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)