X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Ffaces.el;h=a4f56eadda4bff5ac38cdaf92dcc3939e6398754;hb=71baa1c0cbbb886ac1528500c1bda51ac70decad;hp=4e3429835806f302869573bd16fff48da0fd900c;hpb=3062d425fac0473eb5aa2efc0bb002f6ce0cb028;p=chise%2Fxemacs-chise.git.1 diff --git a/lisp/faces.el b/lisp/faces.el index 4e34298..a4f56ea 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -847,10 +847,21 @@ the function to be called on it." (setq temp-sp (copy-specifier sp)) - (if (and (or (eq locale 'global) (eq locale 'all) (not locale)) - (not (face-property face property 'global))) - (copy-specifier (face-property 'default property) - temp-sp 'global)) + (if (or (eq locale 'global) (eq locale 'all) (not locale)) + (when (not (specifier-specs temp-sp 'global)) + ;; Try fallback via the official ways and then do it "by hand" + (let* ((fallback (specifier-fallback sp)) + (fallback-sp + (cond ((specifierp fallback) fallback) + ;; just an inst list + (fallback + (make-specifier-and-init (specifier-type sp) + fallback)) + ((eq (get-face face) (get-face 'default)) + (error "Unable to find global specification")) + ;; If no fallback we snoop from default + (t (face-property 'default property))))) + (copy-specifier fallback-sp temp-sp 'global)))) (if (and (valid-specifier-locale-p locale) (not (specifier-specs temp-sp locale))) (error "Property must have a specification in locale %S" locale)) @@ -986,6 +997,27 @@ multi-charset environments." (face-property-instance unfrobbed-face 'font domain)) (set-face-property face 'font (vector frobbed-face) the-locale tags))))))) +;; WE DEMAND FOUNDRY FROBBING! + +;; Family frobbing +;; Thx Jan Vroonhof, Ref xemacs-beta <87oflypbum.fsf@petteflet.ntlworld.com> +;; Brainlessly derived from make-face-size by Stephen; don't blame Jan. +;; I'm long since flown to Rio, it does you little good to blame me, either. +(defun make-face-family (face family &optional locale tags) + "Set FACE's family to FAMILY in LOCALE, if possible. + +Add/replace settings specified by TAGS only." + (frob-face-property face 'font + ;; uses dynamic scope of family + #'(lambda (f d) + ;; keep the dependency on font.el for now + (let ((fo (font-create-object (font-instance-name f) + d))) + (set-font-family fo family) + (font-create-name fo d))) + nil locale tags)) + +;; Style (ie, typographical face) frobbing (defun make-face-bold (face &optional locale tags) "Make FACE bold in LOCALE, if possible. This will attempt to make the font bold for X/MSW locales and will set the @@ -1159,6 +1191,23 @@ specifics on exactly how this function works." ([bold-italic] . [bold])))) +;; Size frobbing +;; Thx Jan Vroonhof, Ref xemacs-beta <87oflypbum.fsf@petteflet.ntlworld.com> +;; Jan had a separate helper function +(defun make-face-size (face size &optional locale tags) + "Adjust FACE to SIZE in LOCALE, if possible. + +Add/replace settings specified by TAGS only." + (frob-face-property face 'font + ;; uses dynamic scope of size + #'(lambda (f d) + ;; keep the dependency on font.el for now + (let ((fo (font-create-object (font-instance-name f) + d))) + (set-font-size fo size) + (font-create-name fo d))) + nil locale tags)) + ;; Why do the following two functions lose so badly in so many ;; circumstances? @@ -1565,10 +1614,12 @@ and 'global)." (defun face-complain-about-font (face device) (if (symbolp face) (setq face (symbol-name face))) ;; (if (not inhibit-font-complaints) - (display-warning - 'font - (let ((default-name (face-font-name 'default device))) - (format "%s: couldn't deduce %s %s version of the font + ;; complaining for printers is generally annoying. + (unless (device-printer-p device) + (display-warning + 'font + (let ((default-name (face-font-name 'default device))) + (format "%s: couldn't deduce %s %s version of the font %S. Please specify X resources to make the %s face @@ -1578,14 +1629,14 @@ For example, you could add one of the following to $HOME/Emacs: Emacs.%s.attributeFont: -dt-*-medium-i-* or Emacs.%s.attributeForeground: hotpink\n" - invocation-name - (if (string-match "\\`[aeiouAEIOU]" face) "an" "a") - face - default-name - face - face - face - )))) + invocation-name + (if (string-match "\\`[aeiouAEIOU]" face) "an" "a") + face + default-name + face + face + face + ))))) ;; #### This is quite a mess. We should use the custom mechanism for @@ -1727,7 +1778,7 @@ in that frame; otherwise change each frame." (make-face 'underline "Underlined text.") (or (face-differs-from-default-p 'underline) (set-face-underline-p 'underline t 'global '(default))) -(make-face 'zmacs-region "Used on highlightes region between point and mark.") +(make-face 'zmacs-region "Used on highlighted region between point and mark.") (make-face 'isearch "Used on region matched by isearch.") (make-face 'isearch-secondary "Face to use for highlighting all matches.") (make-face 'list-mode-item-selected @@ -1761,7 +1812,7 @@ in that frame; otherwise change each frame." 'global) (set-face-background-pixmap 'highlight '(((x default mono) . "gray1") -;; ((gtk default mono) . "gray1") + ((gtk default mono) . "gray1") ((mswindows default mono) . "gray1")) 'global) @@ -1773,7 +1824,7 @@ in that frame; otherwise change each frame." 'global) (set-face-background-pixmap 'zmacs-region '(((x default mono) . "gray3") -;; ((gtk default mono) . "gray3") + ((gtk default mono) . "gray3") ((mswindows default mono) . "gray3")) 'global) @@ -1781,9 +1832,9 @@ in that frame; otherwise change each frame." '(((x default color) . "gray68") ((x default grayscale) . "gray68") ((x default mono) . [default foreground]) -;; ((gtk default color) . "gray68") -;; ((gtk default grayscale) . "gray68") -;; ((gtk default mono) . [default foreground]) + ((gtk default color) . "gray68") + ((gtk default grayscale) . "gray68") + ((gtk default mono) . [default foreground]) ((mswindows default color) . "gray68") ((mswindows default grayscale) . "gray68") ((mswindows default mono) . [default foreground])) @@ -1801,7 +1852,7 @@ in that frame; otherwise change each frame." 'global) (set-face-background-pixmap 'primary-selection '(((x default mono) . "gray3") - ;;((gtk default mono) . "gray3") + ((gtk default mono) . "gray3") ((mswindows default mono) . "gray3")) 'global) @@ -1809,24 +1860,24 @@ in that frame; otherwise change each frame." '(((x default color) . "paleturquoise") ((x default color) . "green") ((x default grayscale) . "gray53") - ;;((gtk default color) . "paleturquoise") - ;;((gtk default color) . "green") - ;;((gtk default grayscale) . "gray53") + ((gtk default color) . "paleturquoise") + ((gtk default color) . "green") + ((gtk default grayscale) . "gray53") ((mswindows default color) . "paleturquoise") ((mswindows default color) . "green") ((mswindows default grayscale) . "gray53")) 'global) (set-face-background-pixmap 'secondary-selection '(((x default mono) . "gray1") - ;;((gtk default mono) . "gray1") + ((gtk default mono) . "gray1") ((mswindows default mono) . "gray1")) 'global) (set-face-background 'isearch '(((x default color) . "paleturquoise") ((x default color) . "green") - ;;((gtk default color) . "paleturquoise") - ;;((gtk default color) . "green") + ((gtk default color) . "paleturquoise") + ((gtk default color) . "green") ((mswindows default color) . "paleturquoise") ((mswindows default color) . "green")) 'global)