gtk: Use read-bytevector! and punt external strings.

diff --git a/src/gtk/gdk.scm b/src/gtk/gdk.scm
index e6d7763b2273fea6bd84d6400e2d5cc748c853f6..1ecdad5c6217e70fc624333eda7ed7bb452d27bc 100644 (file)
--- a/src/gtk/gdk.scm
+++ b/src/gtk/gdk.scm
@@ -117,48 +117,52 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (create-pixbuf-loader-thread loader)
   (create-thread
-   #f (lambda ()
-       (%trace "; "loader" started in "(current-thread)"\n")
-       (let ((port (pixbuf-loader-port loader))
-             (alien (gobject-alien loader))
-             (gerror* (make-gerror-pointer))
-             (buff (allocate-external-string 4200)))
-         (C->= gerror* "* GError" 0)
-         (let ((buff-address (external-string-descriptor buff)))
-
-           (define (note-done)
-             (gerror-pointer-free gerror*)
-             (without-interrupts
-              (lambda ()
-                (set-pixbuf-loader-closed?! loader #t)
-                (close-input-port port)))
-             (%trace "; "loader" closed by "(current-thread)"\n")
-             (let ((proc (pixbuf-loader-close-hook loader)))
-               (if proc
-                   (proc loader))))
-
-           (define (note-error)
-             (let* ((gerror (C-> gerror* "* GError"))
-                    (message (or (and (not (alien-null? gerror))
-                                      (c-peek-cstring
-                                       (C-> gerror "GError message")))
-                                 "GError pointer not set.")))
-               (set-pixbuf-loader-error-message! loader message))
-             (note-done))
-
-           (let loop ()
-             (let ((n (input-port/read-string! port buff)))
-               (cond ((and (fix:zero? n) (eof-object? (peek-char port)))
-                      (if (fix:zero? (C-call "gdk_pixbuf_loader_close"
-                                             alien gerror*))
-                          (note-error)
-                          (note-done)))
-                     ((not (fix:zero?
-                            (C-call "gdk_pixbuf_loader_write"
-                                    alien buff-address n gerror*)))
-                      (loop))
-                     (else
-                      (note-error))))))))))
+      #f
+    (lambda ()
+      (%trace "; "loader" started in "(current-thread)"\n")
+      (let ((port (pixbuf-loader-port loader))
+           (alien (gobject-alien loader))
+           (gerror* (make-gerror-pointer))
+           (buffer (make-bytevector 4200)))
+       (C->= gerror* "* GError" 0)
+
+       (define (note-done)
+         (gerror-pointer-free gerror*)
+         (without-interrupts
+          (lambda ()
+            (set-pixbuf-loader-closed?! loader #t)
+            (close-input-port port)))
+         (%trace "; "loader" closed by "(current-thread)"\n")
+         (let ((proc (pixbuf-loader-close-hook loader)))
+           (if proc
+               (proc loader)))
+         unspecific)
+
+       (define (note-error)
+         (let* ((gerror (C-> gerror* "* GError"))
+                (message (or (and (not (alien-null? gerror))
+                                  (c-peek-cstring
+                                   (C-> gerror "GError message")))
+                             "GError pointer not set.")))
+           (set-pixbuf-loader-error-message! loader message))
+         (note-done))
+
+       (let loop ()
+         (let ((n (read-bytevector! buffer port)))
+           (cond ((eof-object? n)
+                  (if (fix:zero? (C-call "gdk_pixbuf_loader_close"
+                                         alien gerror*))
+                      (note-error)
+                      (note-done)))
+                 ((or (not (fix:fixnum? n))
+                      (fix:zero? n))
+                  (note-error))
+                 ((not (fix:zero?
+                        (C-call "gdk_pixbuf_loader_write"
+                                alien buffer n gerror*)))
+                  (loop))
+                 (else
+                  (note-error)))))))))
 
 (define (make-gerror-pointer)
   (let ((alien (make-alien '(* |GError|)))
@@ -269,7 +273,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (gdk-display-set-clipboard-text display string)
   (%trace "; gdk-display-set-clipboard-text "display"\n")
-  (let ((string (string->utf8-string string)))
+  (let ((string (string->utf8 string)))
     (C-call "gtk_clipboard_set_text"
             (clipboard display)
             string (string-length string))))