From 54a36ed1acd00abcda236d731166324716434841 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Wed, 10 Aug 2011 17:34:45 -0700 Subject: [PATCH] Mount GFiles as necessary, assuming no password is needed. --- src/gtk/Includes/gio/gfile.cdecl | 15 + src/gtk/Includes/gio/gio.cdecl | 2 +- src/gtk/Includes/gio/gioenums.cdecl | 101 ++++++- src/gtk/Includes/gio/gmountoperation.cdecl | 6 + src/gtk/Includes/gobject/gboxed.cdecl | 7 + src/gtk/Includes/gobject/gparamspecs.cdecl | 2 +- src/gtk/gio.scm | 307 +++++++++++++++------ src/gtk/gtk.cdecl | 24 ++ 8 files changed, 363 insertions(+), 101 deletions(-) create mode 100644 src/gtk/Includes/gio/gmountoperation.cdecl create mode 100644 src/gtk/Includes/gobject/gboxed.cdecl diff --git a/src/gtk/Includes/gio/gfile.cdecl b/src/gtk/Includes/gio/gfile.cdecl index 41661fe9d..9c6f2b180 100644 --- a/src/gtk/Includes/gio/gfile.cdecl +++ b/src/gtk/Includes/gio/gfile.cdecl @@ -111,4 +111,19 @@ glib-2.0/gio/gfile.h |# g_file_enumerate_children_finish (file (* GFile)) (res (* GAsyncResult)) + (error (* (* GError)))) + +(extern void + g_file_mount_enclosing_volume + (location (* GFile)) + (flags GMountMountFlags) + (mount_operation (* GMountOperation)) + (cancellable (* GCancellable)) + (CALLBACK GAsyncReadyCallback) + (ID gpointer)) + +(extern gboolean + g_file_mount_enclosing_volume_finish + (location (* GFile)) + (result (* GAsyncResult)) (error (* (* GError)))) \ No newline at end of file diff --git a/src/gtk/Includes/gio/gio.cdecl b/src/gtk/Includes/gio/gio.cdecl index 113e00bd3..47c85f0c9 100644 --- a/src/gtk/Includes/gio/gio.cdecl +++ b/src/gtk/Includes/gio/gio.cdecl @@ -65,7 +65,7 @@ glib-2.0/gio/gio.h |# ;(include "gmemoryinputstream") ;(include "gmemoryoutputstream") ;(include "gmount") -;(include "gmountoperation") +(include "gmountoperation") ;(include "gnativevolumemonitor") ;(include "gnetworkaddress") ;(include "gnetworkservice") diff --git a/src/gtk/Includes/gio/gioenums.cdecl b/src/gtk/Includes/gio/gioenums.cdecl index 2a555b20a..5c1daee34 100644 --- a/src/gtk/Includes/gio/gioenums.cdecl +++ b/src/gtk/Includes/gio/gioenums.cdecl @@ -4,12 +4,6 @@ glib-2.0/gio/gioenums.h |# (include "../glib-object") -(typedef GFileCreateFlags - (enum - (G_FILE_CREATE_NONE) - (G_FILE_CREATE_PRIVATE) - (G_FILE_CREATE_REPLACE_DESTINATION))) - (typedef GFileAttributeType (enum (G_FILE_ATTRIBUTE_TYPE_INVALID) @@ -29,6 +23,97 @@ glib-2.0/gio/gioenums.h |# (G_FILE_ATTRIBUTE_STATUS_SET) (G_FILE_ATTRIBUTE_STATUS_ERROR_SETTING))) -(typedef GFileQueryInfoFlags (enum +(typedef GFileQueryInfoFlags + (enum (G_FILE_QUERY_INFO_NONE) - (G_FILE_QUERY_INFO_NOFOLLOW_SYMLINKS))) \ No newline at end of file + (G_FILE_QUERY_INFO_NOFOLLOW_SYMLINKS))) + +(typedef GFileCreateFlags + (enum + (G_FILE_CREATE_NONE) + (G_FILE_CREATE_PRIVATE) + (G_FILE_CREATE_REPLACE_DESTINATION))) + +(typedef GMountMountFlags + (enum + (G_MOUNT_MOUNT_NONE))) + +(typedef GMountUnmountFlags + (enum + (G_MOUNT_UNMOUNT_NONE) + (G_MOUNT_UNMOUNT_FORCE))) + +(typedef GDriveStartFlags + (enum + (G_DRIVE_START_NONE))) + +(typedef GDriveStartStopType + (enum + (G_DRIVE_START_STOP_TYPE_UNKNOWN) + (G_DRIVE_START_STOP_TYPE_SHUTDOWN) + (G_DRIVE_START_STOP_TYPE_NETWORK) + (G_DRIVE_START_STOP_TYPE_MULTIDISK) + (G_DRIVE_START_STOP_TYPE_PASSWORD))) + +(typedef GFileCopyFlags + (enum + (G_FILE_COPY_NONE) + (G_FILE_COPY_OVERWRITE) + (G_FILE_COPY_BACKUP) + (G_FILE_COPY_NOFOLLOW_SYMLINKS) + (G_FILE_COPY_ALL_METADATA) + (G_FILE_COPY_NO_FALLBACK_FOR_MOVE) + (G_FILE_COPY_TARGET_DEFAULT_PERMS))) + +(typedef GFileMonitorFlags + (enum + (G_FILE_MONITOR_NONE) + (G_FILE_MONITOR_WATCH_MOUNTS) + (G_FILE_MONITOR_SEND_MOVED))) + +(typedef GFileType + (enum + (G_FILE_TYPE_UNKNOWN) + (G_FILE_TYPE_REGULAR) + (G_FILE_TYPE_DIRECTORY) + (G_FILE_TYPE_SYMBOLIC_LINK) + (G_FILE_TYPE_SPECIAL) + (G_FILE_TYPE_SHORTCUT) + (G_FILE_TYPE_MOUNTABLE))) + +(typedef GFilesystemPreviewType + (enum + (G_FILESYSTEM_PREVIEW_TYPE_IF_ALWAYS) + (G_FILESYSTEM_PREVIEW_TYPE_IF_LOCAL) + (G_FILESYSTEM_PREVIEW_TYPE_NEVER))) + +(typedef GFileMonitorEvent + (enum + (G_FILE_MONITOR_EVENT_CHANGED) + (G_FILE_MONITOR_EVENT_CHANGES_DONE_HINT) + (G_FILE_MONITOR_EVENT_DELETED) + (G_FILE_MONITOR_EVENT_CREATED) + (G_FILE_MONITOR_EVENT_ATTRIBUTE_CHANGED) + (G_FILE_MONITOR_EVENT_PRE_UNMOUNT) + (G_FILE_MONITOR_EVENT_UNMOUNTED) + (G_FILE_MONITOR_EVENT_MOVED))) + +(typedef GAskPasswordFlags + (enum + (G_ASK_PASSWORD_NEED_PASSWORD) + (G_ASK_PASSWORD_NEED_USERNAME) + (G_ASK_PASSWORD_NEED_DOMAIN) + (G_ASK_PASSWORD_SAVING_SUPPORTED) + (G_ASK_PASSWORD_ANONYMOUS_SUPPORTED))) + +(typedef GPasswordSave + (enum + (G_PASSWORD_SAVE_NEVER) + (G_PASSWORD_SAVE_FOR_SESSION) + (G_PASSWORD_SAVE_PERMANENTLY))) + +(typedef GMountOperationResult + (enum + (G_MOUNT_OPERATION_HANDLED) + (G_MOUNT_OPERATION_ABORTED) + (G_MOUNT_OPERATION_UNHANDLED))) \ No newline at end of file diff --git a/src/gtk/Includes/gio/gmountoperation.cdecl b/src/gtk/Includes/gio/gmountoperation.cdecl new file mode 100644 index 000000000..4b1da4429 --- /dev/null +++ b/src/gtk/Includes/gio/gmountoperation.cdecl @@ -0,0 +1,6 @@ +#| -*-Scheme-*- + +glib-2.0/gio/gmountoperation.h |# + +(extern (* GMountOperation) + g_mount_operation_new) \ No newline at end of file diff --git a/src/gtk/Includes/gobject/gboxed.cdecl b/src/gtk/Includes/gobject/gboxed.cdecl new file mode 100644 index 000000000..0b082bbd7 --- /dev/null +++ b/src/gtk/Includes/gobject/gboxed.cdecl @@ -0,0 +1,7 @@ +#| -*-Scheme-*- + +glib-2.0/gobject/gboxed.h |# + +(include "gtype") + +(typedef GStrv (* (* gchar))) \ No newline at end of file diff --git a/src/gtk/Includes/gobject/gparamspecs.cdecl b/src/gtk/Includes/gobject/gparamspecs.cdecl index d5deb19d1..a49851f7b 100644 --- a/src/gtk/Includes/gobject/gparamspecs.cdecl +++ b/src/gtk/Includes/gobject/gparamspecs.cdecl @@ -4,7 +4,7 @@ glib-2.0/gobject/gparamspecs.h |# (include "gvalue") (include "genums") -;(include "gboxed") +(include "gboxed") (include "gobject") (typedef GParamSpecChar (struct _GParamSpecChar)) diff --git a/src/gtk/gio.scm b/src/gtk/gio.scm index 847bd9608..d8973fab7 100644 --- a/src/gtk/gio.scm +++ b/src/gtk/gio.scm @@ -21,7 +21,7 @@ USA. |# -;;;; GIO Ports +;;;; GIO Objects ;;; package: (gtk gio) (define (open-input-gfile uri) @@ -519,29 +519,34 @@ USA. (set-gio-cleanup-info-pending-op! gio-info 'OPEN) (set-gio-cleanup-info-callback-id! gio-info id) id))))) - (C-call "g_file_read_async" - (gobject-alien gfile) - (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 gfile-read:" gfile value)) - (begin - (set-gio-cleanup-info-pending-op! gio-info #f) - (without-interrupts - (lambda () - (de-register-c-callback callback-id) - (set-gio-cleanup-info-callback-id! gio-info #f) - (let ((info (g-input-stream-cleanup-info gstream))) - (set-g-input-stream-cleanup-info-read-id! - info (make-read-finish-callback queue gerror*)) - (set-g-input-stream-cleanup-info-skip-id! - info (make-skip-finish-callback queue gerror*))))) - gstream))))) + (let retry () + (C-call "g_file_read_async" + (gobject-alien gfile) + (gio-priority gstream) + (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 #f) + (without-interrupts + (lambda () + (de-register-c-callback callback-id) + (set-gio-cleanup-info-callback-id! gio-info #f) + (let ((info (g-input-stream-cleanup-info gstream))) + (set-g-input-stream-cleanup-info-read-id! + info (make-read-finish-callback queue gerror*)) + (set-g-input-stream-cleanup-info-skip-id! + info (make-skip-finish-callback queue gerror*))))) + gstream) + ((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 gstream))))))) (define (make-open-finish-callback alien queue gerror*) (C-callback @@ -641,28 +646,34 @@ USA. (set-gio-cleanup-info-pending-op! gio-info op) (set-gio-cleanup-info-callback-id! gio-info id) id))))) - (callout (gobject-alien gfile) - (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 (string "Error in gfile-" op ":") gfile value)) - (begin - (set-gio-cleanup-info-pending-op! gio-info #f) - (without-interrupts - (lambda () - (de-register-c-callback callback-id) - (set-gio-cleanup-info-callback-id! gio-info #f) - (let ((info (g-output-stream-cleanup-info gstream))) - (set-g-output-stream-cleanup-info-write-id! - info (make-write-finish-callback queue gerror*)) - (set-g-output-stream-cleanup-info-flush-id! - info (make-flush-finish-callback queue gerror*))))) - gstream))))) + (let retry () + (callout (gobject-alien gfile) + (gio-priority gstream) + (gobject-alien (gio-cleanup-info-gcancellable gio-info)) + (C-callback "async_ready") + callback-id) + (let ((value (thread-queue/dequeue! queue))) + (cond ((or (eq? value #t) + (equal? value "Location is already mounted")) + (set-gio-cleanup-info-pending-op! gio-info #f) + (without-interrupts + (lambda () + (de-register-c-callback callback-id) + (set-gio-cleanup-info-callback-id! gio-info #f) + (let ((info (g-output-stream-cleanup-info gstream))) + (set-g-output-stream-cleanup-info-write-id! + info (make-write-finish-callback queue gerror*)) + (set-g-output-stream-cleanup-info-flush-id! + info (make-flush-finish-callback queue gerror*))))) + gstream) + ((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 gstream))))))) (define-integrable-operator (g-output-stream-finish alien queue gerror* op) (if (alien-null? alien) @@ -698,27 +709,32 @@ USA. (set-gio-cleanup-info-pending-op! gio-info 'QUERY) (set-gio-cleanup-info-callback-id! gio-info id) id))))) - (C-call "g_file_query_info_async" - (gobject-alien gfile) - pattern - (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))) - (if (string? value) - (begin - (set-gio-cleanup-info-pending-op! gio-info 'ERROR) - (error "Error in gfile-query-info:" gfile value)) - (begin - (set-gio-cleanup-info-pending-op! gio-info 'CLOSED) - (without-interrupts - (lambda () - (cleanup-gio gio-info))) - ginfo))))) + (let retry () + (C-call "g_file_query_info_async" + (gobject-alien gfile) + pattern + (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))))))) (define (make-query-finish-callback alien queue gerror*) (C-callback @@ -841,30 +857,36 @@ USA. (set-gio-cleanup-info-pending-op! gio-info 'OPEN) (set-gio-cleanup-info-callback-id! gio-info id) id))))) - (C-call "g_file_enumerate_children_async" - (gobject-alien gfile) - pattern - (if follow-symlinks? - (C-enum "G_FILE_QUERY_INFO_NONE") - (C-enum "G_FILE_QUERY_INFO_NOFOLLOW_SYMLINKS")) - (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-children:" gfile value)) - (begin - (set-gio-cleanup-info-pending-op! gio-info #f) - (without-interrupts - (lambda () - (de-register-c-callback callback-id) - (set-gio-cleanup-info-callback-id! - gio-info (make-next-files-finish-callback - (gfile-enumerator-ginfos genum) queue gerror*)))) - genum))))) + (let retry () + (C-call "g_file_enumerate_children_async" + (gobject-alien gfile) + pattern + (if follow-symlinks? + (C-enum "G_FILE_QUERY_INFO_NONE") + (C-enum "G_FILE_QUERY_INFO_NOFOLLOW_SYMLINKS")) + (gio-priority genum) + (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 #f) + (without-interrupts + (lambda () + (de-register-c-callback callback-id) + (set-gio-cleanup-info-callback-id! + gio-info + (make-next-files-finish-callback + (gfile-enumerator-ginfos genum) queue gerror*)))) + genum) + ((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 genum))))))) (define (make-enumerator-finish-callback alien queue gerror*) (C-callback @@ -988,6 +1010,109 @@ USA. (%trace ";enumerator-close-finish-callback #t "queue"\n") (%queue! queue #t)))))) +(define-class ( (constructor ())) + ()) + +(define-method initialize-instance ((gmount )) + (call-next-method gmount) + (let ((alien (gobject-alien gmount))) + (set-alien/ctype! alien '|GMountOperation|) + (C-call "g_mount_operation_new" alien) + (error-if-null alien "Could not create:" gmount))) + +(define (gfile-mount gfile) + (let* ((mount-op (make-g-mount-operation)) + (gio-info (gio-cleanup-info mount-op)) + (queue (gio-queue mount-op)) + (gerror* (gio-cleanup-info-gerror-pointer gio-info)) + (callback-id + (without-interrupts ;don't leak callback IDs + (lambda () + (let ((id (make-mount-finish-callback queue gerror*))) + (set-gio-cleanup-info-pending-op! gio-info 'MOUNT) + (set-gio-cleanup-info-callback-id! gio-info id) + id))))) + (attach-mount-signal-handlers mount-op gfile) + (C-call "g_file_mount_enclosing_volume" + (gobject-alien gfile) + (C-enum "G_MOUNT_MOUNT_NONE") + (gobject-alien mount-op) + (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 during mount:" gfile value)) + (begin + (set-gio-cleanup-info-pending-op! gio-info #f) + (gobject-unref! mount-op) + (without-interrupts + (lambda () + (cleanup-gio gio-info)))))))) + +(define (make-mount-finish-callback queue gerror*) + (C-callback + (named-lambda (mount-finish-callback source result) + (if (fix:zero? (C-call "g_file_mount_enclosing_volume_finish" + source result gerror*)) + (let ((message (%gerror-message gerror*))) + (%trace ";mount-finish-callback "message" "queue"\n") + (%queue! queue message)) + (begin + (%trace ";mount-finish-callback #t "queue"\n") + (%queue! queue #t)))))) + +(define (attach-mount-signal-handlers gmount-op gfile) + (g-signal-connect gmount-op (C-callback "ask_password") + (make-mount-password-callback gfile) + 'ask-password) + (g-signal-connect gmount-op (C-callback "ask_question") + (make-mount-question-callback gfile) + 'ask-question) + (g-signal-connect gmount-op (C-callback "show_processes") + (make-mount-processes-callback gfile) + 'show-processes)) + +(define (make-mount-password-callback gfile) + (named-lambda (mount-password-callback gmount-op message user domain flags) + (%trace ";mount-password-callback "(gfile-uri gfile) + " "gmount-op + " "(c-peek-cstring message) + " "(c-peek-cstring user) + " "(c-peek-cstring domain) + " "(c-flags "GAskPasswordFlags" flags)"\n") + )) + +(define (c-flags ignore flags) + (declare (ignore ignore)) + (string "0x" (number->string flags 16))) + +(define (make-mount-question-callback gfile) + (named-lambda (mount-question-callback gmount-op message choices) + (%trace ";make-mount-question-callback "(gfile-uri gfile) + " "gmount-op + " "(c-peek-cstring message) + " "(peek-gstrv! choices)"\n") + )) + +(define (peek-gstrv! alien) + (let loop () + (let ((str (c-peek-cstringp! alien))) + (if (not str) + '() + (cons str (loop)))))) + +(define (make-mount-processes-callback gfile) + (named-lambda (mount-processes-callback gmount-op message processes choices) + (%trace ";make-mount-processes-callback "gfile + " "gmount-op + " "(c-peek-cstring message) + " "processes + " "(peek-gstrv! choices)"\n") + )) + (define-class ( (constructor (uri))) () (uri define accessor)) diff --git a/src/gtk/gtk.cdecl b/src/gtk/gtk.cdecl index 2e207336b..0b7eb75f1 100644 --- a/src/gtk/gtk.cdecl +++ b/src/gtk/gtk.cdecl @@ -46,6 +46,30 @@ USA. (res (* GAsyncResult)) (ID gpointer)) +(callback void + ask_password + (op (* GMountOperation)) + (message (* gchar)) + (default_user (* gchar)) + (default_domain (* gchar)) + (flags GAskPasswordFlags) + (ID gpointer)) + +(callback void + ask_question + (op (* GMountOperation)) + (message (* gchar)) + (choices GStrv) + (ID gpointer)) + +(callback void + show_processes + (op (* GMountOperation)) + (message (* gchar)) + (processes (* GArray)) + (choices GStrv) + (ID gpointer)) + ;;; gtkio.c (extern gboolean start_gtk (argc_loc (* int)) (argv_loc (* (* (* char))))) -- 2.25.1