Many fixes and enhancement about font handling

[Shun-ichi TAHARA <jado flowernet gr jp>]

Again, I fixed and enhancement(?) about font handling on Sawfish-1.3.

* Pango fontname handler has a bug on some font name, for example,
  "Nimbus Sans L". When set one of those fonts in "appearance" menu of
  sawfish-ui, and call that menu again, then the font name in dialog
  is reset to the default value of "Sans". Pango font name needs comma
  after the font family name if the last word of family name matches
  the style name (for example, "L" in "Nimbus Sans L" matches "Light").
  So if set "Nimbus Sans L" with its size 12, sawfish holds the pango
  fontname "Nimbus Sans L 12", but GTK+ font selector extract it with
  the family name to be "Nimbus Sans", the style "L (=Light)", the
  size "12". In this case, sawfish must have the pango fontname as
  "Nimbus Sans L, 12".

* When using xft-type fonts, cannot set the font with hyphens in its
  name, for example, "Eras-Black". Xft font name separates the font
  family name and font size by hyphen, so Xft font loader cannot
  extract font name and size correctly. Xft requires hyphens in the
  font family name escaped by backslash, so sawfish must have the xft
  fontname as "Eras\-Black-12", not "Eras-Black-12".

* Sawfish checks the environment valiable "GDK_USE_XFT" to decide
  whether to use Xft; it will be activated if "GDK_USE_XFT" is set and
  the value is not "0". But this rule is for GTK+-2.0. GTK+-2.2 has
  the different rule; if "GDK_USE_XFT" is not set, Xft is activated
  too.

* When using xlfd-type fonts, selecting "medium" or "r" style (in XLFD
  description) are sometime void, because the descripiton of "-*-" in
  XLFD often matches "-bold-" or "-i-". Sawfish must have xlfd font
  name with its weight or slant description to be set explicitly; like
  "-medium-" or "-r-", not "-*-".

* When using Xft, localized window titles are broken. X applications
  hold the localized window title with the charset of local locale,
  but Xft requires the strings with UTF-8 charset. And must use
  XftDrawStringUtf8(), not XftDrawString8().

* Oppositely, when using xlfd-type fonts, then the localized tooltips
  are broken. Legacy X API handles strings with local-localed charset,
  but sawfish has message catalogues with UTF-8 charset. So must
  convert UTF-8 into local charset in fontstruct ane fontset handler.

* When Xft is activated, set the default font into xft-type one. It is
  not a buf-fix, but I think it is a pretty enhancement.

The following patch fixes features listed above. Regards.
# I have one more patch to submit :-)...
--
S. Tahara

diff -ru sawfish-1.3.orig/lisp/sawfish/gtk/widgets/font.jl sawfish-1.3/lisp/sawfish/gtk/widgets/font.jl
--- sawfish-1.3.orig/lisp/sawfish/gtk/widgets/font.jl	2003-01-13 05:30:45.000000000 +0900
+++ sawfish-1.3/lisp/sawfish/gtk/widgets/font.jl	2003-08-12 08:17:26.000000000 +0900
@@ -29,12 +29,12 @@
 	  sawfish.gtk.widget
 	  sawfish.wm.util.font)
 
-  (defconst default-font "fixed")
-
   ;; FIXME: this is broken, in that only if Xrender is present
   ;; does gdk use Xft. But, it's the best I can do..
   (define use-xft (let ((x (getenv "GDK_USE_XFT")))
-		    (and x (/= (string->number x) 0))))
+		    (or (null x) (/= (string->number x) 0))))
+
+  (define default-font (if use-xft "Sans" "Fixed"))
 
   (define (make-font-item changed-callback)
     (let* ((box (gtk-hbox-new nil box-spacing))
diff -ru sawfish-1.3.orig/lisp/sawfish/wm/util/font.jl sawfish-1.3/lisp/sawfish/wm/util/font.jl
--- sawfish-1.3.orig/lisp/sawfish/wm/util/font.jl	2002-11-09 13:45:22.000000000 +0900
+++ sawfish-1.3/lisp/sawfish/wm/util/font.jl	2003-08-12 10:43:34.000000000 +0900
@@ -94,18 +94,19 @@
 
   (define (xft-description->face name)
     (let* ((fields (string-split "\\s*:\\s*" name))
-	   (family "sans")
+	   (fam-siz (car fields))
+	   (family "Sans")
 	   (size nil))
 
       ;; extract family and size
-      (when (car fields)
-	(cond ((string-match "\\s*-\\s*" (car fields))
-	       (setq family (substring (car fields) 0 (match-start)))
-	       (setq size (string->number
-			   (substring (car fields) (match-end)))))
-	      ((string-looking-at "\\d+" (car fields))
-	       (setq size (string->number (car fields))))
-	      (t (setq family (car fields)))))
+      (when fam-siz
+	(cond ((string-match "[^\\](\\s*-\\s*)" fam-siz)
+	       (setq family (substring fam-siz 0 (match-start 1)))
+	       (setq size (string->number (substring fam-siz (match-end 1)))))
+	      ((string-looking-at "\\d+" fam-siz)
+	       (setq size (string->number fam-siz)))
+	      (t (setq family fam-siz)))
+	(setq family (string-replace "\\\\-" "-" family)))
 
       ;; extract styles
       (let loop ((rest (cdr fields))
@@ -125,7 +126,7 @@
 		(t (loop (cdr rest) styles)))))))
 
   (define (face->xft-description face)
-    (let ((families (face-families face))
+    (let ((families (string-replace "-" "\\-" (face-families face)))
 	  (size (face-size face))
 	  (styles (face-styles face)))
       (mapconcat identity
@@ -165,13 +166,19 @@
       ("Heavy" "weight" . "black")))		;FIXME?
 
   (define (pango-description->face name)
-    (let ((fields (string-split " " name))
-	  (family "sans")
+    (let ((fields (string-split "\\s*,\\s*" name))
+	  (family "Sans")
+	  (force-family nil)
 	  (size nil)
 	  (styles '()))
 
+      ;; if comma found in name, it separates family name and styles
+      (when (> (length fields) 1)
+	(setq force-family (car fields))
+	(setq fields (list (mapconcat identity fields #\space))))
+
       ;; have to parse backwards, since family names may contain spaces..
-      (setq fields (nreverse fields))
+      (setq fields (nreverse (string-split "\\s+" (car fields))))
 
       ;; look for a size at the end of the string
       (when (string-match "\\s*(\\d+)\\s*$" (car fields))
@@ -184,21 +191,34 @@
 				 (car fields) pango-style-map)) styles))
 	(setq fields (cdr fields)))
 
-      ;; whatever's left is the family name
-      (setq family (mapconcat identity (nreverse fields) #\space))
+      ;; whatever's left is the family name, except of that comma found in name
+      (if force-family
+	  (setq family force-family)
+	(setq family (mapconcat identity (nreverse fields) #\space)))
 
       (make-face family size styles)))
 
+  (define (assoc-grep regexp alist #!optional case-fold)
+    (catch 'found
+      (mapc (lambda (x) (if (string-match regexp (car x) 0 case-fold)
+			    (throw 'found x)))
+	alist)))
+
   (define (face->pango-description face)
     (let loop ((rest (face-styles face))
 	       (out '()))
       (if (null rest)
-	  (mapconcat identity
-		     (nconc (list (face-families face))
-			    (nreverse out)
-			    (and (face-size face)
-				 (list (format nil "%d" (face-size face)))))
-		     #\space)
+	  (let* ((family (face-families face))
+		 (regexp (concat "^" (last (string-split "\\s+" family)))))
+	    (when (and (not (string-equal family ""))
+		       (assoc-grep regexp pango-style-map t))
+	      (setq family (concat family ",")))
+	    (mapconcat identity
+		       (nconc (list family)
+			      (nreverse out)
+			      (and (face-size face)
+				   (list (format nil "%d" (face-size face)))))
+		       #\space))
 	(let ((tem (rassoc (car rest) pango-style-map)))
 	  (if tem
 	      (loop (cdr rest) (cons (car tem) out))
@@ -208,8 +228,7 @@
 ;; XLFD naming scheme
 
   (define xlfd-style-names
-    '((3 . "weight")
-      (5 . "width")
+    '((5 . "width")
       (6 . "add-style")
       (8 . "point-size")
       (9 . "resolution-x")
@@ -231,7 +250,7 @@
   (define (xlfd-description->face name)
     (let* ((fields (string-split "-" name))
 	   (nfields (length fields))
-	   (family "sans")
+	   (family "Sans")
 	   (size nil)
 	   (styles '()))
 
@@ -242,15 +261,20 @@
 
 	;; normal XLFD string
 
-	(unless (or (<= fields 2) (string= (nth 2 fields) "*"))
+	(unless (or (<= nfields 2) (string= (nth 2 fields) "*"))
 	  (setq family (nth 2 fields)))
 
-	(unless (or (<= fields 7) (string= (nth 7 fields) "*"))
+	(unless (or (<= nfields 7) (string= (nth 7 fields) "*"))
 	  (setq size (string->number (nth 7 fields))))
 
+	(when (> nfields 3)
+	  (let ((weight (nth 3 fields)))
+	    (when (not (string= weight "medium"))
+	      (setq styles (cons (cons "weight" weight) styles)))))
+
 	(when (> nfields 4)
 	  (let ((slant (nth 4 fields)))
-	    (when (assoc slant xlfd-slant-map)
+	    (when (and (not (string= slant "r")) (assoc slant xlfd-slant-map))
 	      (setq styles (cons (cons "slant"
 				       (cdr (assoc slant xlfd-slant-map)))
 				 styles)))))
@@ -281,10 +305,13 @@
 	(cond ((= i 2)
 	       (setq out (cons (face-families face) out)))
 
+	      ((= i 3)
+	       (setq out (cons (or (face-style face "weight") "medium") out)))
+
 	      ((= i 4)
 	       (let ((slant (car (rassoc (face-style face "slant")
 					 xlfd-slant-map))))
-		 (setq out (cons (or slant "*") out))))
+		 (setq out (cons (or slant "r") out))))
 
 	      ((= i 7)
 	       (setq out (cons (if (face-size face)
diff -ru sawfish-1.3.orig/src/Makefile.in sawfish-1.3/src/Makefile.in
--- sawfish-1.3.orig/src/Makefile.in	2002-09-29 05:15:33.000000000 +0900
+++ sawfish-1.3/src/Makefile.in	2003-08-12 08:17:26.000000000 +0900
@@ -38,7 +38,7 @@
 	  sawfish/wm/util/play-sample.la
 DL_DIRS = sawfish/wm/util
 
-override CFLAGS := $(CFLAGS) $(REP_CFLAGS) $(IMAGE_CFLAGS) $(X11_CFLAGS) $(ESD_CFLAGS)
+override CFLAGS := $(CFLAGS) $(REP_CFLAGS) $(IMAGE_CFLAGS) $(X11_CFLAGS) $(ESD_CFLAGS) $(GTK_CFLAGS)
 
 all : sawfish libclient.o $(DL_OBJS) .libexec gtk-style
 
diff -ru sawfish-1.3.orig/src/fonts.c sawfish-1.3/src/fonts.c
--- sawfish-1.3.orig/src/fonts.c	2002-11-04 06:00:36.000000000 +0900
+++ sawfish-1.3/src/fonts.c	2003-08-12 11:01:59.000000000 +0900
@@ -44,6 +44,7 @@
 
 #ifdef HAVE_X11_XFT_XFT_H
 # include <X11/Xft/Xft.h>
+# include <glib.h>
 #endif
 
 static Lisp_Font *font_list;
@@ -89,6 +90,15 @@
 static int
 fontstruct_measure (Lisp_Font *f, u_char *string, size_t length)
 {
+    gsize r, w;
+    u_char *opsysstr;
+
+    opsysstr = g_locale_from_utf8 (string, length, &r, &w, NULL);
+    if (opsysstr != NULL) {
+	string = opsysstr;
+	length = w;
+    }
+
     return XTextWidth (f->font, string, length);
 }
 
@@ -98,6 +108,8 @@
 {
     XFontStruct *fs;
     XGCValues gcv;
+    gsize r, w;
+    u_char *opsysstr;
 
     fs = f->font;
 
@@ -105,6 +117,12 @@
     gcv.font = fs->fid;
     XChangeGC (dpy, gc, GCForeground | GCFont, &gcv);
 
+    opsysstr = g_locale_from_utf8 (string, length, &r, &w, NULL);
+    if (opsysstr != NULL) {
+	string = opsysstr;
+	length = w;
+    }
+
     XDrawString (dpy, id, gc, x, y, string, length);
 }
 
@@ -294,6 +312,15 @@
 static int
 fontset_measure (Lisp_Font *f, u_char *string, size_t length)
 {
+    gsize r, w;
+    u_char *opsysstr;
+
+    opsysstr = g_locale_from_utf8 (string, length, &r, &w, NULL);
+    if (opsysstr != NULL) {
+	string = opsysstr;
+	length = w;
+    }
+
     return XmbTextEscapement (f->font, string, length);
 }
 
@@ -302,10 +329,18 @@
 	      Window id, GC gc, Lisp_Color *fg, int x, int y)
 {
     XGCValues gcv;
+    gsize r, w;
+    u_char *opsysstr;
 
     gcv.foreground = fg->pixel;
     XChangeGC (dpy, gc, GCForeground, &gcv);
 
+    opsysstr = g_locale_from_utf8 (string, length, &r, &w, NULL);
+    if (opsysstr != NULL) {
+	string = opsysstr;
+	length = w;
+    }
+
     XmbDrawString (dpy, id, f->font, gc, x, y, string, length);
 }
 
@@ -346,9 +381,19 @@
 static int
 xft_measure (Lisp_Font *f, u_char *string, size_t length)
 {
+    gsize r, w;
+    u_char *utf8str;
     XGlyphInfo info;
 
-    XftTextExtents8 (dpy, f->font, string, length, &info);
+    utf8str = g_locale_to_utf8 (string, length, &r, &w, NULL);
+    if (utf8str != NULL) {
+	string = utf8str;
+	length = w;
+    }
+
+    XftTextExtentsUtf8 (dpy, f->font, string, length, &info);
+
+    g_free (utf8str);
 
     return info.xOff; 
 }
@@ -358,8 +403,9 @@
 	  Window id, GC gc, Lisp_Color *fg, int x, int y)
 {
     static XftDraw *draw;
-
     XftColor xft_color;
+    gsize r, w;
+    u_char *utf8str;
 
     if (draw == 0)
 	draw = XftDrawCreate (dpy, id, image_visual, image_cmap);
@@ -372,8 +418,15 @@
     xft_color.color.blue = fg->blue;
     xft_color.color.alpha = fg->alpha;
 
-    XftDrawString8 (draw, &xft_color, f->font,
-		    x, y, string, length);
+    utf8str = g_locale_to_utf8 (string, length, &r, &w, NULL);
+    if (utf8str != NULL) {
+	string = utf8str;
+	length = w;
+    }
+
+    XftDrawStringUtf8 (draw, &xft_color, f->font, x, y, string, length);
+
+    g_free (utf8str);
 }
 
 static const Lisp_Font_Class xft_class = {
@@ -722,6 +775,14 @@
     }
 }
 
+static int
+use_xft (void)
+{
+    char *val = getenv ("GDK_USE_XFT");
+
+    return (val == NULL || strcmp(val, "0"));
+}
+
 
 /* initialisation */
 
@@ -749,13 +810,21 @@
     rep_INTERN_SPECIAL(default_font);
     if (!batch_mode_p ())
     {
-	DEFSTRING (type, "xlfd");
-	DEFSTRING (name, "fixed");
+	DEFSTRING (xft_type, "xft");
+	DEFSTRING (xft_name, "Sans");
+	DEFSTRING (xlfd_type, "xlfd");
+	DEFSTRING (xlfd_name, "fixed");
+	repv font;
+
+	if (use_xft ()) {
+	    font = Fget_font_typed (rep_VAL (&xft_type), rep_VAL (&xft_name));
+	} else {
+	    font = Fget_font_typed (rep_VAL (&xlfd_type), rep_VAL (&xlfd_name));
+	}
 
-	repv font = Fget_font_typed (rep_VAL (&type), rep_VAL (&name));
 	if (font == rep_NULL || !FONTP(font))
 	{
-	    fputs ("can't load 'fixed' font during initialisation", stderr);
+	    fputs ("can't load default font during initialisation", stderr);
 	    rep_throw_value = rep_NULL;
 	    font = Qnil;
 	}