diff lisp/x-faces.el @ 3918:049dc907c17a

[xemacs-hg @ 2007-04-22 19:58:27 by aidan] Make the X11 font menu work again, server side X11 with Mule.
author aidan
date Sun, 22 Apr 2007 19:58:59 +0000
parents c13b89ba4796
children cef5f57bb9e2
line wrap: on
line diff
--- a/lisp/x-faces.el	Sun Apr 22 09:24:12 2007 +0000
+++ b/lisp/x-faces.el	Sun Apr 22 19:58:59 2007 +0000
@@ -74,11 +74,11 @@
      fc-font-name-slant-oblique   fc-font-name-slant-italic
      fc-font-name-slant-roman))
   (globally-declare-fboundp
-    '(fc-pattern-del-size   fc-pattern-get-size   fc-pattern-add-size
-      fc-pattern-del-style  fc-pattern-duplicate  fc-copy-pattern-partial
-      fc-pattern-add-weight fc-pattern-del-weight fc-try-font          
-      fc-pattern-del-slant  fc-pattern-add-slant  fc-name-unparse
-      fc-pattern-get-pixelsize)))
+    '(fc-font-match fc-pattern-del-size fc-pattern-get-size
+      fc-pattern-add-size fc-pattern-del-style fc-pattern-duplicate
+      fc-copy-pattern-partial fc-pattern-add-weight fc-pattern-del-weight
+      fc-try-font fc-pattern-del-slant fc-pattern-add-slant fc-name-parse
+      fc-name-unparse fc-pattern-get-pixelsize)))
 
 (defconst x-font-regexp nil)
 (defconst x-font-regexp-head nil)
@@ -653,6 +653,9 @@
 ;;; state where signalling an error or entering the debugger would likely
 ;;; result in a crash.
 
+;; When we initialise a face from an X resource, note that we did so. 
+(define-specifier-tag 'x-resource)
+
 (defun x-init-face-from-resources (face &optional locale set-anyway)
 
   ;;
@@ -681,6 +684,7 @@
 	 ;; specs.
 	 (x-tag-set '(x default))
 	 (tty-tag-set '(tty default))
+         (our-tag-set '(x x-resource))
 	 (device-class nil)
 	 (face-sym (face-name face))
 	 (name (symbol-name face-sym))
@@ -738,7 +742,8 @@
     (if device-class
 	(setq tag-set (cons device-class tag-set)
 	      x-tag-set (cons device-class x-tag-set)
-	      tty-tag-set (cons device-class tty-tag-set)))
+	      tty-tag-set (cons device-class tty-tag-set)
+              our-tag-set (cons device-class our-tag-set)))
 
     ;;
     ;; If this is the default face, then any unspecified properties should
@@ -782,28 +787,22 @@
 	;; globally.  This means we should override global
 	;; defaults for all X device classes.
 	(remove-specifier (face-font face) locale x-tag-set nil))
-      (set-face-font face fn locale 'x append)
-      ;
-      ; (debug-print "the face is %s, locale %s, specifier %s"
-      ;	       face locale (face-font face))
-      ;
+      (set-face-font face fn locale our-tag-set append)
+
       ;; And retain some of the fallbacks in the generated default face,
       ;; since we don't want to try andale-mono's ISO-10646-1 encoding for
-      ;; Amharic or Thai. This is fragile; it depends on the code in
-      ;; faces.c.
-      (unless (featurep 'xft-fonts)
-        (dolist (assocked '((x encode-as-utf-8 initial)
-                            (x two-dimensional initial)
-                            (x one-dimensional final)
-                            (x two-dimensional final)))
-          (when (and (specifierp (face-font face))
-                     (consp (specifier-fallback (face-font face)))
-                     (setq assocked 
-                           (assoc assocked 
-                                  (specifier-fallback
-                                   (face-font face)))))
-            (set-face-font face (cdr assocked) locale
-                           (nreverse (car assocked)) append)))))
+      ;; Amharic or Thai.
+      (when (and (specifierp (face-font face))
+                 (consp (specifier-fallback (face-font face))))
+        (loop
+          for (tag-set . instantiator)
+          in (specifier-fallback (face-font face))
+          if (memq 'x-coverage-instantiator tag-set)
+          do (add-spec-list-to-specifier
+              (face-font face)
+              (list (cons (or locale 'global)
+                          (list (cons tag-set instantiator))))
+              append))))
 		     
     ;; Kludge-o-rooni.  Set the foreground and background resources for
     ;; X devices only -- otherwise things tend to get all messed up
@@ -814,14 +813,14 @@
 							locale
 							x-tag-set)
 	(remove-specifier (face-foreground face) locale x-tag-set nil))
-      (set-face-foreground face fg locale 'x append))
+      (set-face-foreground face fg locale our-tag-set append))
     (when bg
       (if device-class
 	  (remove-specifier-specs-matching-tag-set-cdrs (face-background face)
 							locale
 							x-tag-set)
 	(remove-specifier (face-background face) locale x-tag-set nil))
-      (set-face-background face bg locale 'x append))
+      (set-face-background face bg locale our-tag-set append))
     (when bgp
       (if device-class
 	  (remove-specifier-specs-matching-tag-set-cdrs (face-background-pixmap
@@ -829,7 +828,7 @@
 							locale
 							x-tag-set)
 	(remove-specifier (face-background-pixmap face) locale x-tag-set nil))
-      (set-face-background-pixmap face bgp locale nil append))
+      (set-face-background-pixmap face bgp locale our-tag-set append))
     (when ulp
       (if device-class
 	  (remove-specifier-specs-matching-tag-set-cdrs (face-property
@@ -838,7 +837,7 @@
 							tty-tag-set)
 	(remove-specifier (face-property face 'underline) locale
 			  tty-tag-set nil))
-      (set-face-underline-p face ulp locale nil append))
+      (set-face-underline-p face ulp locale our-tag-set append))
     (when stp
       (if device-class
 	  (remove-specifier-specs-matching-tag-set-cdrs (face-property
@@ -847,7 +846,7 @@
 							tty-tag-set)
 	(remove-specifier (face-property face 'strikethru)
 			  locale tty-tag-set nil))
-      (set-face-strikethru-p face stp locale nil append))
+      (set-face-strikethru-p face stp locale our-tag-set append))
     (when hp
       (if device-class
 	  (remove-specifier-specs-matching-tag-set-cdrs (face-property
@@ -856,7 +855,7 @@
 							tty-tag-set)
 	(remove-specifier (face-property face 'highlight)
 			  locale tty-tag-set nil))
-      (set-face-highlight-p face hp locale nil append))
+      (set-face-highlight-p face hp locale our-tag-set append))
     (when dp
       (if device-class
 	  (remove-specifier-specs-matching-tag-set-cdrs (face-property
@@ -864,7 +863,7 @@
 							locale
 							tty-tag-set)
 	(remove-specifier (face-property face 'dim) locale tty-tag-set nil))
-      (set-face-dim-p face dp locale nil append))
+      (set-face-dim-p face dp locale our-tag-set append))
     (when bp
       (if device-class
 	  (remove-specifier-specs-matching-tag-set-cdrs (face-property
@@ -873,7 +872,7 @@
 							tty-tag-set)
 	(remove-specifier (face-property face 'blinking) locale
 			  tty-tag-set nil))
-      (set-face-blinking-p face bp locale nil append))
+      (set-face-blinking-p face bp locale our-tag-set append))
     (when rp
       (if device-class
 	  (remove-specifier-specs-matching-tag-set-cdrs (face-property
@@ -882,7 +881,7 @@
 							tty-tag-set)
 	(remove-specifier (face-property face 'reverse) locale
 			  tty-tag-set nil))
-      (set-face-reverse-p face rp locale nil append))
+      (set-face-reverse-p face rp locale our-tag-set append))
     ))
 
 ;; GNU Emacs compatibility. (move to obsolete.el?)