From: Matt Birkholz Date: Sun, 26 Feb 2017 02:17:33 +0000 (-0700) Subject: gtk: Use bytevectors instead of strings. X-Git-Tag: mit-scheme-pucked-9.2.12~211 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c57a4d61d29550275613807926cf9f20c0340031;p=mit-scheme.git gtk: Use bytevectors instead of strings. --- diff --git a/src/gtk/fix-layout.scm b/src/gtk/fix-layout.scm index 8b38b1e8a..2d480dfd9 100644 --- a/src/gtk/fix-layout.scm +++ b/src/gtk/fix-layout.scm @@ -46,7 +46,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define-guarantee fix-widget "a ") -(define-integrable guarantee-size guarantee-non-negative-fixnum) +(define-integrable (guarantee-size object operator) + (guarantee non-negative-fixnum? object operator)) (define-method initialize-instance ((widget ) width height bgcolor) (let ((bg (if (null? bgcolor) @@ -152,7 +153,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (simplify name) ;; |GDK_BASED_ARROW_DOWN| => based-arrow-down - (let ((string (symbol-name name))) + (let ((string (symbol->string name))) (if (string-prefix? "GDK_" string) (intern (string-replace (string-tail string 4) #\_ #\-)) (begin @@ -241,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 (c-peek-cstring alien)) + (let ((string (utf8->string (c-peek-cstring alien))) (char-bits (gdk-key-state->char-bits state))) (cond ((zero? (string-length string)) (cond ((fix:= length 1) @@ -254,7 +255,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. ((and (fix:= 1 (string-length string)) (char=? #\backspace (string-ref string 0))) (let ((name (gdk-keyval->name keyval))) - (cond ((string-ci=? (symbol-name name) "backspace") + (cond ((string-ci=? (symbol->string name) "backspace") (handler widget #\backspace char-bits)) ((memq name '(|h| |H|)) (handler widget #\C-h @@ -321,7 +322,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (floor->exact (C-> GdkEvent "GdkEventButton y"))))) (define (->button-event-type type operator) - (guarantee-symbol type operator) + (guarantee symbol? type operator) (case type ((PRESS) (C-enum "GDK_BUTTON_PRESS")) ((RELEASE) (C-enum "GDK_BUTTON_RELEASE")) @@ -445,8 +446,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (fix-layout-scroll-to! widget x y) (guarantee-fix-layout widget 'fix-layout-scroll-to!) - (guarantee-fixnum x 'fix-layout-scroll-to!) - (guarantee-fixnum y 'fix-layout-scroll-to!) + (guarantee fixnum? x 'fix-layout-scroll-to!) + (guarantee fixnum? y 'fix-layout-scroll-to!) (scroll widget x y)) (define (fix-layout-scroll-nw! widget extent) @@ -511,8 +512,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (set-fix-layout-scroll-step! widget width height) (guarantee-fix-layout widget 'set-fix-layout-scroll-step!) - (guarantee-positive-fixnum width 'set-fix-layout-scroll-step!) - (guarantee-positive-fixnum height 'set-fix-layout-scroll-step!) + (guarantee positive-fixnum? width 'set-fix-layout-scroll-step!) + (guarantee positive-fixnum? height 'set-fix-layout-scroll-step!) (let ((width.height (fix-layout-scroll-step widget))) (set-car! width.height width) (set-cdr! width.height height)) @@ -531,8 +532,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. ;; from the old drawing before the widget sees the new one. (guarantee-fix-layout widget 'set-fix-layout-drawing!) (guarantee-fix-drawing drawing 'set-fix-layout-drawing!) - (guarantee-fixnum x 'set-fix-layout-drawing!) - (guarantee-fixnum y 'set-fix-layout-drawing!) + (guarantee fixnum? x 'set-fix-layout-drawing!) + (guarantee fixnum? y 'set-fix-layout-drawing!) (let* ((old (fix-layout-drawing widget)) (view (fix-layout-view widget))) (if (and (eq? drawing old) (fix-rect-at-point? view x y)) @@ -996,10 +997,10 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (drawing-damage ink)))))) (define (set-line-ink! ink x1 y1 x2 y2) - (guarantee-fixnum x1 'set-line-ink!) - (guarantee-fixnum y1 'set-line-ink!) - (guarantee-fixnum x2 'set-line-ink!) - (guarantee-fixnum y2 'set-line-ink!) + (guarantee fixnum? x1 'set-line-ink!) + (guarantee fixnum? y1 'set-line-ink!) + (guarantee fixnum? x2 'set-line-ink!) + (guarantee fixnum? y2 'set-line-ink!) (without-interrupts (lambda () (let ((vector (line-ink-vector ink)) @@ -1029,7 +1030,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (set-line-ink-width! ink width) (guarantee-line-ink ink 'set-line-ink-width!) - (guarantee-positive-fixnum width 'set-line-ink-width!) + (guarantee positive-fixnum? width 'set-line-ink-width!) (without-interrupts (lambda () (if (set-option!? ink 'LINE-WIDTH (->flonum width)) @@ -1139,8 +1140,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (drawing-damage ink))))) (define (set-rectangle-ink! ink x y width height) - (guarantee-fixnum x 'set-rectangle-ink!) - (guarantee-fixnum y 'set-rectangle-ink!) + (guarantee fixnum? x 'set-rectangle-ink!) + (guarantee fixnum? y 'set-rectangle-ink!) (guarantee-size width 'set-rectangle-ink!) (guarantee-size height 'set-rectangle-ink!) (without-interrupts @@ -1155,8 +1156,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (recache-rectangle-extent! ink))))))) (define (set-rectangle-ink-position! ink x y) - (guarantee-fixnum x 'set-rectangle-ink-position!) - (guarantee-fixnum y 'set-rectangle-ink-position!) + (guarantee fixnum? x 'set-rectangle-ink-position!) + (guarantee fixnum? y 'set-rectangle-ink-position!) (without-interrupts (lambda () (let ((rect (rectangle-ink-rect ink))) @@ -1182,7 +1183,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (set-rectangle-ink-width! ink width) (guarantee-rectangle-ink ink 'set-rectangle-ink-width!) - (guarantee-positive-fixnum width 'set-rectangle-ink-width!) + (guarantee positive-fixnum? width 'set-rectangle-ink-width!) (without-interrupts (lambda () (if (set-option!? ink 'LINE-WIDTH (->flonum width)) @@ -1304,7 +1305,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (set-polygon-ink-width! ink width) (guarantee-polygon-ink ink 'set-polygon-ink-width!) - (guarantee-positive-fixnum width 'set-polygon-ink-width!) + (guarantee positive-fixnum? width 'set-polygon-ink-width!) (without-interrupts (lambda () (if (set-option!? ink 'LINE-WIDTH (->flonum width)) @@ -1392,8 +1393,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (drawing-damage ink))))) (define (set-arc-ink! ink x y width height) - (guarantee-fixnum x 'set-arc-ink!) - (guarantee-fixnum y 'set-arc-ink!) + (guarantee fixnum? x 'set-arc-ink!) + (guarantee fixnum? y 'set-arc-ink!) (guarantee-size width 'set-arc-ink!) (guarantee-size height 'set-arc-ink!) (without-interrupts @@ -1423,7 +1424,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (set-arc-ink-start-angle! arc degrees) (guarantee-arc-ink arc 'set-arc-ink-start-angle!) - (guarantee-real degrees 'set-arc-ink-start-angle!) + (guarantee real? degrees 'set-arc-ink-start-angle!) (let ((new (flo:* (->flonum degrees) (flo:/ flo:pi 180.)))) (if (not (flo:= new (arc-ink-%start-angle arc))) (begin @@ -1436,7 +1437,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (set-arc-ink-sweep-angle! arc degrees) (guarantee-arc-ink arc 'set-arc-ink-sweep-angle!) - (guarantee-real degrees 'set-arc-ink-sweep-angle!) + (guarantee real? degrees 'set-arc-ink-sweep-angle!) (let ((new (flo:* (->flonum degrees) (flo:/ flo:pi 180.)))) (if (not (flo:= new (arc-ink-%sweep-angle arc))) (begin @@ -1449,7 +1450,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (set-arc-ink-width! ink width) (guarantee-arc-ink ink 'set-arc-ink-width!) - (guarantee-positive-fixnum width 'set-arc-ink-width!) + (guarantee positive-fixnum? width 'set-arc-ink-width!) (without-interrupts (lambda () (if (set-option!? ink 'LINE-WIDTH (->flonum width)) @@ -1509,8 +1510,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (draw-ink-options ink))) (define (set-text-ink-position! ink x y) - (guarantee-fixnum x 'set-text-ink-position!) - (guarantee-fixnum y 'set-text-ink-position!) + (guarantee fixnum? x 'set-text-ink-position!) + (guarantee fixnum? y 'set-text-ink-position!) (without-interrupts (lambda () (let ((rect (fix-ink-extent ink))) @@ -1597,7 +1598,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. ;; The TEXT string is shared. (guarantee-simple-text-ink ink 'set-simple-text-ink-text!) (guarantee-gtk-widget widget 'set-simple-text-ink-text!) - (guarantee-string text 'set-simple-text-ink-text!) + (guarantee string? text 'set-simple-text-ink-text!) (without-interrupts (lambda () (let ((old (simple-text-ink-text ink))) @@ -1713,8 +1714,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. ink)) (define (set-image-ink! ink x y) - (guarantee-fixnum x 'set-image-ink-position!) - (guarantee-fixnum y 'set-image-ink-position!) + (guarantee fixnum? x 'set-image-ink-position!) + (guarantee fixnum? y 'set-image-ink-position!) (set-fix-ink-%position! ink x y)) (define-class ( (constructor () (width height))) @@ -1907,8 +1908,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (fix:<= min-y1 min-y2) (fix:<= max-y2 max-y1))))))) (define (gdk-rectangle #!optional x y width height) - (if (not (default-object? x)) (guarantee-fixnum x 'gdk-rectangle)) - (if (not (default-object? y)) (guarantee-fixnum y 'gdk-rectangle)) + (if (not (default-object? x)) (guarantee fixnum? x 'gdk-rectangle)) + (if (not (default-object? y)) (guarantee fixnum? y 'gdk-rectangle)) (if (not (default-object? width)) (guarantee-size width 'gdk-rectangle)) (if (not (default-object? height)) (guarantee-size height 'gdk-rectangle)) (let ((alien (malloc (C-sizeof "GdkRectangle") '|GdkRectangle|))) diff --git a/src/gtk/gdk.scm b/src/gtk/gdk.scm index cd79e8002..85cdbe520 100644 --- a/src/gtk/gdk.scm +++ b/src/gtk/gdk.scm @@ -141,8 +141,9 @@ 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)) - (c-peek-cstring - (C-> gerror "GError message"))) + (utf8->string + (c-peek-cstring + (C-> gerror "GError message")))) "GError pointer not set."))) (set-pixbuf-loader-error-message! loader message)) (note-done)) @@ -265,7 +266,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (if entry (cdr entry) (let ((atom (make-alien '(struct |_GdkAtom|)))) - (C-call "gdk_atom_intern" atom (symbol-name symbol) 0) + (C-call "gdk_atom_intern" atom + (string->utf8 (symbol->string symbol)) 0) (set-gdk-display/atoms! display (cons (cons symbol atom) (gdk-display/atoms display))) @@ -273,10 +275,10 @@ 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))) + (let ((string-bv (string->utf8 string))) (C-call "gtk_clipboard_set_text" (clipboard display) - string (string-length string)))) + string-bv (bytevector-length string-bv)))) (define (gdk-display-get-clipboard-text display msec) (%trace "; gdk-display-get-clipboard-text "display" "msec"\n") @@ -306,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 (c-peek-cstring char*)))))) + (queue! queue (utf8->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 4a41a842b..d761847b1 100644 --- a/src/gtk/gtk-ev.scm +++ b/src/gtk/gtk-ev.scm @@ -302,7 +302,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (event-name-line GdkEvent) (let ((type (C-> GdkEvent "GdkEvent any type"))) - (string-append (symbol-name (C-enum "GdkEventType" type)) "\n"))) + (string-append (symbol->string (C-enum "GdkEventType" type)) "\n"))) (define (any-event-line GdkEvent) (let ((event-time (C-call "gdk_event_get_time" GdkEvent)) @@ -384,8 +384,8 @@ 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) - (c-peek-cstring alien)))) - (cat "Keyval: "keyval" Text: "(write-to-string text)"\n"))) + (utf8->string (c-peek-cstring alien))))) + (cat "Keyval: "keyval" Text: "text"\n"))) (else #f)))) diff --git a/src/gtk/gtk-graphics.scm b/src/gtk/gtk-graphics.scm index 8e59c2a20..7444ba2f8 100644 --- a/src/gtk/gtk-graphics.scm +++ b/src/gtk/gtk-graphics.scm @@ -70,8 +70,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (let ((width (if (default-object? width) 512 width)) (height (if (default-object? height) 384 height)) (no-window? (if (default-object? no-window?) #f no-window?))) - (guarantee-positive-fixnum width 'gtk-graphics/open) - (guarantee-positive-fixnum height 'gtk-graphics/open) + (guarantee positive-fixnum? width 'gtk-graphics/open) + (guarantee positive-fixnum? height 'gtk-graphics/open) (if no-window? (make-device (make-gtk-graphics width height)) (let ((window (gtk-window-new 'toplevel)) diff --git a/src/gtk/gtk-tests.scm b/src/gtk/gtk-tests.scm index 158cfef0e..a0eef89fd 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)) - (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/gtk/gtk-widget.scm b/src/gtk/gtk-widget.scm index 168c09e91..6a3b93b89 100644 --- a/src/gtk/gtk-widget.scm +++ b/src/gtk/gtk-widget.scm @@ -37,11 +37,11 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. lower upper page-size step-incr page-incr) (guarantee-live-gtk-adjustment adjustment 'set-gtk-adjustment!) - (guarantee-real lower 'set-gtk-adjustment!) - (guarantee-real upper 'set-gtk-adjustment!) - (guarantee-real page-size 'set-gtk-adjustment!) - (guarantee-real step-incr 'set-gtk-adjustment!) - (guarantee-real page-incr 'set-gtk-adjustment!) + (guarantee real? lower 'set-gtk-adjustment!) + (guarantee real? upper 'set-gtk-adjustment!) + (guarantee real? page-size 'set-gtk-adjustment!) + (guarantee real? step-incr 'set-gtk-adjustment!) + (guarantee real? page-incr 'set-gtk-adjustment!) (define-integrable f->e floor->exact) (let ((alien (gobject-alien adjustment)) (new-lower (f->e lower)) @@ -198,12 +198,12 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (gtk-widget-create-pango-layout widget #!optional text) (guarantee-gtk-widget widget 'gtk-widget-create-pango-layout) (if (not (default-object? text)) - (guarantee-string text 'gtk-widget-create-pango-layout)) + (guarantee string? text 'gtk-widget-create-pango-layout)) (let* ((layout (make-pango-layout)) (alien (gobject-alien layout))) (C-call "gtk_widget_create_pango_layout" alien (gobject-alien widget) - (if (default-object? text) 0 text)) + (if (default-object? text) 0 (string->utf8 text))) (error-if-null alien "Could not create:" layout) layout)) @@ -274,15 +274,15 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (gtk-widget-set-opacity widget opacity) (guarantee-gtk-widget widget 'gtk-widget-set-opacity) - (guarantee-real opacity 'gtk-widget-set-opacity) + (guarantee real? opacity 'gtk-widget-set-opacity) (if (not (<= 0. opacity 1.)) (error:bad-range-argument opacity 'gtk-widget-set-opacity)) (C-call "gtk_widget_set_opacity" (gobject-alien widget) opacity)) (define (gtk-widget-set-name widget name) (guarantee-gtk-widget widget 'gtk-widget-set-name) - (guarantee-string name 'gtk-widget-set-name) - (C-call "gtk_widget_set_name" (gobject-alien widget) name)) + (guarantee string? name 'gtk-widget-set-name) + (C-call "gtk_widget_set_name" (gobject-alien widget) (string->utf8 name))) ;;; GtkStyleContext & GtkCssProvider @@ -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 (c-peek-cstring (C-> gerror "GError message")))) + (let ((errmsg-bv (c-peek-cstring (C-> gerror "GError message")))) (without-interruption (lambda () (C->= gerror* "* GError" 0) (C-call "g_error_free" gerror))) - (apply error message errmsg data))))) + (apply error message (utf8->string errmsg-bv) data))))) (define-class ( (constructor ())) ()) @@ -381,15 +381,15 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. object)) (define (gtk-css-provider-get-named name variant) - (guarantee-string name 'gtk-css-provider-get-named) + (guarantee string? name 'gtk-css-provider-get-named) (let* ((v (if (eq? #f variant) 0 (begin - (guarantee-string variant 'gtk-css-provider-get-named) - variant))) + (guarantee string? variant 'gtk-css-provider-get-named) + (string->utf8 variant)))) (object (make-gtk-css-provider)) (alien (gobject-alien object))) - (C-call "gtk_css_provider_get_named" alien name v) + (C-call "gtk_css_provider_get_named" alien (string->utf8 name) v) (error-if-null alien "Could not get named GtkCssProvider:" object name variant) (C-call "g_object_ref" alien alien) @@ -397,10 +397,11 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (gtk-css-provider-load-from-data provider string) (guarantee-gtk-css-provider provider 'gtk-css-provider-load-from-data) - (guarantee-string string 'gtk-css-provider-load-from-data) + (guarantee string? string 'gtk-css-provider-load-from-data) (let ((alien (gobject-alien provider)) - (gerror* (gobject-gerror* provider))) - (C-call "gtk_css_provider_load_from_data" alien string -1 gerror*) + (gerror* (gobject-gerror* provider)) + (string-bv (string->utf8 string))) + (C-call "gtk_css_provider_load_from_data" alien string-bv -1 gerror*) (error-if-gerror* gerror* "Could not load GtkCssProvider data:" provider))) (define-guarantee gfile "a ") @@ -422,7 +423,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (merge-pathnames pathname (working-directory-pathname))))) (alien (gobject-alien provider)) (gerror* (gobject-gerror* provider))) - (C-call "gtk_css_provider_load_from_path" alien namestring gerror*) + (C-call "gtk_css_provider_load_from_path" alien + (string->utf8 namestring) gerror*) (error-if-gerror* gerror* "Could not load GtkCssProvider path:" provider namestring))) @@ -460,7 +462,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (gtk-container-set-border-width container width) (guarantee-gtk-container container 'gtk-container-set-border-width) - (guarantee-positive-fixnum width 'gtk-container-set-border-width) + (guarantee positive-fixnum? width 'gtk-container-set-border-width) (C-call "gtk_container_set_border_width" (gobject-alien container) width)) (define (container-add! container child) @@ -494,28 +496,28 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define-method initialize-instance ((label ) string) (call-next-method label) (let ((alien (gobject-alien label))) - (C-call "gtk_label_new" alien string) + (C-call "gtk_label_new" alien (string->utf8 string)) (error-if-null alien "Could not create:" label string) (C-call "g_object_ref_sink" alien alien)) (set-gtk-widget-destroy-callback! label)) (define (gtk-label-new string) - (guarantee-string string 'gtk-label-new) + (guarantee string? string 'gtk-label-new) (make-gtk-label string)) (define (gtk-label-get-text label) (guarantee-gtk-label label 'gtk-label-get-text) (let ((retval (make-alien '|gchar|))) (C-call "gtk_label_get_text" retval (gobject-alien label)) - (c-peek-cstring retval))) + (utf8->string (c-peek-cstring retval)))) (define (gtk-label-set-text label string) (guarantee-gtk-label label 'gtk-label-set-text) - (guarantee-string string 'gtk-label-set-text) - (C-call "gtk_label_set_text" (gobject-alien label) string)) + (guarantee string? string 'gtk-label-set-text) + (C-call "gtk_label_set_text" (gobject-alien label) (string->utf8 string))) (define (gtk-label-set-width-chars label n-chars) - (guarantee-non-negative-fixnum n-chars 'set-label-width!) + (guarantee non-negative-fixnum? n-chars 'set-label-width!) (C-call "gtk_label_set_width_chars" (gobject-alien label) n-chars)) ;;; GtkButtons @@ -602,21 +604,21 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (gtk-grid-set-row-spacing grid spacing) (guarantee-gtk-grid grid 'gtk-grid-set-row-spacing) - (guarantee-non-negative-fixnum spacing 'gtk-grid-set-row-spacing) + (guarantee non-negative-fixnum? spacing 'gtk-grid-set-row-spacing) (C-call "gtk_grid_set_row_spacing" (gobject-alien grid) spacing)) (define (gtk-grid-set-column-spacing grid spacing) (guarantee-gtk-grid grid 'gtk-grid-set-column-spacing) - (guarantee-non-negative-fixnum spacing 'gtk-grid-set-column-spacing) + (guarantee non-negative-fixnum? spacing 'gtk-grid-set-column-spacing) (C-call "gtk_grid_set_column_spacing" (gobject-alien grid) spacing)) (define (gtk-grid-attach grid widget left top width height) (guarantee-gtk-grid grid 'gtk-grid-attach) (guarantee-gtk-widget widget 'gtk-grid-attach) - (guarantee-fixnum left 'gtk-grid-attach) - (guarantee-fixnum top 'gtk-grid-attach) - (guarantee-fixnum width 'gtk-grid-attach) - (guarantee-fixnum height 'gtk-grid-attach) + (guarantee fixnum? left 'gtk-grid-attach) + (guarantee fixnum? top 'gtk-grid-attach) + (guarantee fixnum? width 'gtk-grid-attach) + (guarantee fixnum? height 'gtk-grid-attach) (container-add! grid widget) (C-call "gtk_grid_attach" (gobject-alien grid) (gobject-alien widget) left top width height)) @@ -625,8 +627,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (guarantee-gtk-grid grid 'gtk-grid-attach-next-to) (guarantee-gtk-widget child 'gtk-grid-attach-next-to) (if sibling (guarantee-gtk-widget sibling 'gtk-grid-attach-next-to)) - (guarantee-fixnum width 'gtk-grid-attach-next-to) - (guarantee-fixnum height 'gtk-grid-attach-next-to) + (guarantee fixnum? width 'gtk-grid-attach-next-to) + (guarantee fixnum? height 'gtk-grid-attach-next-to) (let ((side-num (->side side 'gtk-grid-attach-next-to))) (container-add! grid child) (C-call "gtk_grid_attach_next_to" @@ -675,13 +677,14 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define-method initialize-instance ((frame ) label) (call-next-method frame) (let ((alien (gobject-alien frame))) - (C-call "gtk_frame_new" alien label) + (C-call "gtk_frame_new" alien + (if (string-null? label) 0 (string->utf8 label))) (error-if-null alien "Could not create:" frame) (C-call "g_object_ref_sink" alien alien)) (set-gtk-widget-destroy-callback! frame)) (define (gtk-frame-new label) - (guarantee-string label 'gtk-frame-new) + (guarantee string? label 'gtk-frame-new) (make-gtk-frame label)) (define (gtk-frame-set-shadow-type frame type) @@ -859,8 +862,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (gtk-window-set-title window title) (guarantee-gtk-window window 'gtk-window-set-title) - (guarantee-string title 'gtk-window-set-title) - (C-call "gtk_window_set_title" (gobject-alien window) title)) + (guarantee string? title 'gtk-window-set-title) + (C-call "gtk_window_set_title" (gobject-alien window) (string->utf8 title))) (define (gtk-window-set-type-hint window hint) (guarantee-gtk-window window 'gtk-window-set-type-hint) @@ -898,8 +901,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (gtk-window-set-default-size window width height) (guarantee-gtk-window window 'gtk-window-set-default-size) - (guarantee-integer width 'gtk-window-set-default-size) - (guarantee-integer height 'gtk-window-set-default-size) + (guarantee integer? width 'gtk-window-set-default-size) + (guarantee integer? height 'gtk-window-set-default-size) (C-call "gtk_window_set_default_size" (gobject-alien window) width height)) (define (gtk-window-set-geometry-hints window widget . hints) @@ -1004,8 +1007,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (gtk-window-resize window width height) (guarantee-gtk-window window 'gtk-window-resize) - (guarantee-positive-fixnum width 'gtk-window-resize) - (guarantee-positive-fixnum height 'gtk-window-resize) + (guarantee positive-fixnum? width 'gtk-window-resize) + (guarantee positive-fixnum? height 'gtk-window-resize) (C-call "gtk_window_resize" (gobject-alien window) width height)) (define (gtk-window-present window) @@ -1035,6 +1038,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (gtk-window-set-clipboard-text window string) (guarantee-gtk-window window 'gtk-window-set-clipboard-text) + (guarantee string? string 'gtk-window-set-clipboard-text) (let* ((gdkdisplay (C-call "gtk_widget_get_display" (make-alien '|GtkDisplay|) (gobject-alien window))) diff --git a/src/gtk/keys.scm b/src/gtk/keys.scm index c11567be9..9fbd14185 100644 --- a/src/gtk/keys.scm +++ b/src/gtk/keys.scm @@ -50,7 +50,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (map (lambda (gdk-name.keyval) (let* ((keyval (cdr gdk-name.keyval)) (gdk-name (car gdk-name.keyval)) - (string (symbol-name gdk-name)) + (string (symbol->string gdk-name)) (name (cond ((string-prefix? "GDK_KEY_" string) (string->symbol (string-tail string 8))) (else diff --git a/src/gtk/main.scm b/src/gtk/main.scm index 983c1846d..7b9b01072 100644 --- a/src/gtk/main.scm +++ b/src/gtk/main.scm @@ -71,25 +71,26 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. 'INIT-GTK)) (vars-size (+ (C-sizeof "int") ;gtk_init_check return var (C-sizeof "* * char")))) ;gtk_init_check return var - (guarantee-string name 'INIT-GTK) + (guarantee string? name 'INIT-GTK) (let* ((words (cons name args)) + (words-bv (map string->utf8 words)) (vector-size (* (C-sizeof "* char") (+ 1 arg-count))) (total-size (+ vars-size vector-size (fold-left (lambda (sum arg) - (+ sum (string-length arg) 1)) ;null terminated - 0 words))) + (+ sum (bytevector-length arg) 1)) ;null terminated + 0 words-bv))) (bytes (malloc total-size #f)) (vector (alien-byte-increment bytes vars-size)) (word-scan (alien-byte-increment vector vector-size)) (vector-scan (copy-alien vector)) (count-var bytes) (vector-var (alien-byte-increment count-var (C-sizeof "int")))) - (for-each (lambda (word) + (for-each (lambda (word-bv) (c-poke-pointer! vector-scan word-scan) - (c-poke-string! word-scan word)) - words) + (c-poke-string! word-scan word-bv)) + words-bv) (C->= count-var "int" (+ 1 arg-count)) (C->= vector-var "* * char" vector) (if (fix:zero? (C-call "gtk_init_check" count-var vector-var)) @@ -100,7 +101,9 @@ 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 (c-peek-cstringp! vector-scan) args)) + (cons (utf8->string + (c-peek-cstringp! vector-scan)) + args)) (reverse! args))))) (free bytes) (set! initialized? #t) diff --git a/src/gtk/scm-widget.scm b/src/gtk/scm-widget.scm index a68c2cc47..c63d6f349 100644 --- a/src/gtk/scm-widget.scm +++ b/src/gtk/scm-widget.scm @@ -44,16 +44,16 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define (set-scm-widget-minimum-size! widget width height) (guarantee-scm-widget widget 'set-scm-widget-minimum-size!) - (guarantee-non-negative-fixnum width 'set-scm-widget-minimum-size!) - (guarantee-non-negative-fixnum height 'set-scm-widget-minimum-size!) + (guarantee non-negative-fixnum? width 'set-scm-widget-minimum-size!) + (guarantee non-negative-fixnum? height 'set-scm-widget-minimum-size!) (let ((a (gobject-alien widget))) (C->= a "ScmWidget minimum_width" width) (C->= a "ScmWidget minimum_height" height))) (define (set-scm-widget-natural-size! widget width height) (guarantee-scm-widget widget 'set-scm-widget-natural-size!) - (guarantee-non-negative-fixnum width 'set-scm-widget-natural-size!) - (guarantee-non-negative-fixnum height 'set-scm-widget-natural-size!) + (guarantee non-negative-fixnum? width 'set-scm-widget-natural-size!) + (guarantee non-negative-fixnum? height 'set-scm-widget-natural-size!) (let ((a (gobject-alien widget))) (C->= a "ScmWidget natural_width" width) (C->= a "ScmWidget natural_height" height))) \ No newline at end of file diff --git a/src/gtk/swat.scm b/src/gtk/swat.scm index 1ecdf37e6..99427f2f2 100644 --- a/src/gtk/swat.scm +++ b/src/gtk/swat.scm @@ -205,8 +205,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (unset! (cdr items))))))) (define (item-move! item dx dy) - (guarantee-fixnum dx 'item-move!) - (guarantee-fixnum dy 'item-move!) + (guarantee fixnum? dx 'item-move!) + (guarantee fixnum? dy 'item-move!) (if (not (and (fix:zero? dx) (fix:zero? dy))) (without-interrupts (lambda () @@ -484,7 +484,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (lambda () (set-swat-text-%anchor! text anchor))))) (define (set-swat-text-text! text string) - (guarantee-string string 'set-swat-text-text!) + (guarantee string? string 'set-swat-text-text!) (if (eq? 'nw (swat-text-anchor text)) (set-simple-text-ink-text! text string) (hold-position text (lambda () (set-simple-text-ink-text! text string))))) @@ -650,18 +650,18 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define-generic set-text! (widget string)) (define-method set-text! ((button ) string) - (guarantee-string string '(set-text! )) + (guarantee string? string '(set-text! )) (let ((label (gtk-bin-child button))) (if (not label) (gtk-container-add button (gtk-label-new string)) (gtk-label-set-text label string)))) (define-method set-text! ((label ) string) - (guarantee-string string '(set-text! )) + (guarantee string? string '(set-text! )) (gtk-label-set-text (gtk-bin-child label) string)) (define-method set-text! ((button ) string) - (guarantee-string string '(set-text! )) + (guarantee string? string '(set-text! )) (let ((label (gtk-bin-child button))) (if (not label) (gtk-container-add button (gtk-label-new string)) @@ -797,7 +797,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define-generic set-item-text! (item value)) (define-method set-item-text! ((text ) string) - (guarantee-string string '(set-item-text! )) + (guarantee string? string '(set-item-text! )) (set-swat-text-text! text string)) (define-generic set-item-width! (item value)) @@ -806,10 +806,10 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (if head (set-polygon-ink-width! head width))) (set-line-ink-width! item width)) (define-method set-item-width! ((item ) width) - (guarantee-positive-fixnum width '(set-item-width! )) + (guarantee positive-fixnum? width '(set-item-width! )) (set-arc-ink-width! item width)) (define-method set-item-width! ((item ) width) - (guarantee-positive-fixnum width '(set-item-width! )) + (guarantee positive-fixnum? width '(set-item-width! )) (set-rectangle-ink-width! item width)) ;;;; SWAT Interface @@ -1024,7 +1024,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. ;;; ClearArea, initialize-uitk!. (define (after-delay seconds thunk) - (guarantee-index-fixnum seconds 'after-delay) + (guarantee index-fixnum? seconds 'after-delay) (guarantee-procedure-of-arity thunk 0 'after-delay) (detach-thread (create-thread @@ -1178,30 +1178,30 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (for-each fix-ink-remove! (fix-drawing-display-list drawing)))) (define (make-line-on-canvas canvas x1 y1 x2 y2) - (guarantee-fixnum x1 'make-line-on-canvas) - (guarantee-fixnum y1 'make-line-on-canvas) - (guarantee-fixnum x2 'make-line-on-canvas) - (guarantee-fixnum y2 'make-line-on-canvas) + (guarantee fixnum? x1 'make-line-on-canvas) + (guarantee fixnum? y1 'make-line-on-canvas) + (guarantee fixnum? x2 'make-line-on-canvas) + (guarantee fixnum? y2 'make-line-on-canvas) (let ((item (make-swat-line))) (set-line-ink! item x1 y1 x2 y2) (fix-drawing-add-ink! (fix-layout-drawing canvas) item) item)) (define (make-rectangle-on-canvas canvas x y width height) - (guarantee-fixnum x 'make-rectangle-on-canvas) - (guarantee-fixnum y 'make-rectangle-on-canvas) - (guarantee-positive-fixnum width 'make-rectangle-on-canvas) - (guarantee-positive-fixnum height 'make-rectangle-on-canvas) + (guarantee fixnum? x 'make-rectangle-on-canvas) + (guarantee fixnum? y 'make-rectangle-on-canvas) + (guarantee positive-fixnum? width 'make-rectangle-on-canvas) + (guarantee positive-fixnum? height 'make-rectangle-on-canvas) (let ((item (make-swat-rectangle))) (set-rectangle-ink! item x y width height) (fix-drawing-add-ink! (fix-layout-drawing canvas) item) item)) (define (make-oval-on-canvas canvas x1 y1 x2 y2) - (guarantee-fixnum x1 'make-oval-on-canvas) - (guarantee-fixnum y1 'make-oval-on-canvas) - (guarantee-fixnum x2 'make-oval-on-canvas) - (guarantee-fixnum y2 'make-oval-on-canvas) + (guarantee fixnum? x1 'make-oval-on-canvas) + (guarantee fixnum? y1 'make-oval-on-canvas) + (guarantee fixnum? x2 'make-oval-on-canvas) + (guarantee fixnum? y2 'make-oval-on-canvas) (let ((x (fix:min x1 x2)) (y (fix:min y1 y2)) (width (fix:abs (fix:- x2 x1))) @@ -1217,7 +1217,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (let ((text (find-option options '-text "")) (anchor (find-option options '-anchor 'center)) (ink (make-swat-text))) - (guarantee-string text 'make-text-on-canvas) + (guarantee string? text 'make-text-on-canvas) (set-simple-text-ink-text! ink canvas text) (set-text-ink-position! ink x y) (set-swat-text-anchor! ink anchor)