From: Matt Birkholz Date: Fri, 12 Aug 2011 19:15:44 +0000 (-0700) Subject: Factored gfile-close out of -stream-close and -enumerator-close. X-Git-Tag: mit-scheme-pucked-9.2.12~642 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=41e6c9cdb1699aff6084d182625776ebe114421c;p=mit-scheme.git Factored gfile-close out of -stream-close and -enumerator-close. --- diff --git a/src/gtk/gio.scm b/src/gtk/gio.scm index 902e165c0..f8b347f62 100644 --- a/src/gtk/gio.scm +++ b/src/gtk/gio.scm @@ -357,35 +357,47 @@ USA. (%queue! queue bytes))))))) (define (g-input-stream-close gstream) - (let* ((gio-info (gio-cleanup-info gstream)) - (queue (gio-queue gstream)) + (gfile-close gstream + (named-lambda (close-input + gstream* priority gcancellable* callback id) + (C-call "g_input_stream_close_async" + gstream* priority gcancellable* callback id)) + make-input-close-finish-callback + (named-lambda (close-input-cleanup gio-info) + (cleanup-g-input-stream + gio-info (g-input-stream-cleanup-info gstream))))) + +(define (gfile-close gio callout make-callback cleanup) + (let* ((gio-info (gio-cleanup-info gio)) + (queue (gio-queue gio)) (gerror* (gio-cleanup-info-gerror-pointer gio-info))) - (guarantee-gio-idle gstream) + (guarantee-gio-idle gio) (let ((callback-id (without-interrupts ;don't leak callback IDs (lambda () - (let ((id (make-input-close-finish-callback queue gerror*))) + (let ((old (gio-cleanup-info-callback-id gio-info))) + (if old (de-register-c-callback old))) + (let ((id (make-callback queue gerror*))) (set-gio-cleanup-info-pending-op! gio-info 'CLOSE) (set-gio-cleanup-info-callback-id! gio-info id) id))))) - (C-call "g_input_stream_close_async" - (gobject-alien gstream) - (gio-priority gstream) - (gobject-alien (gio-cleanup-info-gcancellable gio-info)) - (C-callback "async_ready") - callback-id) + (callout (gobject-alien gio) + (gio-priority gio) + (gobject-alien (gio-cleanup-info-gcancellable gio-info)) + (C-callback "async_ready") + callback-id) (let ((value (thread-queue/dequeue! queue))) - (if (string? value) - (begin - (set-gio-cleanup-info-pending-op! gio-info 'ERROR) - (error "Error in g-input-stream-close:" gstream value)) - (begin - (set-gio-cleanup-info-pending-op! gio-info 'CLOSED) - (without-interrupts - (lambda () - (cleanup-g-input-stream - gio-info (g-input-stream-cleanup-info gstream)))) - value)))))) + (cond ((eq? value #t) + (set-gio-cleanup-info-pending-op! gio-info 'CLOSED) + (without-interrupts + (lambda () + (cleanup gio-info))) + unspecific) + ((string? value) + (set-gio-cleanup-info-pending-op! gio-info 'ERROR) + (error "Error during close:" gio value)) + (else + (error "Unexpected value from:" queue gio))))))) (define (make-input-close-finish-callback queue gerror*) (C-callback @@ -503,35 +515,15 @@ USA. (%queue! queue #t)))))) (define (g-output-stream-close gstream) - (let* ((gio-info (gio-cleanup-info gstream)) - (queue (gio-queue gstream)) - (gerror* (gio-cleanup-info-gerror-pointer gio-info))) - (guarantee-gio-idle gstream) - (let ((callback-id - (without-interrupts ;don't leak callback IDs - (lambda () - (let ((id (make-output-close-finish-callback queue gerror*))) - (set-gio-cleanup-info-pending-op! gio-info 'CLOSE) - (set-gio-cleanup-info-callback-id! gio-info id) - id))))) - (C-call "g_output_stream_close_async" - (gobject-alien gstream) - (gio-priority gstream) - (gobject-alien (gio-cleanup-info-gcancellable gio-info)) - (C-callback "async_ready") - callback-id) - (let ((value (thread-queue/dequeue! queue))) - (if (string? value) - (begin - (set-gio-cleanup-info-pending-op! gio-info 'ERROR) - (error "Error in g-output-stream-close:" gstream value)) - (begin - (set-gio-cleanup-info-pending-op! gio-info 'CLOSED) - (without-interrupts - (lambda () + (gfile-close gstream + (named-lambda (close-output + gstream* priority gcancellable* callback id) + (C-call "g_output_stream_close_async" + gstream* priority gcancellable* callback id)) + make-output-close-finish-callback + (named-lambda (close-output-cleanup gio-info) (cleanup-g-output-stream - gio-info (g-output-stream-cleanup-info gstream)))) - value)))))) + gio-info (g-output-stream-cleanup-info gstream))))) (define (make-output-close-finish-callback queue gerror*) (C-callback @@ -953,37 +945,15 @@ USA. (%queue! queue #t)))))) (define (gfile-enumerator-close genum) - (let* ((gio-info (gio-cleanup-info genum)) - (ginfos (gfile-enumerator-ginfos genum)) - (queue (gio-queue genum)) - (gerror* (gio-cleanup-info-gerror-pointer gio-info))) - (guarantee-gio-idle genum) - (let ((callback-id - (without-interrupts ;don't leak callback IDs - (lambda () - (let ((old (gio-cleanup-info-callback-id gio-info))) - (if old (de-register-c-callback old))) - (let ((id (make-enumerator-close-finish-callback queue gerror*))) - (set-gio-cleanup-info-pending-op! gio-info 'CLOSE) - (set-gio-cleanup-info-callback-id! gio-info id) - id))))) - (C-call "g_file_enumerator_close_async" - (gobject-alien genum) - (gio-priority genum) - (gobject-alien (gio-cleanup-info-gcancellable gio-info)) - (C-callback "async_ready") - callback-id) - (let ((value (thread-queue/dequeue! queue))) - (if (string? value) - (begin - (set-gio-cleanup-info-pending-op! gio-info 'ERROR) - (error "Error in gfile-enumerator-close:" genum value)) - (begin - (set-gio-cleanup-info-pending-op! gio-info 'CLOSED) - (without-interrupts - (lambda () - (cleanup-gfile-enumerator gio-info ginfos))) - value)))))) + (let ((ginfos (gfile-enumerator-ginfos genum))) + (gfile-close genum + (named-lambda (close-enumerator + genum* priority gcancellable* callback id) + (C-call "g_file_enumerator_close_async" + genum* priority gcancellable* callback id)) + make-enumerator-close-finish-callback + (named-lambda (cleanup-enumerator gio-info) + (cleanup-gfile-enumerator gio-info ginfos))))) (define (make-enumerator-close-finish-callback queue gerror*) (C-callback