gtk plugin: Apply bytes->string to value of c-peek-cstring.

diff --git a/src/gtk/fix-layout.scm b/src/gtk/fix-layout.scm
index 2d480dfd973bebe99ab51cfd877cffa74b183acc..558db5be8b93efaf6dfd15982cf9371cc18b4468 100644 (file)
--- a/src/gtk/fix-layout.scm
+++ b/src/gtk/fix-layout.scm
@@ -242,7 +242,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
           (length (C-> GdkEvent "GdkEvent key length"))
           (state (C-> GdkEvent "GdkEvent key state"))
           (keyval (C-> GdkEvent "GdkEvent key keyval")))
-       (let ((string (utf8->string (c-peek-cstring alien)))
+       (let ((string (bytes->string (c-peek-cstring alien)))
             (char-bits (gdk-key-state->char-bits state)))
         (cond ((zero? (string-length string))
                (cond ((fix:= length 1)

diff --git a/src/gtk/gdk.scm b/src/gtk/gdk.scm
index 85cdbe5208690366d34686cebf9ee09ae9527429..ba92aa3a031ef013f791c00a1b9f10f82abca2ff 100644 (file)
--- a/src/gtk/gdk.scm
+++ b/src/gtk/gdk.scm
@@ -141,7 +141,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
        (define (note-error)
          (let* ((gerror (C-> gerror* "* GError"))
                 (message (or (and (not (alien-null? gerror))
-                                  (utf8->string
+                                  (bytes->string
                                    (c-peek-cstring
                                     (C-> gerror "GError message"))))
                              "GError pointer not set.")))
@@ -308,7 +308,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
      (declare (ignore clipboard))
      (if (alien-null? char*)
         (queue! queue #t)
-        (queue! queue (utf8->string (c-peek-cstring char*)))))))
+        (queue! queue (bytes->string (c-peek-cstring char*)))))))
 
 (define (queue! queue value)
   (thread-queue/queue! queue value)

diff --git a/src/gtk/gtk-ev.scm b/src/gtk/gtk-ev.scm
index d761847b1a236638508373a9dff73f8811652eba..482b7b6701640b5699723ae040ac195b337cb570 100644 (file)
--- a/src/gtk/gtk-ev.scm
+++ b/src/gtk/gtk-ev.scm
@@ -384,7 +384,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
                                 (C-> GdkEvent "GdkEvent key keyval")))
                 (text (let ((alien (make-alien '|gchar|)))
                         (C-> GdkEvent "GdkEvent key string" alien)
-                        (utf8->string (c-peek-cstring alien)))))
+                        (bytes->string (c-peek-cstring alien)))))
             (cat "Keyval: "keyval" Text: "text"\n")))
          (else
           #f))))

diff --git a/src/gtk/gtk-tests.scm b/src/gtk/gtk-tests.scm
index a0eef89fdd5ecc722134080323deb9f485f1ab04..72206f07b4956e760b90f32680dcc1c188165dfb 100644 (file)
--- a/src/gtk/gtk-tests.scm
+++ b/src/gtk/gtk-tests.scm
@@ -47,6 +47,6 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
               (map (lambda (elt)
                      (let ((alien (weak-car elt)))
                        (if (eq? 'uchar (alien/ctype alien))
-                           (utf8->string (c-peek-cstring alien))
+                           (bytes->string (c-peek-cstring alien))
                            alien)))
                    (access malloced-aliens ffi))))))
\ No newline at end of file

diff --git a/src/gtk/gtk-widget.scm b/src/gtk/gtk-widget.scm
index 6a3b93b8971e033c8b878283b9620f1e26e50331..3c0563ebd8f8915fab7f115247ae0bcd5b8296ba 100644 (file)
--- a/src/gtk/gtk-widget.scm
+++ b/src/gtk/gtk-widget.scm
@@ -352,12 +352,12 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (error-if-gerror* gerror* message . data)
   (let ((gerror (C-> gerror* "* GError")))
     (if (not (alien-null? gerror))
-       (let ((errmsg-bv (c-peek-cstring (C-> gerror "GError message"))))
+       (let ((errmsg-bytes (c-peek-cstring (C-> gerror "GError message"))))
          (without-interruption
           (lambda ()
             (C->= gerror* "* GError" 0)
             (C-call "g_error_free" gerror)))
-         (apply error message (utf8->string errmsg-bv) data)))))
+         (apply error message (bytes->string errmsg-bytes) data)))))
 
 (define-class (<gtk-css-provider> (constructor ()))
     (<gobject-with-gerror*>))
@@ -509,7 +509,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   (guarantee-gtk-label label 'gtk-label-get-text)
   (let ((retval (make-alien '|gchar|)))
     (C-call "gtk_label_get_text" retval (gobject-alien label))
-    (utf8->string (c-peek-cstring retval))))
+    (bytes->string (c-peek-cstring retval))))
 
 (define (gtk-label-set-text label string)
   (guarantee-gtk-label label 'gtk-label-set-text)

diff --git a/src/gtk/gtk.scm b/src/gtk/gtk.scm
index 6fc6f64ccdedaba87089e630625e82af65b6f53d..93c6a1fa663f54cc1fc67a40699105d2e7a363a2 100644 (file)
--- a/src/gtk/gtk.scm
+++ b/src/gtk/gtk.scm
@@ -105,4 +105,13 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
     (set-color-green! color green)
     (set-color-blue! color blue)
     (set-color-alpha! color alpha)
-    color))
\ No newline at end of file
+    color))
+
+(declare (integrate-operator bytes->string))
+(define (bytes->string bytes)
+  (cond ((string? bytes)
+        bytes)
+       ((bytevector? bytes)
+        (utf8->string bytes))
+       (else
+        (error:wrong-type-argument bytes "a string or bytevector"))))
\ No newline at end of file

diff --git a/src/gtk/main.scm b/src/gtk/main.scm
index 7b9b010729e9cc7b822a259d216b5bd0c8ff1aa5..6f4df7c1d23c103fc2b523d6fb35756d4be8c682 100644 (file)
--- a/src/gtk/main.scm
+++ b/src/gtk/main.scm
@@ -101,7 +101,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
                   (let loop ((i 0)(args '()))
                     (if (fix:< i new-argc)
                         (loop (fix:1+ i)
-                              (cons (utf8->string
+                              (cons (bytes->string
                                      (c-peek-cstringp! vector-scan))
                                     args))
                         (reverse! args)))))