From 3ed612e47bff564772be0ee3508dbcec36e9600f Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Wed, 20 Jul 2011 15:14:38 -0700 Subject: [PATCH] Fixed GError GC-cleanup. --- src/gtk/gio.scm | 24 ++++++++++++++++-------- src/gtk/gtk.pkg | 1 - 2 files changed, 16 insertions(+), 9 deletions(-) diff --git a/src/gtk/gio.scm b/src/gtk/gio.scm index 2bb59658d..b54ef5229 100644 --- a/src/gtk/gio.scm +++ b/src/gtk/gio.scm @@ -211,13 +211,21 @@ USA. (named-lambda (g-input-stream-read-finish-callback source result) (let ((bytes (C-call "g_input_stream_read_finish" source result gerror*))) (if (fix:= bytes -1) - (let ((message (gerror->message gerror*))) + (let ((message (gerror-message gerror*))) (%trace ";g-input-stream-read-finish-callback "message" "queue"\n") (%queue! queue message)) (begin (%trace ";g-input-stream-read-finish-callback "bytes" "queue"\n") (%queue! queue bytes))))))) +(define-integrable (gerror-message pointer) + (let* ((GError (C-> pointer "* GError")) + (message (or (and (not (alien-null? GError)) + (c-peek-cstring (C-> GError "GError message"))) + "GError pointer not set."))) + (C->= pointer "* GError" 0) + message)) + (define-integrable (%queue! queue value) ;; The GIO finish callbacks use this procedure to queue a value on a ;; g-stream's queue AND signal the main loop if Scheme has become @@ -254,7 +262,7 @@ USA. (named-lambda (g-input-stream-skip-finish-callback source result) (let ((bytes (C-call "g_input_stream_skip_finish" source result gerror*))) (if (fix:= bytes -1) - (let ((message (gerror->message gerror*))) + (let ((message (gerror-message gerror*))) (%trace ";g-input-stream-skip-finish-callback "message" "queue"\n") (%queue! queue message)) (begin @@ -299,7 +307,7 @@ USA. (named-lambda (g-input-stream-close-finish-callback source result) (if (fix:zero? (C-call "g_input_stream_close_finish" source result gerror*)) - (let ((message (gerror->message gerror*))) + (let ((message (gerror-message gerror*))) (%trace ";g-input-stream-close-finish-callback "message" "queue"\n") (%queue! queue message)) (begin @@ -383,7 +391,7 @@ USA. (let ((bytes (C-call "g_output_stream_write_finish" source result gerror*))) (if (fix:= bytes -1) - (let ((message (gerror->message gerror*))) + (let ((message (gerror-message gerror*))) (%trace ";g-output-stream-write-finish-callback "message " "queue"\n") (%queue! queue message)) @@ -419,7 +427,7 @@ USA. (named-lambda (g-output-stream-flush-finish-callback source result) (if (fix:zero? (C-call "g_output_stream_flush_finish" source result gerror*)) - (let ((message (gerror->message gerror*))) + (let ((message (gerror-message gerror*))) (%trace ";g-output-stream-flush-finish-callback "message" "queue"\n") (%queue! queue message)) (begin @@ -465,7 +473,7 @@ USA. (named-lambda (g-output-stream-close-finish-callback source result) (if (fix:zero? (C-call "g_output_stream_close_finish" source result gerror*)) - (let ((message (gerror->message gerror*))) + (let ((message (gerror-message gerror*))) (%trace ";g-output-stream-close-finish-callback "message" "queue"\n") (%queue! queue message)) (begin @@ -521,7 +529,7 @@ USA. (named-lambda (gfile-read-finish-callback source result) (let ((bytes (C-call "g_file_read_finish" alien source result gerror*))) (if (fix:= bytes -1) - (let ((message (gerror->message gerror*))) + (let ((message (gerror-message gerror*))) (%trace ";g-file-read-finish-callback \""message"\" "queue"\n") (%queue! queue message)) (begin @@ -639,7 +647,7 @@ USA. (define-integrable (g-output-stream-finish alien queue gerror* op) (if (alien-null? alien) - (let ((message (gerror->message gerror*))) + (let ((message (gerror-message gerror*))) (%trace ";g-output-stream-"op"-callback "message" "queue"\n") (%queue! queue message)) (begin diff --git a/src/gtk/gtk.pkg b/src/gtk/gtk.pkg index 4b617433c..2aeb837f0 100644 --- a/src/gtk/gtk.pkg +++ b/src/gtk/gtk.pkg @@ -44,7 +44,6 @@ USA. add-gc-cleanup punt-gc-cleanup gobject-get-property gobject-set-properties gquark-from-string gquark-to-string - gerror->message make-pixbuf-loader load-pixbuf-from-port load-pixbuf-from-file pixbuf-loader-size-hook set-pixbuf-loader-size-hook! -- 2.25.1