From c8a93ab552acb1874bf05f61dc5d48f46c9f86c4 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Fri, 7 Jul 2017 07:55:44 -0700 Subject: [PATCH] gtk plugin: Apply bytes->string to value of c-peek-cstring. --- src/gtk/fix-layout.scm | 2 +- src/gtk/gdk.scm | 4 ++-- src/gtk/gtk-ev.scm | 2 +- src/gtk/gtk-tests.scm | 2 +- src/gtk/gtk-widget.scm | 6 +++--- src/gtk/gtk.scm | 11 ++++++++++- src/gtk/main.scm | 2 +- 7 files changed, 19 insertions(+), 10 deletions(-) diff --git a/src/gtk/fix-layout.scm b/src/gtk/fix-layout.scm index 2d480dfd9..558db5be8 100644 --- 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 85cdbe520..ba92aa3a0 100644 --- 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 d761847b1..482b7b670 100644 --- 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 a0eef89fd..72206f07b 100644 --- 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 6a3b93b89..3c0563ebd 100644 --- 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 ( (constructor ())) ()) @@ -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 6fc6f64cc..93c6a1fa6 100644 --- 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 7b9b01072..6f4df7c1d 100644 --- 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))))) -- 2.25.1