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