[lambda-gtk-devel] Patch to add support for unicode labels.

[Joslwah]

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)