Factored gfile-open out of gfile-query-info.

diff --git a/src/gtk/gio.scm b/src/gtk/gio.scm
index 60274d508a04d4381b7645f892bbed25fa76187e..902e165c0ab0c0ca0f84cd4e7982b1c9fe11183f 100644 (file)
--- a/src/gtk/gio.scm
+++ b/src/gtk/gio.scm
@@ -727,44 +727,23 @@ USA.
 
 (define (gfile-query-info gfile attributes follow-symlinks?)
   (guarantee-string attributes 'gfile-query-info)
-  (let* ((ginfo (make-gfile-info))
-        (gio-info (gio-cleanup-info ginfo))
-        (queue (gio-queue ginfo))
-        (gerror* (gio-cleanup-info-gerror-pointer gio-info))
-        (callback-id
-         (without-interrupts           ;don't leak callback IDs
-          (lambda ()
-            (let* ((alien (gobject-alien ginfo))
-                   (id (make-query-finish-callback alien queue gerror*)))
-              (set-gio-cleanup-info-pending-op! gio-info 'QUERY)
-              (set-gio-cleanup-info-callback-id! gio-info id)
-              id)))))
-    (let retry ()
-      (C-call "g_file_query_info_async"
-             (gobject-alien gfile)
-             attributes
-             (if follow-symlinks?
-                 (C-enum "G_FILE_QUERY_INFO_NONE")
-                 (C-enum "G_FILE_QUERY_INFO_NOFOLLOW_SYMLINKS"))
-             (gio-priority ginfo)
-             (gobject-alien (gio-cleanup-info-gcancellable gio-info))
-             (C-callback "async_ready")
-             callback-id)
-      (let ((value (thread-queue/dequeue! queue)))
-       (cond ((eq? value #t)
-              (set-gio-cleanup-info-pending-op! gio-info 'CLOSED)
-              (without-interrupts
-               (lambda ()
-                 (cleanup-gio gio-info)))
-              ginfo)
-             ((equal? value "The specified location is not mounted")
-              (gfile-mount gfile)
-              (retry))
-             ((string? value)
-              (set-gio-cleanup-info-pending-op! gio-info 'ERROR)
-              (error (string-append (gfile-uri gfile) ":") value))
-             (else
-              (error "Unexpected value from:" queue ginfo)))))))
+  (gfile-open gfile 'QUERY
+             make-gfile-info
+             (named-lambda (query-callout
+                            gfile* priority gcancellable* callback id)
+               (C-call "g_file_query_info_async"
+                       gfile*
+                       attributes
+                       (if follow-symlinks?
+                           (C-enum "G_FILE_QUERY_INFO_NONE")
+                           (C-enum "G_FILE_QUERY_INFO_NOFOLLOW_SYMLINKS"))
+                       priority gcancellable* callback id))
+             make-query-finish-callback 
+             (named-lambda (cleanup-gfile-info gfile-info queue gerror*)
+               (declare (ignore queue gerror*))
+               (let ((gio-info (gio-cleanup-info gfile-info)))
+                 (set-gio-cleanup-info-pending-op! gio-info 'CLOSED)
+                 (cleanup-gio gio-info)))))
 
 (define (make-query-finish-callback alien queue gerror*)
   (C-callback