lisp/ChangeLog addition: 2007-01-02 Aidan Kehoe <kehoea(a)parhasard.net&gt; * cus-face.el (custom-set-face-update-spec): Fix some formatting. * faces.el (reset-face): reset-face resets other faces to behave like the default face--it shouldn't do anything if it's handed the default face. * font-menu.el: * font-menu.el (font-menu-set-font): If the font was initialised from X resources (the tag-set contains 'x-resource) pretend to Custom that it has responsibility for those settings. * x-faces.el: Add a couple of fontconfig functions to the globally-declare-fboundp, to eliminate a couple of byte-compile warnings. * x-faces.el ('x-resource)): New specifier tag, used to mark when a face's font or other attributes have been initialised from X resources. * x-faces.el (x-init-face-from-resources): Use the new specifier tag; also, instead of using a fragile explicit list of what would incidentally be specified for the X11 Unicode fonts in faces.c, pay attention to the new specifier tag created in that file for the specific purpose of grouping those instantiators together. src/ChangeLog addition: 2007-01-02 Aidan Kehoe <kehoea(a)parhasard.net&gt; * faces.c: * faces.c (syms_of_faces): * faces.c (complex_vars_of_faces): New symbol and corresponding specifier tag, x-coverage-instantiator, used to group those fonts used for their extensive coverage for obscure characters in x-faces.el. * specifier.c (setup_device_initial_specifier_tags): Fix a bug where the mswindows specifier tag was matching X11 devices, because the format of the DEVICE_USER_SPECIFIED_TAGS list wasn't being respected correctly. XEmacs Trunk source patch: Diff command: cvs -q diff -Nu Files affected: src/specifier.c =================================================================== RCS src/faces.c =================================================================== RCS lisp/x-faces.el =================================================================== RCS lisp/font-menu.el =================================================================== RCS lisp/faces.el =================================================================== RCS lisp/cus-face.el =================================================================== RCS Index: lisp/cus-face.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/cus-face.el,v retrieving revision 1.12 diff -u -u -r1.12 cus-face.el --- lisp/cus-face.el 2005/10/25 11:28:24 1.12 +++ lisp/cus-face.el 2007/01/01 23:36:44 ＠＠ -282,7 +282,7 ＠＠ ;;;###autoload (defun custom-set-face-update-spec (face display plist) "Customize the FACE for display types matching DISPLAY, merging - in the new items from PLIST." +in the new items from PLIST." (let ((spec (face-spec-update-all-matching (custom-face-get-spec face) display plist))) (put face 'customized-face spec) Index: lisp/faces.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/faces.el,v retrieving revision 1.39 diff -u -u -r1.39 faces.el --- lisp/faces.el 2006/11/05 22:31:32 1.39 +++ lisp/faces.el 2007/01/01 23:36:45 ＠＠ -398,10 +398,10 ＠＠ The arguments LOCALE, TAG-SET and EXACT-P are the same as for `remove-specifier'." - (mapc (lambda (x) - (remove-specifier (face-property face x) locale tag-set exact-p)) - built-in-face-specifiers) - nil) + ;; Don't reset the default face. + (unless (eq 'default face) + (dolist (x built-in-face-specifiers nil) + (remove-specifier (face-property face x) locale tag-set exact-p)))) (defun set-face-parent (face parent &optional locale tag-set how-to-add) "Set the parent of FACE to PARENT, for all properties. Index: lisp/font-menu.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/font-menu.el,v retrieving revision 1.9 diff -u -u -r1.9 font-menu.el --- lisp/font-menu.el 2005/11/26 11:45:54 1.9 +++ lisp/font-menu.el 2007/01/01 23:36:46 ＠＠ -365,13 +365,32 ＠＠ (/ (or size from-size) (specifier-instance font-menu-size-scaling (selected-device)))) - "pt")))) + "pt"))) + new-spec-list) + ;; If the font was initialised from X resources (the tag-set + ;; contains 'x-resource) pretend to Custom that it has + ;; responsibility for those settings. + (map-specifier (face-font 'default) + (lambda (spec locale inst-list arg) + (loop + for (tag-set . inst) + in inst-list + do (setq tag-set (delq 'x-resource tag-set) + tag-set (delq 'custom tag-set) + tag-set (cons 'custom tag-set)) + (push (cons tag-set inst) new-spec-list) + ;; Need to return nil, else map-specifier stops + finally return nil)) + nil nil '(x-resource)) + (remove-specifier (face-font 'default) nil '(x-resource)) + (when new-spec-list + (add-spec-list-to-specifier (face-font 'default) + (list (cons 'global new-spec-list)))) (custom-set-face-update-spec 'default (list (list 'type (device-type))) (list :family (or family from-family) :size fsize)))) (message "Font %s" (face-font-name 'default)))) - ;; #### This should be called `font-menu-maybe-change-face' ;; I wonder if a better API wouldn't (face attribute from to) Index: lisp/x-faces.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/x-faces.el,v retrieving revision 1.27 diff -u -u -r1.27 x-faces.el --- lisp/x-faces.el 2006/12/17 11:25:59 1.27 +++ lisp/x-faces.el 2007/01/01 23:36:49 ＠＠ -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?) Index: src/faces.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/faces.c,v retrieving revision 1.53 diff -u -u -r1.53 faces.c --- src/faces.c 2006/12/17 11:26:09 1.53 +++ src/faces.c 2007/01/01 23:36:52 ＠＠ -2011,7 +2011,7 ＠＠ #ifdef MULE -Lisp_Object Qone_dimensional, Qtwo_dimensional; +Lisp_Object Qone_dimensional, Qtwo_dimensional, Qx_coverage_instantiator; DEFUN ("specifier-tag-one-dimensional-p", Fspecifier_tag_one_dimensional_p, ＠＠ -2108,6 +2108,8 ＠＠ #ifdef MULE DEFSYMBOL (Qone_dimensional); DEFSYMBOL (Qtwo_dimensional); + DEFSYMBOL (Qx_coverage_instantiator); + /* I would much prefer these were in Lisp. */ DEFSUBR (Fspecifier_tag_one_dimensional_p); DEFSUBR (Fspecifier_tag_two_dimensional_p); ＠＠ -2307,6 +2309,13 ＠＠ define_specifier_tag (Qencode_as_utf_8, Qnil, intern("specifier-tag-encode-as-utf-8-p")); + + /* This tag is used to group those instantiators made available in the + fallback for the sake of coverage of obscure characters, notably + Markus Kuhn's misc-fixed fonts. They will be copied from the fallback + when the default face is determined from X resources at startup. */ + define_specifier_tag (Qx_coverage_instantiator, Qnil, Qnil); + #endif /* MULE */ #ifdef USE_XFT ＠＠ -2333,7 +2342,7 ＠＠ inst_list = Fcons (Fcons - (list3(device_symbol, Qtwo_dimensional, Qfinal), + (list4(device_symbol, Qtwo_dimensional, Qfinal, Qx_coverage_instantiator), build_string ("-misc-fixed-medium-r-normal--15-140-75-75-c-90-iso10646-1")), inst_list); ＠＠ -2345,7 +2354,7 ＠＠ inst_list = Fcons (Fcons - (list3(device_symbol, Qone_dimensional, Qfinal), + (list4(device_symbol, Qone_dimensional, Qfinal, Qx_coverage_instantiator), build_string ("-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-iso10646-1")), inst_list); ＠＠ -2365,7 +2374,7 ＠＠ inst_list = Fcons (Fcons - (list3(device_symbol, Qencode_as_utf_8, Qinitial), + (list4(device_symbol, Qencode_as_utf_8, Qinitial, Qx_coverage_instantiator), build_string ("-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-iso10646-1")), inst_list); Index: src/specifier.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/specifier.c,v retrieving revision 1.51 diff -u -u -r1.51 specifier.c --- src/specifier.c 2006/12/11 12:22:52 1.51 +++ src/specifier.c 2007/01/01 23:36:57 ＠＠ -1310,18 +1310,17 ＠＠ assert(3 == list_len); device_predicate = XCADR(XCAR (rest)); - charset_predicate = XCADDR(XCAR (rest)); if (NILP (device_predicate)) { - XCDR (XCAR (rest2)) = list2(Qt, charset_predicate); + XCDR (XCAR (rest2)) = Qt; } else { device_predicate = !NILP (call_critical_lisp_code (d, device_predicate, device)) ? Qt : Qnil; - XCDR (XCAR (rest2)) = list2(device_predicate, charset_predicate); + XCDR (XCAR (rest2)) = device_predicate; } } } -- When I was in the scouts, the leader told me to pitch a tent. I couldn't find any pitch, so I used creosote. _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches