Mercurial > hg > xemacs-beta

comparison lisp/faces.el @ 442:abe6d1db359e r21-2-36

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-36
author cvs
date Mon, 13 Aug 2007 11:35:02 +0200
parents 8de8e3f6228a
children 576fb035e263
comparison
equal deleted inserted replaced
441:72a7cfa4a488 442:abe6d1db359e
115 'all, the specifications for all locales of all types will be returned. 115 'all, the specifications for all locales of all types will be returned.
116 116
117 The specifications in a specifier determine what the value of 117 The specifications in a specifier determine what the value of
118 PROPERTY will be in a particular \"domain\" or set of circumstances, 118 PROPERTY will be in a particular \"domain\" or set of circumstances,
119 which is typically a particular Emacs window along with the buffer 119 which is typically a particular Emacs window along with the buffer
120 it contains and the frame and device it lies within. The value 120 it contains and the frame and device it lies within. The value is
121 is derived from the instantiator associated with the most specific 121 derived from the instantiator associated with the most specific
122 locale (in the order buffer, window, frame, device, and 'global) 122 locale (in the order buffer, window, frame, device, and 'global)
123 that matches the domain in question. In other words, given a domain 123 that matches the domain in question. In other words, given a domain
124 (i.e. an Emacs window, usually), the specifier for PROPERTY will first 124 (i.e. an Emacs window, usually), the specifier for PROPERTY will
125 be searched for a specification whose locale is the buffer contained 125 first be searched for a specification whose locale is the buffer
126 within that window; then for a specification whose locale is the window 126 contained within that window; then for a specification whose locale
127 itself; then for a specification whose locale is the frame that the 127 is the window itself; then for a specification whose locale is the
128 window is contained within; etc. The first instantiator that is 128 frame that the window is contained within; etc. The first
129 valid for the domain (usually this means that the instantiator is 129 instantiator that is valid for the domain (usually this means that
130 recognized by the device [i.e. the X server or TTY device] that the 130 the instantiator is recognized by the device [i.e. MS Windows, the X
131 domain is on. The function `face-property-instance' actually does 131 server or TTY device] that the domain is on. The function
132 all this, and is used to determine how to display the face. 132 `face-property-instance' actually does all this, and is used to
133 determine how to display the face.
133 134
134 See `set-face-property' for the built-in property-names." 135 See `set-face-property' for the built-in property-names."
135 136
136 (setq face (get-face face)) 137 (setq face (get-face face))
137 (let ((value (get face property))) 138 (let ((value (get face property)))
290 291
291 292
292 The following symbols have predefined meanings: 293 The following symbols have predefined meanings:
293 294
294 foreground The foreground color of the face. 295 foreground The foreground color of the face.
295 For valid instantiators, see `color-specifier-p'. 296 For valid instantiators, see `make-color-specifier'.
296 297
297 background The background color of the face. 298 background The background color of the face.
298 For valid instantiators, see `color-specifier-p'. 299 For valid instantiators, see `make-color-specifier'.
299 300
300 font The font used to display text covered by this face. 301 font The font used to display text covered by this face.
301 For valid instantiators, see `font-specifier-p'. 302 For valid instantiators, see `make-font-specifier'.
302 303
303 display-table The display table of the face. 304 display-table The display table of the face.
304 This should be a vector of 256 elements. 305 This should be a vector of 256 elements.
305 306
306 background-pixmap The pixmap displayed in the background of the face. 307 background-pixmap The pixmap displayed in the background of the face.
307 Only used by faces on X devices. 308 Only used by faces on X and MS Windows devices.
308 For valid instantiators, see `image-specifier-p'. 309 For valid instantiators, see `make-image-specifier'.
309 310
310 underline Underline all text covered by this face. 311 underline Underline all text covered by this face.
311 For valid instantiators, see `face-boolean-specifier-p'. 312 For valid instantiators, see `make-face-boolean-specifier'.
312 313
313 strikethru Draw a line through all text covered by this face. 314 strikethru Draw a line through all text covered by this face.
314 For valid instantiators, see `face-boolean-specifier-p'. 315 For valid instantiators, see `make-face-boolean-specifier'.
315 316
316 highlight Highlight all text covered by this face. 317 highlight Highlight all text covered by this face.
317 Only used by faces on TTY devices. 318 Only used by faces on TTY devices.
318 For valid instantiators, see `face-boolean-specifier-p'. 319 For valid instantiators, see `make-face-boolean-specifier'.
319 320
320 dim Dim all text covered by this face. 321 dim Dim all text covered by this face.
321 For valid instantiators, see `face-boolean-specifier-p'. 322 For valid instantiators, see `make-face-boolean-specifier'.
322 323
323 blinking Blink all text covered by this face. 324 blinking Blink all text covered by this face.
324 Only used by faces on TTY devices. 325 Only used by faces on TTY devices.
325 For valid instantiators, see `face-boolean-specifier-p'. 326 For valid instantiators, see `make-face-boolean-specifier'.
326 327
327 reverse Reverse the foreground and background colors. 328 reverse Reverse the foreground and background colors.
328 Only used by faces on TTY devices. 329 Only used by faces on TTY devices.
329 For valid instantiators, see `face-boolean-specifier-p'. 330 For valid instantiators, see `make-face-boolean-specifier'.
330 331
331 doc-string Description of what the face's normal use is. 332 doc-string Description of what the face's normal use is.
332 NOTE: This is not a specifier, unlike all 333 NOTE: This is not a specifier, unlike all
333 the other built-in properties, and cannot 334 the other built-in properties, and cannot
334 contain locale-specific values." 335 contain locale-specific values."
431 (defun set-face-font (face font &optional locale tag-set how-to-add) 432 (defun set-face-font (face font &optional locale tag-set how-to-add)
432 "Change the font of FACE to FONT in LOCALE. 433 "Change the font of FACE to FONT in LOCALE.
433 434
434 FACE may be either a face object or a symbol representing a face. 435 FACE may be either a face object or a symbol representing a face.
435 436
436 FONT should be an instantiator (see `font-specifier-p'), a list of 437 FONT should be an instantiator (see `make-font-specifier'), a list of
437 instantiators, an alist of specifications (each mapping a 438 instantiators, an alist of specifications (each mapping a
438 locale to an instantiator list), or a font specifier object. 439 locale to an instantiator list), or a font specifier object.
439 440
440 If FONT is an alist, LOCALE must be omitted. If FONT is a 441 If FONT is an alist, LOCALE must be omitted. If FONT is a
441 specifier object, LOCALE can be a locale, a locale type, 'all, 442 specifier object, LOCALE can be a locale, a locale type, 'all,
488 (defun set-face-foreground (face color &optional locale tag-set how-to-add) 489 (defun set-face-foreground (face color &optional locale tag-set how-to-add)
489 "Change the foreground color of FACE to COLOR in LOCALE. 490 "Change the foreground color of FACE to COLOR in LOCALE.
490 491
491 FACE may be either a face object or a symbol representing a face. 492 FACE may be either a face object or a symbol representing a face.
492 493
493 COLOR should be an instantiator (see `color-specifier-p'), a list of 494 COLOR should be an instantiator (see `make-color-specifier'), a list of
494 instantiators, an alist of specifications (each mapping a locale to 495 instantiators, an alist of specifications (each mapping a locale to
495 an instantiator list), or a color specifier object. 496 an instantiator list), or a color specifier object.
496 497
497 If COLOR is an alist, LOCALE must be omitted. If COLOR is a 498 If COLOR is an alist, LOCALE must be omitted. If COLOR is a
498 specifier object, LOCALE can be a locale, a locale type, 'all, 499 specifier object, LOCALE can be a locale, a locale type, 'all,
545 (defun set-face-background (face color &optional locale tag-set how-to-add) 546 (defun set-face-background (face color &optional locale tag-set how-to-add)
546 "Change the background color of FACE to COLOR in LOCALE. 547 "Change the background color of FACE to COLOR in LOCALE.
547 548
548 FACE may be either a face object or a symbol representing a face. 549 FACE may be either a face object or a symbol representing a face.
549 550
550 COLOR should be an instantiator (see `color-specifier-p'), a list of 551 COLOR should be an instantiator (see `make-color-specifier'), a list of
551 instantiators, an alist of specifications (each mapping a locale to 552 instantiators, an alist of specifications (each mapping a locale to
552 an instantiator list), or a color specifier object. 553 an instantiator list), or a color specifier object.
553 554
554 If COLOR is an alist, LOCALE must be omitted. If COLOR is a 555 If COLOR is an alist, LOCALE must be omitted. If COLOR is a
555 specifier object, LOCALE can be a locale, a locale type, 'all, 556 specifier object, LOCALE can be a locale, a locale type, 'all,
593 "Change the background pixmap of FACE to PIXMAP in LOCALE. 594 "Change the background pixmap of FACE to PIXMAP in LOCALE.
594 This property is only used on window system devices. 595 This property is only used on window system devices.
595 596
596 FACE may be either a face object or a symbol representing a face. 597 FACE may be either a face object or a symbol representing a face.
597 598
598 PIXMAP should be an instantiator (see `image-specifier-p'), a list 599 PIXMAP should be an instantiator (see `make-image-specifier'), a list
599 of instantiators, an alist of specifications (each mapping a locale 600 of instantiators, an alist of specifications (each mapping a locale
600 to an instantiator list), or an image specifier object. 601 to an instantiator list), or an image specifier object.
601 602
602 If PIXMAP is an alist, LOCALE must be omitted. If PIXMAP is a 603 If PIXMAP is an alist, LOCALE must be omitted. If PIXMAP is a
603 specifier object, LOCALE can be a locale, a locale type, 'all, 604 specifier object, LOCALE can be a locale, a locale type, 'all,
650 651
651 (defun set-face-underline-p (face underline-p &optional locale tag-set 652 (defun set-face-underline-p (face underline-p &optional locale tag-set
652 how-to-add) 653 how-to-add)
653 "Change the underline property of FACE to UNDERLINE-P. 654 "Change the underline property of FACE to UNDERLINE-P.
654 UNDERLINE-P is normally a face-boolean instantiator; see 655 UNDERLINE-P is normally a face-boolean instantiator; see
655 `face-boolean-specifier-p'. 656 `make-face-boolean-specifier'.
656 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and 657 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
657 HOW-TO-ADD arguments." 658 HOW-TO-ADD arguments."
658 (interactive (face-interactive "underline-p" "underlined")) 659 (interactive (face-interactive "underline-p" "underlined"))
659 (set-face-property face 'underline underline-p locale tag-set how-to-add)) 660 (set-face-property face 'underline underline-p locale tag-set how-to-add))
660 661
665 666
666 (defun set-face-strikethru-p (face strikethru-p &optional locale tag-set 667 (defun set-face-strikethru-p (face strikethru-p &optional locale tag-set
667 how-to-add) 668 how-to-add)
668 "Change whether FACE is strikethru-d (i.e. struck through) in LOCALE. 669 "Change whether FACE is strikethru-d (i.e. struck through) in LOCALE.
669 STRIKETHRU-P is normally a face-boolean instantiator; see 670 STRIKETHRU-P is normally a face-boolean instantiator; see
670 `face-boolean-specifier-p'. 671 `make-face-boolean-specifier'.
671 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and 672 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
672 HOW-TO-ADD arguments." 673 HOW-TO-ADD arguments."
673 (interactive (face-interactive "strikethru-p" "strikethru-d")) 674 (interactive (face-interactive "strikethru-p" "strikethru-d"))
674 (set-face-property face 'strikethru strikethru-p locale tag-set how-to-add)) 675 (set-face-property face 'strikethru strikethru-p locale tag-set how-to-add))
675 676
680 681
681 (defun set-face-highlight-p (face highlight-p &optional locale tag-set 682 (defun set-face-highlight-p (face highlight-p &optional locale tag-set
682 how-to-add) 683 how-to-add)
683 "Change whether FACE is highlighted in LOCALE (TTY locales only). 684 "Change whether FACE is highlighted in LOCALE (TTY locales only).
684 HIGHLIGHT-P is normally a face-boolean instantiator; see 685 HIGHLIGHT-P is normally a face-boolean instantiator; see
685 `face-boolean-specifier-p'. 686 `make-face-boolean-specifier'.
686 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and 687 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
687 HOW-TO-ADD arguments." 688 HOW-TO-ADD arguments."
688 (interactive (face-interactive "highlight-p" "highlighted")) 689 (interactive (face-interactive "highlight-p" "highlighted"))
689 (set-face-property face 'highlight highlight-p locale tag-set how-to-add)) 690 (set-face-property face 'highlight highlight-p locale tag-set how-to-add))
690 691
694 (face-property-instance face 'dim domain default no-fallback)) 695 (face-property-instance face 'dim domain default no-fallback))
695 696
696 (defun set-face-dim-p (face dim-p &optional locale tag-set how-to-add) 697 (defun set-face-dim-p (face dim-p &optional locale tag-set how-to-add)
697 "Change whether FACE is dimmed in LOCALE. 698 "Change whether FACE is dimmed in LOCALE.
698 DIM-P is normally a face-boolean instantiator; see 699 DIM-P is normally a face-boolean instantiator; see
699 `face-boolean-specifier-p'. 700 `make-face-boolean-specifier'.
700 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and 701 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
701 HOW-TO-ADD arguments." 702 HOW-TO-ADD arguments."
702 (interactive (face-interactive "dim-p" "dimmed")) 703 (interactive (face-interactive "dim-p" "dimmed"))
703 (set-face-property face 'dim dim-p locale tag-set how-to-add)) 704 (set-face-property face 'dim dim-p locale tag-set how-to-add))
704 705
709 710
710 (defun set-face-blinking-p (face blinking-p &optional locale tag-set 711 (defun set-face-blinking-p (face blinking-p &optional locale tag-set
711 how-to-add) 712 how-to-add)
712 "Change whether FACE is blinking in LOCALE (TTY locales only). 713 "Change whether FACE is blinking in LOCALE (TTY locales only).
713 BLINKING-P is normally a face-boolean instantiator; see 714 BLINKING-P is normally a face-boolean instantiator; see
714 `face-boolean-specifier-p'. 715 `make-face-boolean-specifier'.
715 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and 716 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
716 HOW-TO-ADD arguments." 717 HOW-TO-ADD arguments."
717 (interactive (face-interactive "blinking-p" "blinking")) 718 (interactive (face-interactive "blinking-p" "blinking"))
718 (set-face-property face 'blinking blinking-p locale tag-set how-to-add)) 719 (set-face-property face 'blinking blinking-p locale tag-set how-to-add))
719 720
723 (face-property-instance face 'reverse domain default no-fallback)) 724 (face-property-instance face 'reverse domain default no-fallback))
724 725
725 (defun set-face-reverse-p (face reverse-p &optional locale tag-set how-to-add) 726 (defun set-face-reverse-p (face reverse-p &optional locale tag-set how-to-add)
726 "Change whether FACE is reversed in LOCALE (TTY locales only). 727 "Change whether FACE is reversed in LOCALE (TTY locales only).
727 REVERSE-P is normally a face-boolean instantiator; see 728 REVERSE-P is normally a face-boolean instantiator; see
728 `face-boolean-specifier-p'. 729 `make-face-boolean-specifier'.
729 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and 730 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
730 HOW-TO-ADD arguments." 731 HOW-TO-ADD arguments."
731 (interactive (face-interactive "reverse-p" "reversed")) 732 (interactive (face-interactive "reverse-p" "reversed"))
732 (set-face-property face 'reverse reverse-p locale tag-set how-to-add)) 733 (set-face-property face 'reverse reverse-p locale tag-set how-to-add))
733 734
792 ;; WE DEMAND LEXICAL SCOPING!!! 793 ;; WE DEMAND LEXICAL SCOPING!!!
793 ;; WE DEMAND LEXICAL SCOPING!!! 794 ;; WE DEMAND LEXICAL SCOPING!!!
794 ;; WE DEMAND LEXICAL SCOPING!!! 795 ;; WE DEMAND LEXICAL SCOPING!!!
795 ;; WE DEMAND LEXICAL SCOPING!!! 796 ;; WE DEMAND LEXICAL SCOPING!!!
796 ;; WE DEMAND LEXICAL SCOPING!!! 797 ;; WE DEMAND LEXICAL SCOPING!!!
797 (defun frob-face-property (face property func &optional locale tags) 798 (defun frob-face-property (face property func device-tags &optional
799 locale tags)
798 "Change the specifier for FACE's PROPERTY according to FUNC, in LOCALE. 800 "Change the specifier for FACE's PROPERTY according to FUNC, in LOCALE.
799 This function is ugly and messy and is primarily used as an internal 801 This function is ugly and messy and is primarily used as an internal
800 helper function for `make-face-bold' et al., so you probably don't 802 helper function for `make-face-bold' et al., so you probably don't
801 want to use it or read the rest of the documentation. But if you do ... 803 want to use it or read the rest of the documentation. But if you do ...
802 804
811 iterated over all valid instantiators for the device of the domain 813 iterated over all valid instantiators for the device of the domain
812 until a non-nil result is found (if there is no such result, the 814 until a non-nil result is found (if there is no such result, the
813 first valid instantiator is used), and that result substituted for 815 first valid instantiator is used), and that result substituted for
814 the specification; otherwise, the process just outlined is 816 the specification; otherwise, the process just outlined is
815 iterated over each existing device and the concatenated results 817 iterated over each existing device and the concatenated results
816 substituted for the specification." 818 substituted for the specification.
819
820 DEVICE-TAGS is a list of tags that each device must match in order for
821 the function to be called on it."
817 (let ((sp (face-property face property)) 822 (let ((sp (face-property face property))
818 temp-sp) 823 temp-sp)
819 (if (valid-specifier-domain-p locale) 824 (if (valid-specifier-domain-p locale)
820 ;; this is easy. 825 ;; this is easy.
821 (let* ((inst (face-property-instance face property locale)) 826 (let* ((inst (face-property-instance face property locale))
822 (name (and inst (funcall func inst (dfw-device locale))))) 827 (name (and inst
828 (device-matches-specifier-tag-set-p
829 (dfw-device locale) device-tags)
830 (funcall func inst (dfw-device locale)))))
823 (when name 831 (when name
824 (add-spec-to-specifier sp name locale tags))) 832 (add-spec-to-specifier sp name locale tags)))
825 ;; otherwise, map over all specifications ... 833 ;; otherwise, map over all specifications ...
826 ;; but first, some further kludging: 834 ;; but first, some further kludging:
827 ;; (1) if we're frobbing the global property, make sure 835 ;; (1) if we're frobbing the global property, make sure
850 ;; if a device can be derived from the locale, 858 ;; if a device can be derived from the locale,
851 ;; call frob-face-property-1 for that device. 859 ;; call frob-face-property-1 for that device.
852 ;; Otherwise map frob-face-property-1 over each device. 860 ;; Otherwise map frob-face-property-1 over each device.
853 (result 861 (result
854 (if device 862 (if device
855 (list (frob-face-property-1 sp-arg device inst-list func)) 863 (list (and (device-matches-specifier-tag-set-p
864 device device-tags)
865 (frob-face-property-1 sp-arg device inst-list
866 func)))
856 (mapcar (lambda (device) 867 (mapcar (lambda (device)
857 (frob-face-property-1 sp-arg device 868 (and (device-matches-specifier-tag-set-p
858 inst-list func)) 869 device device-tags)
870 (frob-face-property-1 sp-arg device
871 inst-list func)))
859 (device-list)))) 872 (device-list))))
860 new-result) 873 new-result)
861 ;; remove duplicates and nils from the obtained list of 874 ;; remove duplicates and nils from the obtained list of
862 ;; instantiators. Also add tags amd remove 'defaults'. 875 ;; instantiators. Also add tags amd remove 'defaults'.
863 (mapcar (lambda (arg) 876 (mapcar (lambda (arg)
864 (when arg 877 (when arg
865 (if (not (consp arg)) 878 (if (not (consp arg))
866 (setq arg (cons tags arg)) 879 (setq arg (cons tags arg))
867 (setcar arg (append tags (delete 'default 880 (setcar arg (append tags (delete 'default
868 (car arg)))))) 881 (car arg))))))
869 (when (and arg (not (member arg new-result))) 882 (when (and arg (not (member arg new-result)))
870 (setq new-result (cons arg new-result)))) 883 (setq new-result (cons arg new-result))))
871 result) 884 result)
872 ;; add back in. 885 ;; add back in.
873 (add-spec-list-to-specifier sp (list (cons locale new-result))) 886 (add-spec-list-to-specifier sp (list (cons locale new-result)))
874 ;; tell map-specifier to keep going. 887 ;; tell map-specifier to keep going.
893 (setq result (cons tag-set result)))))) 906 (setq result (cons tag-set result))))))
894 (setq inst-list (cdr inst-list))) 907 (setq inst-list (cdr inst-list)))
895 (or result first-valid))) 908 (or result first-valid)))
896 909
897 (defun frob-face-font-2 (face locale tags unfrobbed-face frobbed-face 910 (defun frob-face-font-2 (face locale tags unfrobbed-face frobbed-face
898 tty-thunk x-thunk standard-face-mapping) 911 tty-thunk ws-thunk standard-face-mapping)
899 ;; another kludge to make things more intuitive. If we're 912 ;; another kludge to make things more intuitive. If we're
900 ;; inheriting from a standard face in this locale, frob the 913 ;; inheriting from a standard face in this locale, frob the
901 ;; inheritance as appropriate. Else, if, after the first X frobbing 914 ;; inheritance as appropriate. Else, if, after the first
902 ;; pass, the face hasn't changed and still looks like the standard 915 ;; window-system frobbing pass, the face hasn't changed and still
903 ;; unfrobbed face (e.g. 'default), make it inherit from the standard 916 ;; looks like the standard unfrobbed face (e.g. 'default), make it
904 ;; frobbed face (e.g. 'bold). Regardless of things, do the TTY 917 ;; inherit from the standard frobbed face (e.g. 'bold). Regardless
905 ;; frobbing. 918 ;; of things, do the TTY frobbing.
906 919
907 ;; yuck -- The LOCALE argument to make-face-bold is not actually a locale, 920 ;; yuck -- The LOCALE argument to make-face-bold is not actually a locale,
908 ;; but is a "locale, locale-type, or nil for all". So ... do our extra 921 ;; but is a "locale, locale-type, or nil for all". So ... do our extra
909 ;; frobbing only if it's actually a locale; or for nil, do the frobbing 922 ;; frobbing only if it's actually a locale; or for nil, do the frobbing
910 ;; on 'global. This specifier stuff needs some rethinking. 923 ;; on 'global. This specifier stuff needs some rethinking.
928 ((or (eq the-locale 'global) (eq the-locale 'all)) 941 ((or (eq the-locale 'global) (eq the-locale 'all))
929 (selected-device)) 942 (selected-device))
930 (t nil))) 943 (t nil)))
931 (inst (and domain (face-property-instance face 'font domain)))) 944 (inst (and domain (face-property-instance face 'font domain))))
932 (funcall tty-thunk) 945 (funcall tty-thunk)
933 (funcall x-thunk) 946 (funcall ws-thunk)
934 ;; If it's reasonable to do the inherit-from-standard-face trick, 947 ;; If it's reasonable to do the inherit-from-standard-face trick,
935 ;; and it's called for, then do it now. 948 ;; and it's called for, then do it now.
936 (or (null domain) 949 (or (null domain)
937 (not (equal inst (face-property-instance face 'font domain))) 950 (not (equal inst (face-property-instance face 'font domain)))
938 ;; don't do it for standard faces, or you'll get inheritance loops. 951 ;; don't do it for standard faces, or you'll get inheritance loops.
944 (set-face-property face 'font (vector frobbed-face) 957 (set-face-property face 'font (vector frobbed-face)
945 the-locale tags)))))) 958 the-locale tags))))))
946 959
947 (defun make-face-bold (face &optional locale tags) 960 (defun make-face-bold (face &optional locale tags)
948 "Make FACE bold in LOCALE, if possible. 961 "Make FACE bold in LOCALE, if possible.
949 This will attempt to make the font bold for X locales and will set the 962 This will attempt to make the font bold for X/MSW locales and will set the
950 highlight flag for TTY locales. 963 highlight flag for TTY locales.
951 964
952 If LOCALE is nil, omitted, or `all', this will attempt to frob all 965 If LOCALE is nil, omitted, or `all', this will attempt to frob all
953 font specifications for FACE to make them appear bold. Similarly, if 966 font specifications for FACE to make them appear bold. Similarly, if
954 LOCALE is a locale type, this frobs all font specifications for locales 967 LOCALE is a locale type, this frobs all font specifications for locales
977 (lambda () 990 (lambda ()
978 ;; handle TTY specific entries 991 ;; handle TTY specific entries
979 (when (featurep 'tty) 992 (when (featurep 'tty)
980 (set-face-highlight-p face t locale (cons 'tty tags)))) 993 (set-face-highlight-p face t locale (cons 'tty tags))))
981 (lambda () 994 (lambda ()
982 ;; handle X specific entries 995 ;; handle X/MS Windows specific entries
983 (when (featurep 'x) 996 (when (featurep 'x)
984 (frob-face-property face 'font 'x-make-font-bold locale tags)) 997 (frob-face-property face 'font 'x-make-font-bold
998 '(x) locale tags))
985 (when (featurep 'mswindows) 999 (when (featurep 'mswindows)
986 (frob-face-property face 'font 'mswindows-make-font-bold locale tags)) 1000 (frob-face-property face 'font 'mswindows-make-font-bold
1001 '(mswindows) locale tags))
987 ) 1002 )
988 '(([default] . [bold]) 1003 '(([default] . [bold])
989 ([bold] . t) 1004 ([bold] . t)
990 ([italic] . [bold-italic]) 1005 ([italic] . [bold-italic])
991 ([bold-italic] . t)))) 1006 ([bold-italic] . t))))
992 1007
993 (defun make-face-italic (face &optional locale tags) 1008 (defun make-face-italic (face &optional locale tags)
994 "Make FACE italic in LOCALE, if possible. 1009 "Make FACE italic in LOCALE, if possible.
995 This will attempt to make the font italic for X locales and will set 1010 This will attempt to make the font italic for X/MS Windows locales and
996 the underline flag for TTY locales. 1011 will set the underline flag for TTY locales. See `make-face-bold' for
997 See `make-face-bold' for the semantics of the LOCALE argument and 1012 the semantics of the LOCALE argument and for more specifics on exactly
998 for more specifics on exactly how this function works." 1013 how this function works."
999 (interactive (list (read-face-name "Make which face italic: "))) 1014 (interactive (list (read-face-name "Make which face italic: ")))
1000 (frob-face-font-2 1015 (frob-face-font-2
1001 face locale tags 'default 'italic 1016 face locale tags 'default 'italic
1002 (lambda () 1017 (lambda ()
1003 ;; handle TTY specific entries 1018 ;; handle TTY specific entries
1004 (when (featurep 'tty) 1019 (when (featurep 'tty)
1005 (set-face-underline-p face t locale (cons 'tty tags)))) 1020 (set-face-underline-p face t locale (cons 'tty tags))))
1006 (lambda () 1021 (lambda ()
1007 ;; handle X specific entries 1022 ;; handle X specific entries
1008 (when (featurep 'x) 1023 (when (featurep 'x)
1009 (frob-face-property face 'font 'x-make-font-italic locale tags)) 1024 (frob-face-property face 'font 'x-make-font-italic
1025 '(x) locale tags))
1010 (when (featurep 'mswindows) 1026 (when (featurep 'mswindows)
1011 (frob-face-property face 'font 'mswindows-make-font-italic locale tags)) 1027 (frob-face-property face 'font 'mswindows-make-font-italic
1028 '(mswindows) locale tags))
1012 ) 1029 )
1013 '(([default] . [italic]) 1030 '(([default] . [italic])
1014 ([bold] . [bold-italic]) 1031 ([bold] . [bold-italic])
1015 ([italic] . t) 1032 ([italic] . t)
1016 ([bold-italic] . t)))) 1033 ([bold-italic] . t))))
1017 1034
1018 (defun make-face-bold-italic (face &optional locale tags) 1035 (defun make-face-bold-italic (face &optional locale tags)
1019 "Make FACE bold and italic in LOCALE, if possible. 1036 "Make FACE bold and italic in LOCALE, if possible.
1020 This will attempt to make the font bold-italic for X locales and will 1037 This will attempt to make the font bold-italic for X/MS Windows
1021 set the highlight and underline flags for TTY locales. 1038 locales and will set the highlight and underline flags for TTY
1022 See `make-face-bold' for the semantics of the LOCALE argument and 1039 locales. See `make-face-bold' for the semantics of the LOCALE
1023 for more specifics on exactly how this function works." 1040 argument and for more specifics on exactly how this function works."
1024 (interactive (list (read-face-name "Make which face bold-italic: "))) 1041 (interactive (list (read-face-name "Make which face bold-italic: ")))
1025 (frob-face-font-2 1042 (frob-face-font-2
1026 face locale tags 'default 'bold-italic 1043 face locale tags 'default 'bold-italic
1027 (lambda () 1044 (lambda ()
1028 ;; handle TTY specific entries 1045 ;; handle TTY specific entries
1030 (set-face-highlight-p face t locale (cons 'tty tags)) 1047 (set-face-highlight-p face t locale (cons 'tty tags))
1031 (set-face-underline-p face t locale (cons 'tty tags)))) 1048 (set-face-underline-p face t locale (cons 'tty tags))))
1032 (lambda () 1049 (lambda ()
1033 ;; handle X specific entries 1050 ;; handle X specific entries
1034 (when (featurep 'x) 1051 (when (featurep 'x)
1035 (frob-face-property face 'font 'x-make-font-bold-italic locale tags)) 1052 (frob-face-property face 'font 'x-make-font-bold-italic
1053 '(x) locale tags))
1036 (when (featurep 'mswindows) 1054 (when (featurep 'mswindows)
1037 (frob-face-property face 'font 'mswindows-make-font-bold-italic locale tags)) 1055 (frob-face-property face 'font 'mswindows-make-font-bold-italic
1056 '(mswindows) locale tags))
1038 ) 1057 )
1039 '(([default] . [italic]) 1058 '(([default] . [italic])
1040 ([bold] . [bold-italic]) 1059 ([bold] . [bold-italic])
1041 ([italic] . [bold-italic]) 1060 ([italic] . [bold-italic])
1042 ([bold-italic] . t)))) 1061 ([bold-italic] . t))))
1043 1062
1044 (defun make-face-unbold (face &optional locale tags) 1063 (defun make-face-unbold (face &optional locale tags)
1045 "Make FACE non-bold in LOCALE, if possible. 1064 "Make FACE non-bold in LOCALE, if possible.
1046 This will attempt to make the font non-bold for X locales and will 1065 This will attempt to make the font non-bold for X/MS Windows locales
1047 unset the highlight flag for TTY locales. 1066 and will unset the highlight flag for TTY locales. See
1048 See `make-face-bold' for the semantics of the LOCALE argument and 1067 `make-face-bold' for the semantics of the LOCALE argument and for more
1049 for more specifics on exactly how this function works." 1068 specifics on exactly how this function works."
1050 (interactive (list (read-face-name "Make which face non-bold: "))) 1069 (interactive (list (read-face-name "Make which face non-bold: ")))
1051 (frob-face-font-2 1070 (frob-face-font-2
1052 face locale tags 'bold 'default 1071 face locale tags 'bold 'default
1053 (lambda () 1072 (lambda ()
1054 ;; handle TTY specific entries 1073 ;; handle TTY specific entries
1055 (when (featurep 'tty) 1074 (when (featurep 'tty)
1056 (set-face-highlight-p face nil locale (cons 'tty tags)))) 1075 (set-face-highlight-p face nil locale (cons 'tty tags))))
1057 (lambda () 1076 (lambda ()
1058 ;; handle X specific entries 1077 ;; handle X specific entries
1059 (when (featurep 'x) 1078 (when (featurep 'x)
1060 (frob-face-property face 'font 'x-make-font-unbold locale tags)) 1079 (frob-face-property face 'font 'x-make-font-unbold
1080 '(x) locale tags))
1061 (when (featurep 'mswindows) 1081 (when (featurep 'mswindows)
1062 (frob-face-property face 'font 'mswindows-make-font-unbold locale tags)) 1082 (frob-face-property face 'font 'mswindows-make-font-unbold
1083 '(mswindows) locale tags))
1063 ) 1084 )
1064 '(([default] . t) 1085 '(([default] . t)
1065 ([bold] . [default]) 1086 ([bold] . [default])
1066 ([italic] . t) 1087 ([italic] . t)
1067 ([bold-italic] . [italic])))) 1088 ([bold-italic] . [italic]))))
1068 1089
1069 (defun make-face-unitalic (face &optional locale tags) 1090 (defun make-face-unitalic (face &optional locale tags)
1070 "Make FACE non-italic in LOCALE, if possible. 1091 "Make FACE non-italic in LOCALE, if possible.
1071 This will attempt to make the font non-italic for X locales and will 1092 This will attempt to make the font non-italic for X/MS Windows locales
1072 unset the underline flag for TTY locales. 1093 and will unset the underline flag for TTY locales. See
1073 See `make-face-bold' for the semantics of the LOCALE argument and 1094 `make-face-bold' for the semantics of the LOCALE argument and for more
1074 for more specifics on exactly how this function works." 1095 specifics on exactly how this function works."
1075 (interactive (list (read-face-name "Make which face non-italic: "))) 1096 (interactive (list (read-face-name "Make which face non-italic: ")))
1076 (frob-face-font-2 1097 (frob-face-font-2
1077 face locale tags 'italic 'default 1098 face locale tags 'italic 'default
1078 (lambda () 1099 (lambda ()
1079 ;; handle TTY specific entries 1100 ;; handle TTY specific entries
1080 (when (featurep 'tty) 1101 (when (featurep 'tty)
1081 (set-face-underline-p face nil locale (cons 'tty tags)))) 1102 (set-face-underline-p face nil locale (cons 'tty tags))))
1082 (lambda () 1103 (lambda ()
1083 ;; handle X specific entries 1104 ;; handle X specific entries
1084 (when (featurep 'x) 1105 (when (featurep 'x)
1085 (frob-face-property face 'font 'x-make-font-unitalic locale tags)) 1106 (frob-face-property face 'font 'x-make-font-unitalic
1107 '(x) locale tags))
1086 (when (featurep 'mswindows) 1108 (when (featurep 'mswindows)
1087 (frob-face-property face 'font 'mswindows-make-font-unitalic locale tags)) 1109 (frob-face-property face 'font 'mswindows-make-font-unitalic
1110 '(mswindows) locale tags))
1088 ) 1111 )
1089 '(([default] . t) 1112 '(([default] . t)
1090 ([bold] . t) 1113 ([bold] . t)
1091 ([italic] . [default]) 1114 ([italic] . [default])
1092 ([bold-italic] . [bold])))) 1115 ([bold-italic] . [bold]))))
1101 from-the-bold-face'' operations described there are not done 1124 from-the-bold-face'' operations described there are not done
1102 because they don't make sense in this context." 1125 because they don't make sense in this context."
1103 (interactive (list (read-face-name "Shrink which face: "))) 1126 (interactive (list (read-face-name "Shrink which face: ")))
1104 ;; handle X specific entries 1127 ;; handle X specific entries
1105 (when (featurep 'x) 1128 (when (featurep 'x)
1106 (frob-face-property face 'font 'x-find-smaller-font locale)) 1129 (frob-face-property face 'font 'x-find-smaller-font
1130 '(x) locale))
1107 (when (featurep 'mswindows) 1131 (when (featurep 'mswindows)
1108 (frob-face-property face 'font 'mswindows-find-smaller-font locale))) 1132 (frob-face-property face 'font 'mswindows-find-smaller-font
1133 '(mswindows) locale)))
1109 1134
1110 (defun make-face-larger (face &optional locale) 1135 (defun make-face-larger (face &optional locale)
1111 "Make the font of FACE be larger, if possible. 1136 "Make the font of FACE be larger, if possible.
1112 See `make-face-smaller' for the semantics of the LOCALE argument." 1137 See `make-face-smaller' for the semantics of the LOCALE argument."
1113 (interactive (list (read-face-name "Enlarge which face: "))) 1138 (interactive (list (read-face-name "Enlarge which face: ")))
1114 ;; handle X specific entries 1139 ;; handle X specific entries
1115 (when (featurep 'x) 1140 (when (featurep 'x)
1116 (frob-face-property face 'font 'x-find-larger-font locale)) 1141 (frob-face-property face 'font 'x-find-larger-font
1142 '(x) locale))
1117 (when (featurep 'mswindows) 1143 (when (featurep 'mswindows)
1118 (frob-face-property face 'font 'mswindows-find-larger-font locale))) 1144 (frob-face-property face 'font 'mswindows-find-larger-font
1145 '(mswindows) locale)))
1119 1146
1120 (defun invert-face (face &optional locale) 1147 (defun invert-face (face &optional locale)
1121 "Swap the foreground and background colors of the face." 1148 "Swap the foreground and background colors of the face."
1122 (interactive (list (read-face-name "Invert face: "))) 1149 (interactive (list (read-face-name "Invert face: ")))
1123 (if (valid-specifier-domain-p locale) 1150 (if (valid-specifier-domain-p locale)
1246 (put face 'custom-face-display display)) 1273 (put face 'custom-face-display display))
1247 (setq spec nil))))) 1274 (setq spec nil)))))
1248 1275
1249 (defvar default-custom-frame-properties nil 1276 (defvar default-custom-frame-properties nil
1250 "The frame properties used for the global faces. 1277 "The frame properties used for the global faces.
1251 Frames not matching these propertiess should have frame local faces. 1278 Frames not matching these properties should have frame local faces.
1252 The value should be nil, if uninitialized, or a plist otherwise. 1279 The value should be nil, if uninitialized, or a plist otherwise.
1253 See `defface' for a list of valid keys and values for the plist.") 1280 See `defface' for a list of valid keys and values for the plist.")
1254 1281
1255 (defun get-custom-frame-properties (&optional frame) 1282 (defun get-custom-frame-properties (&optional frame)
1256 "Return a plist with the frame properties of FRAME used by custom. 1283 "Return a plist with the frame properties of FRAME used by custom.
1587 (face-property-equal 'text-cursor 'default 'foreground device)) 1614 (face-property-equal 'text-cursor 'default 'foreground device))
1588 (set-face-foreground 'text-cursor [default background] 'global 1615 (set-face-foreground 'text-cursor [default background] 'global
1589 nil 'append)) 1616 nil 'append))
1590 ) 1617 )
1591 1618
1592 ;; New function with 20.1, suggested by Per Abrahamsen, coded by Kyle Jones. 1619 ;; New function with 20.1, suggested by Per Abrahamsen, coded by Kyle
1620 ;; Jones and Hrvoje Niksic.
1593 (defun set-face-stipple (face pixmap &optional frame) 1621 (defun set-face-stipple (face pixmap &optional frame)
1594 "Change the stipple pixmap of FACE to PIXMAP. 1622 "Change the stipple pixmap of FACE to PIXMAP.
1595 This is an Emacs compatibility function; consider using 1623 This is an Emacs compatibility function; consider using
1596 set-face-background-pixmap instead. 1624 set-face-background-pixmap instead.
1597 1625
1598 PIXMAP should be a string, the name of a file of pixmap data. 1626 PIXMAP should be a string, the name of a file of pixmap data.
1599 The directories listed in the `x-bitmap-file-path' variable are searched. 1627 The directories listed in the variables `x-bitmap-file-path' and
1628 `mswindows-bitmap-file-path' under X and MS Windows respectively
1629 are searched.
1600 1630
1601 Alternatively, PIXMAP may be a list of the form (WIDTH HEIGHT 1631 Alternatively, PIXMAP may be a list of the form (WIDTH HEIGHT
1602 DATA) where WIDTH and HEIGHT are the size in pixels, and DATA is 1632 DATA) where WIDTH and HEIGHT are the size in pixels, and DATA is
1603 a string, containing the raw bits of the bitmap. XBM data is 1633 a string, containing the raw bits of the bitmap. XBM data is
1604 expected in this case, other types of image data will not work. 1634 expected in this case, other types of image data will not work.
1605 1635
1606 If the optional FRAME argument is provided, change only 1636 If the optional FRAME argument is provided, change only
1607 in that frame; otherwise change each frame." 1637 in that frame; otherwise change each frame."
1608 (while (not (find-face face)) 1638 (while (not (find-face face))
1609 (setq face (signal 'wrong-type-argument (list 'facep face)))) 1639 (setq face (signal 'wrong-type-argument (list 'facep face))))
1610 (locate-file pixmap x-bitmap-file-path '(".xbm" "")) 1640 (let ((bitmap-path (ecase (console-type)
1611 (while (cond ((stringp pixmap) 1641 (x x-bitmap-file-path)
1612 (unless (file-readable-p pixmap) 1642 (mswindows mswindows-bitmap-file-path)))
1613 (setq pixmap `[xbm :file ,pixmap])) 1643 instantiator)
1614 nil) 1644 (while
1615 ((and (consp pixmap) (= (length pixmap) 3)) 1645 (null
1616 (setq pixmap `[xbm :data ,pixmap]) 1646 (setq instantiator
1617 nil) 1647 (cond ((stringp pixmap)
1618 (t t)) 1648 (let ((file (if (file-name-absolute-p pixmap)
1619 (setq pixmap (signal 'wrong-type-argument 1649 pixmap
1620 (list 'stipple-pixmap-p pixmap)))) 1650 (locate-file pixmap bitmap-path
1621 (while (and frame (not (framep frame))) 1651 '(".xbm" "")))))
1622 (setq frame (signal 'wrong-type-argument (list 'framep frame)))) 1652 (and file
1623 (set-face-background-pixmap face pixmap frame)) 1653 `[xbm :file ,file])))
1654 ((and (listp pixmap) (= (length pixmap) 3))
1655 `[xbm :data ,pixmap])
1656 (t nil))))
1657 ;; We're signaling a continuable error; let's make sure the
1658 ;; function `stipple-pixmap-p' at least exists.
1659 (flet ((stipple-pixmap-p (pixmap)
1660 (or (stringp pixmap)
1661 (and (listp pixmap) (= (length pixmap) 3)))))
1662 (setq pixmap (signal 'wrong-type-argument
1663 (list 'stipple-pixmap-p pixmap)))))
1664 (while (and frame (not (framep frame)))
1665 (setq frame (signal 'wrong-type-argument (list 'framep frame))))
1666 (set-face-background-pixmap face instantiator frame)))
1624 1667
1625 1668
1626 ;; Create the remaining standard faces now. This way, packages that we dump 1669 ;; Create the remaining standard faces now. This way, packages that we dump
1627 ;; can reference these faces as parents. 1670 ;; can reference these faces as parents.
1628 ;; 1671 ;;
1743 (purecopy '("backgroundToolBarColor" 1786 (purecopy '("backgroundToolBarColor"
1744 (or 1787 (or
1745 (and 1788 (and
1746 (featurep 'x) 1789 (featurep 'x)
1747 (x-get-resource "backgroundToolBarColor" 1790 (x-get-resource "backgroundToolBarColor"
1748 "BackgroundToolBarColor" 'string)) 1791 "BackgroundToolBarColor" 'string
1792 nil nil 'warn))
1749 1793
1750 (face-background 'toolbar)))) 1794 (face-background 'toolbar))))
1751 (purecopy '("foregroundToolBarColor" 1795 (purecopy '("foregroundToolBarColor"
1752 (or 1796 (or
1753 (and 1797 (and
1754 (featurep 'x) 1798 (featurep 'x)
1755 (x-get-resource "foregroundToolBarColor" 1799 (x-get-resource "foregroundToolBarColor"
1756 "ForegroundToolBarColor" 'string)) 1800 "ForegroundToolBarColor" 'string
1801 nil nil 'warn))
1757 (face-foreground 'toolbar)))) 1802 (face-foreground 'toolbar))))
1758 ))) 1803 )))
1759 1804
1760 (when (featurep 'tty) 1805 (when (featurep 'tty)
1761 (set-face-highlight-p 'bold t 'global '(default tty)) 1806 (set-face-highlight-p 'bold t 'global '(default tty))