Dear All,
This patch adds support for passing unicode strings to gtk for labels and the like. gtk supports this, and it works on sbcl/x86 and sbcl/ppc (both sbcl-0.9.9). Can't test it on ppc64 since there isn't a version of sbcl that currently runs on it.
The patch is in two parts. The first part just adds some functions to the api that I need for some of my code. The second part adds support for passing utf8-encoded strings to gtk.
Please apply for sbcl and could someone test for CMUCL etc.
Thanks.
Joslwah.
p.s. Is it possible to increment the version number occasionally? I know of at least two incompatible versions around both carrying the 0.1 label. One works with older versions of sbcl, and one only with newer!
-------------Patch follows------------------------------------------------------------
diff -r -u lambda-gtk_0.1-pre/gtk.api lambda-gtk_0.1/gtk.api
--- lambda-gtk_0.1-pre/gtk.api 2006-02-16 14:07:04.000000000 +0800
+++ lambda-gtk_0.1/gtk.api 2006-02-13 18:49:04.000000000 +0800
@@ -1091,6 +1091,9 @@
(:function "gdk_threads_enter")
(:function "gdk_threads_leave")
(:function "gdk_threads_init")
+(:function "gdk_display_open")
+(:function "gdk_display_get_default_screen")
+(:function "gtk_window_set_screen")
(:function "gtk_accel_group_get_type")
(:function "gtk_accel_group_new")
(:function "gtk_accel_group_lock")
diff -r -u lambda-gtk_0.1-pre/lambda-gtk-cmusbcl.lisp lambda-gtk_0.1/lambda-gtk-cmusbcl.lisp
--- lambda-gtk_0.1-pre/lambda-gtk-cmusbcl.lisp 2006-02-16 14:07:05.000000000 +0800
+++ lambda-gtk_0.1/lambda-gtk-cmusbcl.lisp 2006-02-13 19:10:30.000000000 +0800
@@ -86,7 +86,7 @@
( (void ()) void)
( (pointer (void ())) (* t))
- ( (pointer (char ())) c-string )
+ ( (pointer (char ())) utf8-string )
( (pointer (gchar ())) c-string )
( (pointer (guchar ())) c-string )
@@ -417,12 +417,14 @@
(if (eql (car arg) 'pointer)
(let ((isa (sbcl-type arg)))
(if (or (eql isa 'c-string)
+ (eql isa 'utf8-string)
(equal isa '(* T)))
(list isa)
(let ((x (second isa)))
;;(print (list :x-> x))
(cond ((symbolp x) ; basic type
- (if (eql x 'c-string)
+ (if (or (eql x 'c-string)
+ (eql x 'utf8-string))
(list (list '* t))
(list x ':in-out)))
((stringp x)
