Factored gfile-close out of -stream-close and -enumerator-close.

diff --git a/src/gtk/gio.scm b/src/gtk/gio.scm
index 902e165c0ab0c0ca0f84cd4e7982b1c9fe11183f..f8b347f62fcdf9da5069c4e3343b7e2223342ace 100644 (file)
--- 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