glib: Use bytevectors instead of strings.

diff --git a/src/glib/gio.scm b/src/glib/gio.scm
index 588bb898d743c3a5256a1028ede2944b52d0ab80..15b3265c6626f4ac870c9629b737cb63e7ae8f3c 100644 (file)
--- a/src/glib/gio.scm
+++ b/src/glib/gio.scm
@@ -318,7 +318,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
        (begin
          (C->= pointer "* GError" 0)
          (C-call "g_error_free" gerror)))
-    message))
+    (utf8->string message)))
 
 (define-integrable (%queue! queue value)
   ;; The GIO finish callbacks use this procedure to queue a value on a
@@ -726,7 +726,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
     (cleanup-gio gio-info)))
 
 (define (gfile-query-info gfile attributes follow-symlinks?)
-  (guarantee-string attributes 'gfile-query-info)
+  (guarantee string? attributes 'gfile-query-info)
   (gfile-open gfile 'QUERY
              make-gfile-info
              (named-lambda (query-callout
@@ -758,7 +758,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
           (%queue! queue #t))))))
 
 (define (gfile-info-list-attributes ginfo namespace)
-  (guarantee-string namespace 'gfile-info-list-attributes)
+  (guarantee string? namespace 'gfile-info-list-attributes)
   (map! string->symbol
        (let ((alien (make-cstringv
                      (lambda (copy)
@@ -771,7 +771,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (gfile-info-get-attribute-status ginfo name)
   (let ((code (C-call "g_file_info_get_attribute_status"
                      (gobject-alien ginfo)
-                     name)))
+                     (string->utf8 name))))
     (cond ((fix:= code (C-enum "G_FILE_ATTRIBUTE_STATUS_UNSET")) 'unset)
          ((fix:= code (C-enum "G_FILE_ATTRIBUTE_STATUS_SET")) 'set)
          ((fix:= code (C-enum "G_FILE_ATTRIBUTE_STATUS_ERROR_SETTING"))
@@ -780,35 +780,38 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (gfile-info-get-attribute-value ginfo name)
   (let* ((alien (gobject-alien ginfo))
-        (type (C-call "g_file_info_get_attribute_type" alien name)))
+        (name-bv (string->utf8 name))
+        (type (C-call "g_file_info_get_attribute_type" alien name-bv)))
     (cond ((fix:= type (C-enum "G_FILE_ATTRIBUTE_TYPE_INVALID"))
           (error "Invalid attribute:" name))
          ((fix:= type (C-enum "G_FILE_ATTRIBUTE_TYPE_STRING"))
-          (c-peek-cstring
-           (C-call "g_file_info_get_attribute_string"
-                   (make-alien 'char) alien name)))
+          (utf8->string
+           (c-peek-cstring
+            (C-call "g_file_info_get_attribute_string"
+                    (make-alien 'char) alien name-bv))))
          ((fix:= type (C-enum "G_FILE_ATTRIBUTE_TYPE_BYTE_STRING"))
-          (c-peek-cstring
-           (C-call "g_file_info_get_attribute_byte_string"
-                   (make-alien 'uchar) alien name)))
+          (utf8->string
+           (c-peek-cstring
+            (C-call "g_file_info_get_attribute_byte_string"
+                    (make-alien 'uchar) alien name-bv))))
          ((fix:= type (C-enum "G_FILE_ATTRIBUTE_TYPE_BOOLEAN"))
           (not (fix:zero?
-                (C-call "g_file_info_get_attribute_boolean" alien name))))
+                (C-call "g_file_info_get_attribute_boolean" alien name-bv))))
          ((fix:= type (C-enum "G_FILE_ATTRIBUTE_TYPE_UINT32"))
-          (C-call "g_file_info_get_attribute_uint32" alien name))
+          (C-call "g_file_info_get_attribute_uint32" alien name-bv))
          ((fix:= type (C-enum "G_FILE_ATTRIBUTE_TYPE_INT32"))
-          (C-call "g_file_info_get_attribute_int32" alien name))
+          (C-call "g_file_info_get_attribute_int32" alien name-bv))
 ;        ((fix:= type (C-enum "G_FILE_ATTRIBUTE_TYPE_UINT64"))
-;         (C-call "g_file_info_get_attribute_uint64" alien name))
+;         (C-call "g_file_info_get_attribute_uint64" alien name-bv))
 ;        ((fix:= type (C-enum "G_FILE_ATTRIBUTE_TYPE_INT64"))
-;         (C-call "g_file_info_get_attribute_int64" alien name))
+;         (C-call "g_file_info_get_attribute_int64" alien name-bv))
          ((fix:= type (C-enum "G_FILE_ATTRIBUTE_TYPE_OBJECT"))
           (C-call "g_file_info_get_attribute_object"
-                  (make-alien '|GObject|) alien name))
+                  (make-alien '|GObject|) alien name-bv))
          ((fix:= type (C-enum "G_FILE_ATTRIBUTE_TYPE_STRINGV"))
           (peek-cstringv
            (C-call "g_file_info_get_attribute_stringv"
-                   (make-alien '(* (const char))) alien name)))
+                   (make-alien '(* (const char))) alien name-bv)))
          (else (error "Unexpected GFileAttributeType:" type)))))
 \f
 (define-class (<gfile-enumerator> (constructor ()))
@@ -850,14 +853,14 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
              (loop))))))
 
 (define (gfile-enumerate-children gfile attributes follow-symlinks?)
-  (guarantee-string attributes 'gfile-enumerate-children)
+  (guarantee string? attributes 'gfile-enumerate-children)
   (gfile-open gfile 'OPEN
              make-gfile-enumerator
              (named-lambda (query-callout
                             gfile* priority gcancellable* callback id)
                (C-call "g_file_enumerate_children_async"
                        gfile*
-                       attributes
+                       (string->utf8 attributes)
                        (if follow-symlinks?
                            (C-enum "G_FILE_QUERY_INFO_NONE")
                            (C-enum "G_FILE_QUERY_INFO_NOFOLLOW_SYMLINKS"))
@@ -884,7 +887,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
           (%queue! queue #t))))))
 
 (define (gfile-enumerator-next-files genum nfiles)
-  (guarantee-fixnum nfiles 'gfile-enumerator-next-files)
+  (guarantee fixnum? nfiles 'gfile-enumerator-next-files)
   (let* ((gio-info (gio-cleanup-info genum))
         (callback-id (gio-cleanup-info-callback-id gio-info)))
     (guarantee-gio-idle genum)
@@ -1011,7 +1014,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
                (C-call "g_mount_operation_set_anonymous" alien 1)
                (set-g-mount-operation-username! gmountop "anonymous"))
              (begin
-               (C-call "g_mount_operation_set_username" alien userinfo)
+               (C-call "g_mount_operation_set_username"
+                       alien (string->utf8 userinfo))
                (set-g-mount-operation-username! gmountop userinfo)))))
     (attach-mount-signal-handlers gmountop gfile)
     (let retry ()
@@ -1057,17 +1061,17 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
          (set-g-mount-operation-username! alien "anonymous")))
     (if (memq 'NEED-DOMAIN flags)
        (let ((d (prompt-for-string* "Domain" domain port)))
-         (C-call "g_mount_operation_set_domain" alien d)
+         (C-call "g_mount_operation_set_domain" alien (string->utf8 d))
          (set-g-mount-operation-domain! gmountop d)))
     (if (memq 'NEED-USERNAME flags)
        (let ((u (prompt-for-string* "Username" username port)))
-         (C-call "g_mount_operation_set_username" alien u)
+         (C-call "g_mount_operation_set_username" alien (string->utf8 u))
          (set-g-mount-operation-username! gmountop u)))
     (if (memq 'NEED-PASSWORD flags)
        (call-with-pass-phrase
         "Password"
         (lambda (phrase)
-          (C-call "g_mount_operation_set_password" alien phrase))))
+          (C-call "g_mount_operation_set_password" alien (string->utf8 phrase)))))
     (if (memq 'SAVING-SUPPORTED flags)
        (if (prompt-for-confirmation "Save password permanently" port)
            (C-call "g_mount_operation_set_password_save" alien
@@ -1108,15 +1112,18 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   (named-lambda (mount-password-callback gmountop message user domain flags)
     (%trace-auth ";mount-password-callback "(gfile-uri gfile)
                 " "gmountop
-                " "(c-peek-cstring message)
-                " "(c-peek-cstring user)
-                " "(c-peek-cstring domain)
+                " "(utf8->string (c-peek-cstring message))
+                " "(utf8->string (c-peek-cstring user))
+                " "(utf8->string (c-peek-cstring domain))
                 " "(->ask-password-flags flags)"\n")
     (let ((old (g-mount-operation-ask-password-flags gmountop))
          (new (->ask-password-flags flags)))
-      (set-g-mount-operation-message! gmountop (c-peek-cstring message))
-      (set-g-mount-operation-username! gmountop (c-peek-cstring user))
-      (set-g-mount-operation-domain! gmountop (c-peek-cstring domain))
+      (set-g-mount-operation-message! gmountop
+                                     (utf8->string (c-peek-cstring message)))
+      (set-g-mount-operation-username! gmountop
+                                      (utf8->string (c-peek-cstring user)))
+      (set-g-mount-operation-domain! gmountop
+                                    (utf8->string (c-peek-cstring domain)))
       (set-g-mount-operation-ask-password-flags! gmountop new)
       (cond ((not old)
             ;; Punt, %queuing "Password dialog cancelled".
@@ -1149,13 +1156,13 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
     (%trace-auth ";make-mount-question-callback"
                 " "(gfile-uri gfile)
                 " "gmountop
-                " "(c-peek-cstring message)
+                " "(utf8->string (c-peek-cstring message))
                 " "(peek-gstrv! choices)"\n")
     (warn "Unimplemented" 'mount-question-callback)))
 
 (define (peek-gstrv! alien)
   (let loop ()
-    (let ((str (c-peek-cstringp! alien)))
+    (let ((str (utf8->string (c-peek-cstringp! alien))))
       (if (null? str)
          '()
          (cons str (loop))))))
@@ -1165,7 +1172,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
     (%trace-auth ";make-mount-processes-callback"
                 " "gfile
                 " "gmountop
-                " "(c-peek-cstring message)
+                " "(utf8->string (c-peek-cstring message))
                 " "processes
                 " "(peek-gstrv! choices)"\n")
     (warn "Unimplemented" 'mount-processes-callback)))
@@ -1225,7 +1232,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
       (C-> scan "* uchar" cstr)
       (if (alien-null? cstr)
          '()
-         (let ((str (c-peek-cstring cstr)))
+         (let ((str (utf8->string (c-peek-cstring cstr))))
            (alien-byte-increment! scan (C-sizeof "* uchar"))
            (cons str (loop)))))))
 

diff --git a/src/glib/glib-tests.scm b/src/glib/glib-tests.scm
index 38173e814f986abf43bb10ef8cf24b9165f71e87..4dc83863c94b7754f28d4ac222e802688aa6687b 100644 (file)
--- a/src/glib/glib-tests.scm
+++ b/src/glib/glib-tests.scm
@@ -79,6 +79,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))
-                           (c-peek-cstring alien)
+                           (utf8->string (c-peek-cstring alien))
                            alien)))
                    (access malloced-aliens ffi))))))
\ No newline at end of file

diff --git a/src/glib/gobject.scm b/src/glib/gobject.scm
index 3fede7dfb59da7bfc12165051659fc7935498d5c..3e33e13bad4a1bf2dab74dab4dde23717028eb90 100644 (file)
--- a/src/glib/gobject.scm
+++ b/src/glib/gobject.scm
@@ -119,12 +119,12 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
     (set-car! id.handle newid)
     (set-cdr! id.handle
              (C-call "g_signal_connect_data" alien
-                     (symbol-name (car name.id.handle))
+                     (string->utf8 (symbol->string (car name.id.handle)))
                      alien-function newid 0 0))))
 
 (define (g-signal-disconnect gobject name)
   (guarantee-gobject gobject 'g-signal-disconnect)
-  (guarantee-symbol name 'g-signal-disconnect)
+  (guarantee symbol? name 'g-signal-disconnect)
   (without-interrupts
    (lambda ()
      (let* ((alien (gobject-alien gobject))
@@ -156,7 +156,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
     (define (unimplemented type)
       (error "Unimplemented property type:" type name gobject))
 
-    (C-call "g_object_get_property" (gobject-alien gobject) name gvalue)
+    (C-call "g_object_get_property" (gobject-alien gobject)
+           (string->utf8 name) gvalue)
     (let* ((type (C-> gvalue "GValue g_type"))
           (value
            (cond
@@ -195,9 +196,9 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
             ((int:= type (C-enum "G_TYPE_STRING"))
              (let ((alien (make-alien '(const (* |gchar|)))))
                (C-call "g_value_get_string" alien gvalue)
-               (let ((str (c-peek-cstring alien)))
+               (let ((bv (c-peek-cstring alien)))
                  (free alien)
-                 str)))
+                 (utf8->string bv))))
             ((int:= type (C-enum "G_TYPE_POINTER"))
              (let ((alien (make-alien '|gpointer|)))
                (C-call "g_value_get_pointer" alien gvalue)
@@ -227,7 +228,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
            (else
             (let ((name (check-prop-name (car plist)))
                   (value (cadr plist)))
-              (C-call "g_object_class_find_property" pspec gclass name)
+              (C-call "g_object_class_find_property"
+                      pspec gclass (string->utf8 name))
               (if (alien-null? pspec)
                   (error "No property:" name gclass-name))
               (let ((flags (C-> pspec "GParamSpec flags")))
@@ -296,7 +298,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
                            (or (C-enum "enum GFundamentalType" fundamental)
                                fundamental)
                            name gclass-name))))
-                (C-call "g_object_set_property" gobject-alien name gvalue)
+                (C-call "g_object_set_property" gobject-alien
+                        (string->utf8 name) gvalue)
                 (C-call "g_value_reset" gvalue)))
             (loop (cddr plist)))))
     (free gtype)
@@ -313,7 +316,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   ;; GCLASS should be an alien of type GObjectClass.
   (let ((c* (make-alien '(* |gchar|))))
     (C-call "G_OBJECT_CLASS_NAME" c* gclass)
-    (c-peek-cstring c*)))
+    (utf8->string (c-peek-cstring c*))))
 
 (define (gobject-get-gtype gobject)
   (let ((ret (make-alien '|GType|)))
@@ -325,7 +328,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (check-prop-name name)
   ;; Allows NAME to be a symbol OR string.
-  (cond ((symbol? name) (symbol-name name))
+  (cond ((symbol? name) (symbol->string name))
        ((string? name) name)
        (else (check-prop-name
               (error "Invalid property name:" name)))))
@@ -400,7 +403,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (gquark-from-string string)
   (or (hash-table/get gquark-from-string-cache string #f)
-      (let ((gq (C-call "g_quark_from_string" string)))
+      (let ((gq (C-call "g_quark_from_string" (string->utf8 string))))
        (hash-table/put! gquark-from-string-cache string gq)
        (hash-table/put! gquark-to-string-cache gq string)
        gq)))