From 7c5516324bd6400898045ae69641d3ebe64ce97d Mon Sep 17 00:00:00 2001
From: Andreas Fuchs <asf@boinkor.net>
Date: Wed, 9 Sep 2009 14:52:54 +0200
Subject: [PATCH] bug18599: Fix font loading on OS X 10.6's broken X11.app

Try to query the font before loading it. This seems to prevent any BadValue
errors.
---
 ChangeLog.n              |  5 +++++
 tk-silica/xt-silica.lisp | 48 +++++++++++++++++++++-------------------
 2 files changed, 30 insertions(+), 23 deletions(-)

diff --git a/ChangeLog.n b/ChangeLog.n
index 75e74efe..6848d961 100644
--- a/ChangeLog.n
+++ b/ChangeLog.n
@@ -3,6 +3,11 @@
 don't forget to change the version in utils/packages.lisp if you do anything
 user visible.
 *******************************************************************************
+2009-09-09  Andreas Fuchs  <afuchs@franz.com>
+
+	* tk-silica/xt-silica.lisp: Try to query fonts before loading them, as we get
+	  BadValue errors from OS X 10.6's X11.app otherwise.
+
 2009-09-07  Andreas Fuchs  <afuchs@franz.com>
 
 	* tk-silica/xt-graphics: Make sure that drawing rotated text plays nice with
diff --git a/tk-silica/xt-silica.lisp b/tk-silica/xt-silica.lisp
index 015956ad..8d936762 100644
--- a/tk-silica/xt-silica.lisp
+++ b/tk-silica/xt-silica.lisp
@@ -283,12 +283,14 @@
                       (fallback-loadable-p ;fallback actually loadable?
                        (and fallback-matches-p
                             (excl:with-native-string (nfn fallback)
-                              (let ((x (x11:xloadqueryfont display nfn)))
-                                (if (not (zerop x))
-                                    (progn
-                                      (x11:xfreefont display x)
-                                      t)
-                                    nil))))))
+                              (let ((info (x11:xqueryfont display nfn)))
+                                (unless (zerop info)
+                                  (let ((font (x11:xloadfont display nfn)))
+                                    (unwind-protect
+                                        (unless (zerop font)
+                                          (x11:xfreefont display font)
+                                          t)
+                                      (x11:xfreefontinfo nil info 1)))))))))
                  (dolist (per-family families)
                    (destructuring-bind (family &rest patterns) per-family
                      (dolist (font-pattern patterns)
@@ -318,7 +320,7 @@
                           fallback))
                    ((and matchesp fallback-matches-p)
                     (warn "Fallback font ~A, for character set ~A, matches with XListFonts,
-but is not loadable by XLoadQueryFont.  Something may be wrong with the X font
+but is not loadable by XLoadFont or XQueryFont.  Something may be wrong with the X font
 setup."
                           fallback character-set))
                    (matchesp
@@ -352,22 +354,22 @@ setup."
         ;; the "fixed" alias to find out at least a sensible default
         ;; weight and slant.
         (excl:ics-target-case
-          (:+ics
-           (let* ((default-fallback (disassemble-x-font-name (font-name-of-aliased-font display *default-fallback-font*)))
-                  (weight (nth 3 default-fallback))
-                  (slant (nth 4 default-fallback)))
-             (loop for character-set from (1+ charset-number) 
-                   for encoding being the hash-keys of (list-fonts-by-registry display) using (hash-value fonts)
-                   for fallback-font = (find-font-with-properties fonts weight slant)
-                   for default-font-match-string = (format nil "-*-*-*-*-*-*-*-*-*-*-*-*-~A-~A" (first encoding) (second encoding))
-                   do (unless (member encoding done-registries :test #'equal)
-                        (vector-push-extend (excl:string-to-native
-                                             (format nil "~A-~A" (first encoding) (second encoding)))
-                                            tk::*font-list-tags*)
-                        (load-1-charset character-set fallback-font
-                                        `((:fix ,default-font-match-string)
-                                          (:sans-serif ,default-font-match-string)
-                                          (:serif ,default-font-match-string))))))))
+         (:+ics
+          (let* ((default-fallback (disassemble-x-font-name (font-name-of-aliased-font display *default-fallback-font*)))
+                 (weight (nth 3 default-fallback))
+                 (slant (nth 4 default-fallback)))
+            (loop for character-set from (1+ charset-number) 
+                  for encoding being the hash-keys of (list-fonts-by-registry display) using (hash-value fonts)
+                  for fallback-font = (find-font-with-properties fonts weight slant)
+                  for default-font-match-string = (format nil "-*-*-*-*-*-*-*-*-*-*-*-*-~A-~A" (first encoding) (second encoding))
+                  do (unless (member encoding done-registries :test #'equal)
+                       (vector-push-extend (excl:string-to-native
+                                            (format nil "~A-~A" (first encoding) (second encoding)))
+                                           tk::*font-list-tags*)
+                       (load-1-charset character-set fallback-font
+                                       `((:fix ,default-font-match-string)
+                                         (:sans-serif ,default-font-match-string)
+                                         (:serif ,default-font-match-string))))))))
         )))
   (setup-stipples port display))
 
-- 
GitLab