Mercurial > hg > xemacs-beta

comparison lisp/faces.el @ 398:74fd4e045ea6 r21-2-29

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 064ab7fed2e0
children b8cc9ab3f761
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
29 ;;; Commentary: 29 ;;; Commentary:
30 30
31 ;; This file is dumped with XEmacs. 31 ;; This file is dumped with XEmacs.
32 32
33 ;; face implementation #1 (used Lisp vectors and parallel C vectors; 33 ;; face implementation #1 (used Lisp vectors and parallel C vectors;
34 ;; FSFmacs still uses this) authored by Jamie Zawinski <jwz@netscape.com> 34 ;; FSFmacs still uses this) authored by Jamie Zawinski <jwz@jwz.org>
35 ;; pre Lucid-Emacs 19.0. 35 ;; pre Lucid-Emacs 19.0.
36 36
37 ;; face implementation #2 (used one face object per frame per face) 37 ;; face implementation #2 (used one face object per frame per face)
38 ;; authored by Jamie Zawinski for 19.9. 38 ;; authored by Jamie Zawinski for 19.9.
39 39
792 ;; WE DEMAND LEXICAL SCOPING!!! 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 (defun frob-face-property (face property func &optional locale) 797 (defun frob-face-property (face property func &optional locale tags)
798 "Change the specifier for FACE's PROPERTY according to FUNC, in LOCALE. 798 "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 799 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 800 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 ... 801 want to use it or read the rest of the documentation. But if you do ...
802 802
812 until a non-nil result is found (if there is no such result, the 812 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 813 first valid instantiator is used), and that result substituted for
814 the specification; otherwise, the process just outlined is 814 the specification; otherwise, the process just outlined is
815 iterated over each existing device and the concatenated results 815 iterated over each existing device and the concatenated results
816 substituted for the specification." 816 substituted for the specification."
817 (let ((sp (face-property face property))) 817 (let ((sp (face-property face property))
818 temp-sp)
818 (if (valid-specifier-domain-p locale) 819 (if (valid-specifier-domain-p locale)
819 ;; this is easy. 820 ;; this is easy.
820 (let* ((inst (face-property-instance face property locale)) 821 (let* ((inst (face-property-instance face property locale))
821 (name (and inst (funcall func inst (dfw-device locale))))) 822 (name (and inst (funcall func inst (dfw-device locale)))))
822 (when name 823 (when name
823 (add-spec-to-specifier sp name locale))) 824 (add-spec-to-specifier sp name locale tags)))
824 ;; otherwise, map over all specifications ... 825 ;; otherwise, map over all specifications ...
825 ;; but first, some further kludging: 826 ;; but first, some further kludging:
826 ;; (1) if we're frobbing the global property, make sure 827 ;; (1) if we're frobbing the global property, make sure
827 ;; that something is there (copy from the default face, 828 ;; that something is there (copy from the default face,
828 ;; if necessary). Otherwise, something like 829 ;; if necessary). Otherwise, something like
830 ;; won't do anything at all if the modeline simply 831 ;; won't do anything at all if the modeline simply
831 ;; inherits its font from 'default. 832 ;; inherits its font from 'default.
832 ;; (2) if we're frobbing a particular locale, nothing would 833 ;; (2) if we're frobbing a particular locale, nothing would
833 ;; happen if that locale has no instantiators. So signal 834 ;; happen if that locale has no instantiators. So signal
834 ;; an error to indicate this. 835 ;; an error to indicate this.
836
837
838 (setq temp-sp (copy-specifier sp))
835 (if (and (or (eq locale 'global) (eq locale 'all) (not locale)) 839 (if (and (or (eq locale 'global) (eq locale 'all) (not locale))
836 (not (face-property face property 'global))) 840 (not (face-property face property 'global)))
837 (copy-specifier (face-property 'default property) 841 (copy-specifier (face-property 'default property)
838 (face-property face property) 842 temp-sp 'global))
839 'global))
840 (if (and (valid-specifier-locale-p locale) 843 (if (and (valid-specifier-locale-p locale)
841 (not (face-property face property locale))) 844 (not (specifier-specs temp-sp locale)))
842 (error "Property must have a specification in locale %S" locale)) 845 (error "Property must have a specification in locale %S" locale))
843 (map-specifier 846 (map-specifier
844 sp 847 temp-sp
845 (lambda (sp locale inst-list func) 848 (lambda (sp-arg locale inst-list func)
846 (let* ((device (dfw-device locale)) 849 (let* ((device (dfw-device locale))
847 ;; if a device can be derived from the locale, 850 ;; if a device can be derived from the locale,
848 ;; call frob-face-property-1 for that device. 851 ;; call frob-face-property-1 for that device.
849 ;; Otherwise map frob-face-property-1 over each device. 852 ;; Otherwise map frob-face-property-1 over each device.
850 (result 853 (result
851 (if device 854 (if device
852 (list (frob-face-property-1 sp device inst-list func)) 855 (list (frob-face-property-1 sp-arg device inst-list func))
853 (mapcar (lambda (device) 856 (mapcar (lambda (device)
854 (frob-face-property-1 sp device 857 (frob-face-property-1 sp-arg device
855 inst-list func)) 858 inst-list func))
856 (device-list)))) 859 (device-list))))
857 new-result) 860 new-result)
858 ;; remove duplicates and nils from the obtained list of 861 ;; remove duplicates and nils from the obtained list of
859 ;; instantiators. 862 ;; instantiators. Also add tags amd remove 'defaults'.
860 (mapcar (lambda (arg) 863 (mapcar (lambda (arg)
861 (when (and arg (not (member arg new-result))) 864 (when arg
865 (if (not (consp arg))
866 (setq arg (cons tags arg))
867 (setcar arg (append tags (delete 'default
868 (car arg))))))
869 (when (and arg (not (member arg new-result)))
862 (setq new-result (cons arg new-result)))) 870 (setq new-result (cons arg new-result))))
863 result) 871 result)
864 ;; add back in. 872 ;; add back in.
865 (add-spec-list-to-specifier sp (list (cons locale new-result))) 873 (add-spec-list-to-specifier sp (list (cons locale new-result)))
866 ;; tell map-specifier to keep going. 874 ;; tell map-specifier to keep going.
884 (if result 892 (if result
885 (setq result (cons tag-set result)))))) 893 (setq result (cons tag-set result))))))
886 (setq inst-list (cdr inst-list))) 894 (setq inst-list (cdr inst-list)))
887 (or result first-valid))) 895 (or result first-valid)))
888 896
889 (defun frob-face-font-2 (face locale unfrobbed-face frobbed-face 897 (defun frob-face-font-2 (face locale tags unfrobbed-face frobbed-face
890 tty-thunk x-thunk standard-face-mapping) 898 tty-thunk x-thunk standard-face-mapping)
891 ;; another kludge to make things more intuitive. If we're 899 ;; another kludge to make things more intuitive. If we're
892 ;; inheriting from a standard face in this locale, frob the 900 ;; inheriting from a standard face in this locale, frob the
893 ;; inheritance as appropriate. Else, if, after the first X frobbing 901 ;; inheritance as appropriate. Else, if, after the first X frobbing
894 ;; pass, the face hasn't changed and still looks like the standard 902 ;; pass, the face hasn't changed and still looks like the standard
932 (memq (face-name (find-face face)) 940 (memq (face-name (find-face face))
933 '(default bold italic bold-italic)) 941 '(default bold italic bold-italic))
934 (not (equal (face-property-instance face 'font domain) 942 (not (equal (face-property-instance face 'font domain)
935 (face-property-instance unfrobbed-face 'font domain))) 943 (face-property-instance unfrobbed-face 'font domain)))
936 (set-face-property face 'font (vector frobbed-face) 944 (set-face-property face 'font (vector frobbed-face)
937 the-locale)))))) 945 the-locale tags))))))
938 946
939 (defun make-face-bold (face &optional locale) 947 (defun make-face-bold (face &optional locale tags)
940 "Make FACE bold in LOCALE, if possible. 948 "Make FACE bold in LOCALE, if possible.
941 This will attempt to make the font bold for X locales and will set the 949 This will attempt to make the font bold for X locales and will set the
942 highlight flag for TTY locales. 950 highlight flag for TTY locales.
943 951
944 If LOCALE is nil, omitted, or `all', this will attempt to frob all 952 If LOCALE is nil, omitted, or `all', this will attempt to frob all
963 'default face, it is set to inherit from the 'bold face. This is kludgy 971 'default face, it is set to inherit from the 'bold face. This is kludgy
964 but it makes `make-face-bold' have more intuitive behavior in many 972 but it makes `make-face-bold' have more intuitive behavior in many
965 circumstances." 973 circumstances."
966 (interactive (list (read-face-name "Make which face bold: "))) 974 (interactive (list (read-face-name "Make which face bold: ")))
967 (frob-face-font-2 975 (frob-face-font-2
968 face locale 'default 'bold 976 face locale tags 'default 'bold
969 (lambda () 977 (lambda ()
970 ;; handle TTY specific entries 978 ;; handle TTY specific entries
971 (when (featurep 'tty) 979 (when (featurep 'tty)
972 (set-face-highlight-p face t locale 'tty))) 980 (set-face-highlight-p face t locale (cons 'tty tags))))
973 (lambda () 981 (lambda ()
974 ;; handle X specific entries 982 ;; handle X specific entries
975 (when (featurep 'x) 983 (when (featurep 'x)
976 (frob-face-property face 'font 'x-make-font-bold locale)) 984 (frob-face-property face 'font 'x-make-font-bold locale tags))
977 (when (featurep 'mswindows) 985 (when (featurep 'mswindows)
978 (frob-face-property face 'font 'mswindows-make-font-bold locale)) 986 (frob-face-property face 'font 'mswindows-make-font-bold locale tags))
979 ) 987 )
980 '(([default] . [bold]) 988 '(([default] . [bold])
981 ([bold] . t) 989 ([bold] . t)
982 ([italic] . [bold-italic]) 990 ([italic] . [bold-italic])
983 ([bold-italic] . t)))) 991 ([bold-italic] . t))))
984 992
985 (defun make-face-italic (face &optional locale) 993 (defun make-face-italic (face &optional locale tags)
986 "Make FACE italic in LOCALE, if possible. 994 "Make FACE italic in LOCALE, if possible.
987 This will attempt to make the font italic for X locales and will set 995 This will attempt to make the font italic for X locales and will set
988 the underline flag for TTY locales. 996 the underline flag for TTY locales.
989 See `make-face-bold' for the semantics of the LOCALE argument and 997 See `make-face-bold' for the semantics of the LOCALE argument and
990 for more specifics on exactly how this function works." 998 for more specifics on exactly how this function works."
991 (interactive (list (read-face-name "Make which face italic: "))) 999 (interactive (list (read-face-name "Make which face italic: ")))
992 (frob-face-font-2 1000 (frob-face-font-2
993 face locale 'default 'italic 1001 face locale tags 'default 'italic
994 (lambda () 1002 (lambda ()
995 ;; handle TTY specific entries 1003 ;; handle TTY specific entries
996 (when (featurep 'tty) 1004 (when (featurep 'tty)
997 (set-face-underline-p face t locale 'tty))) 1005 (set-face-underline-p face t locale (cons 'tty tags))))
998 (lambda () 1006 (lambda ()
999 ;; handle X specific entries 1007 ;; handle X specific entries
1000 (when (featurep 'x) 1008 (when (featurep 'x)
1001 (frob-face-property face 'font 'x-make-font-italic locale)) 1009 (frob-face-property face 'font 'x-make-font-italic locale tags))
1002 (when (featurep 'mswindows) 1010 (when (featurep 'mswindows)
1003 (frob-face-property face 'font 'mswindows-make-font-italic locale)) 1011 (frob-face-property face 'font 'mswindows-make-font-italic locale tags))
1004 ) 1012 )
1005 '(([default] . [italic]) 1013 '(([default] . [italic])
1006 ([bold] . [bold-italic]) 1014 ([bold] . [bold-italic])
1007 ([italic] . t) 1015 ([italic] . t)
1008 ([bold-italic] . t)))) 1016 ([bold-italic] . t))))
1009 1017
1010 (defun make-face-bold-italic (face &optional locale) 1018 (defun make-face-bold-italic (face &optional locale tags)
1011 "Make FACE bold and italic in LOCALE, if possible. 1019 "Make FACE bold and italic in LOCALE, if possible.
1012 This will attempt to make the font bold-italic for X locales and will 1020 This will attempt to make the font bold-italic for X locales and will
1013 set the highlight and underline flags for TTY locales. 1021 set the highlight and underline flags for TTY locales.
1014 See `make-face-bold' for the semantics of the LOCALE argument and 1022 See `make-face-bold' for the semantics of the LOCALE argument and
1015 for more specifics on exactly how this function works." 1023 for more specifics on exactly how this function works."
1016 (interactive (list (read-face-name "Make which face bold-italic: "))) 1024 (interactive (list (read-face-name "Make which face bold-italic: ")))
1017 (frob-face-font-2 1025 (frob-face-font-2
1018 face locale 'default 'bold-italic 1026 face locale tags 'default 'bold-italic
1019 (lambda () 1027 (lambda ()
1020 ;; handle TTY specific entries 1028 ;; handle TTY specific entries
1021 (when (featurep 'tty) 1029 (when (featurep 'tty)
1022 (set-face-highlight-p face t locale 'tty) 1030 (set-face-highlight-p face t locale (cons 'tty tags))
1023 (set-face-underline-p face t locale 'tty))) 1031 (set-face-underline-p face t locale (cons 'tty tags))))
1024 (lambda () 1032 (lambda ()
1025 ;; handle X specific entries 1033 ;; handle X specific entries
1026 (when (featurep 'x) 1034 (when (featurep 'x)
1027 (frob-face-property face 'font 'x-make-font-bold-italic locale)) 1035 (frob-face-property face 'font 'x-make-font-bold-italic locale tags))
1028 (when (featurep 'mswindows) 1036 (when (featurep 'mswindows)
1029 (frob-face-property face 'font 'mswindows-make-font-bold-italic locale)) 1037 (frob-face-property face 'font 'mswindows-make-font-bold-italic locale tags))
1030 ) 1038 )
1031 '(([default] . [italic]) 1039 '(([default] . [italic])
1032 ([bold] . [bold-italic]) 1040 ([bold] . [bold-italic])
1033 ([italic] . [bold-italic]) 1041 ([italic] . [bold-italic])
1034 ([bold-italic] . t)))) 1042 ([bold-italic] . t))))
1035 1043
1036 (defun make-face-unbold (face &optional locale) 1044 (defun make-face-unbold (face &optional locale tags)
1037 "Make FACE non-bold in LOCALE, if possible. 1045 "Make FACE non-bold in LOCALE, if possible.
1038 This will attempt to make the font non-bold for X locales and will 1046 This will attempt to make the font non-bold for X locales and will
1039 unset the highlight flag for TTY locales. 1047 unset the highlight flag for TTY locales.
1040 See `make-face-bold' for the semantics of the LOCALE argument and 1048 See `make-face-bold' for the semantics of the LOCALE argument and
1041 for more specifics on exactly how this function works." 1049 for more specifics on exactly how this function works."
1042 (interactive (list (read-face-name "Make which face non-bold: "))) 1050 (interactive (list (read-face-name "Make which face non-bold: ")))
1043 (frob-face-font-2 1051 (frob-face-font-2
1044 face locale 'bold 'default 1052 face locale tags 'bold 'default
1045 (lambda () 1053 (lambda ()
1046 ;; handle TTY specific entries 1054 ;; handle TTY specific entries
1047 (when (featurep 'tty) 1055 (when (featurep 'tty)
1048 (set-face-highlight-p face nil locale 'tty))) 1056 (set-face-highlight-p face nil locale (cons 'tty tags))))
1049 (lambda () 1057 (lambda ()
1050 ;; handle X specific entries 1058 ;; handle X specific entries
1051 (when (featurep 'x) 1059 (when (featurep 'x)
1052 (frob-face-property face 'font 'x-make-font-unbold locale)) 1060 (frob-face-property face 'font 'x-make-font-unbold locale tags))
1053 (when (featurep 'mswindows) 1061 (when (featurep 'mswindows)
1054 (frob-face-property face 'font 'mswindows-make-font-unbold locale)) 1062 (frob-face-property face 'font 'mswindows-make-font-unbold locale tags))
1055 ) 1063 )
1056 '(([default] . t) 1064 '(([default] . t)
1057 ([bold] . [default]) 1065 ([bold] . [default])
1058 ([italic] . t) 1066 ([italic] . t)
1059 ([bold-italic] . [italic])))) 1067 ([bold-italic] . [italic]))))
1060 1068
1061 (defun make-face-unitalic (face &optional locale) 1069 (defun make-face-unitalic (face &optional locale tags)
1062 "Make FACE non-italic in LOCALE, if possible. 1070 "Make FACE non-italic in LOCALE, if possible.
1063 This will attempt to make the font non-italic for X locales and will 1071 This will attempt to make the font non-italic for X locales and will
1064 unset the underline flag for TTY locales. 1072 unset the underline flag for TTY locales.
1065 See `make-face-bold' for the semantics of the LOCALE argument and 1073 See `make-face-bold' for the semantics of the LOCALE argument and
1066 for more specifics on exactly how this function works." 1074 for more specifics on exactly how this function works."
1067 (interactive (list (read-face-name "Make which face non-italic: "))) 1075 (interactive (list (read-face-name "Make which face non-italic: ")))
1068 (frob-face-font-2 1076 (frob-face-font-2
1069 face locale 'italic 'default 1077 face locale tags 'italic 'default
1070 (lambda () 1078 (lambda ()
1071 ;; handle TTY specific entries 1079 ;; handle TTY specific entries
1072 (when (featurep 'tty) 1080 (when (featurep 'tty)
1073 (set-face-underline-p face nil locale 'tty))) 1081 (set-face-underline-p face nil locale (cons 'tty tags))))
1074 (lambda () 1082 (lambda ()
1075 ;; handle X specific entries 1083 ;; handle X specific entries
1076 (when (featurep 'x) 1084 (when (featurep 'x)
1077 (frob-face-property face 'font 'x-make-font-unitalic locale)) 1085 (frob-face-property face 'font 'x-make-font-unitalic locale tags))
1078 (when (featurep 'mswindows) 1086 (when (featurep 'mswindows)
1079 (frob-face-property face 'font 'mswindows-make-font-unitalic locale)) 1087 (frob-face-property face 'font 'mswindows-make-font-unitalic locale tags))
1080 ) 1088 )
1081 '(([default] . t) 1089 '(([default] . t)
1082 ([bold] . t) 1090 ([bold] . t)
1083 ([italic] . [default]) 1091 ([italic] . [default])
1084 ([bold-italic] . [bold])))) 1092 ([bold-italic] . [bold]))))
1195 :type 'boolean) 1203 :type 'boolean)
1196 1204
1197 ;; Old name, used by custom. Also, FSFmacs name. 1205 ;; Old name, used by custom. Also, FSFmacs name.
1198 (defvaralias 'initialize-face-resources 'init-face-from-resources) 1206 (defvaralias 'initialize-face-resources 'init-face-from-resources)
1199 1207
1200 (defun face-spec-set (face spec &optional frame) 1208 ;; Make sure all custom setting are added with this tag so we can
1209 ;; identify-them
1210 (define-specifier-tag 'custom)
1211
1212 (defun face-spec-set (face spec &optional frame tags)
1201 "Set FACE's face attributes according to the first matching entry in SPEC. 1213 "Set FACE's face attributes according to the first matching entry in SPEC.
1202 If optional FRAME is non-nil, set it for that frame only. 1214 If optional FRAME is non-nil, set it for that frame only.
1203 If it is nil, then apply SPEC to each frame individually. 1215 If it is nil, then apply SPEC to each frame individually.
1204 See `defface' for information about SPEC." 1216 See `defface' for information about SPEC."
1205 (if frame 1217 (if frame
1206 (progn 1218 (progn
1207 (reset-face face frame) 1219 (reset-face face frame tags)
1208 (face-display-set face spec frame) 1220 (face-display-set face spec frame tags)
1209 (init-face-from-resources face frame)) 1221 (init-face-from-resources face frame))
1210 (let ((frames (relevant-custom-frames))) 1222 (let ((frames (relevant-custom-frames)))
1211 (reset-face face) 1223 (reset-face face nil tags)
1212 (if (and (eq 'default face) (featurep 'x)) 1224 ;; This should not be needed. We only remove our own specifiers
1213 (x-init-global-faces)) 1225 ;; (if (and (eq 'default face) (featurep 'x))
1214 (face-display-set face spec) 1226 ;; (x-init-global-faces))
1227 (face-display-set face spec nil tags)
1215 (while frames 1228 (while frames
1216 (face-display-set face spec (car frames)) 1229 (face-display-set face spec (car frames) tags)
1217 (pop frames)) 1230 (pop frames))
1218 (init-face-from-resources face)))) 1231 (init-face-from-resources face))))
1219 1232
1220 (defun face-display-set (face spec &optional frame) 1233 (defun face-display-set (face spec &optional frame tags)
1221 "Set FACE to the attributes to the first matching entry in SPEC. 1234 "Set FACE to the attributes to the first matching entry in SPEC.
1222 Iff optional FRAME is non-nil, set it for that frame only. 1235 Iff optional FRAME is non-nil, set it for that frame only.
1223 See `defface' for information about SPEC." 1236 See `defface' for information about SPEC."
1224 (while spec 1237 (while spec
1225 (let ((display (caar spec)) 1238 (let ((display (caar spec))
1226 (atts (cadar spec))) 1239 (atts (cadar spec)))
1227 (pop spec) 1240 (pop spec)
1228 (when (face-spec-set-match-display display frame) 1241 (when (face-spec-set-match-display display frame)
1229 ;; Avoid creating frame local duplicates of the global face. 1242 ;; Avoid creating frame local duplicates of the global face.
1230 (unless (and frame (eq display (get face 'custom-face-display))) 1243 (unless (and frame (eq display (get face 'custom-face-display)))
1231 (apply 'face-custom-attributes-set face frame atts)) 1244 (apply 'face-custom-attributes-set face frame tags atts))
1232 (unless frame 1245 (unless frame
1233 (put face 'custom-face-display display)) 1246 (put face 'custom-face-display display))
1234 (setq spec nil))))) 1247 (setq spec nil)))))
1235 1248
1236 (defvar default-custom-frame-properties nil 1249 (defvar default-custom-frame-properties nil
1345 "Initialize frame-local custom faces for FRAME if necessary." 1358 "Initialize frame-local custom faces for FRAME if necessary."
1346 (unless (equal (get-custom-frame-properties) 1359 (unless (equal (get-custom-frame-properties)
1347 (get-custom-frame-properties frame)) 1360 (get-custom-frame-properties frame))
1348 (initialize-custom-faces frame))) 1361 (initialize-custom-faces frame)))
1349 1362
1363 (defun startup-initialize-custom-faces ()
1364 "Reset faces created by defface. Only called at startup.
1365 Don't use this function in your program."
1366 (when default-custom-frame-properties
1367 ;; Reset default value to the actual frame, not stream.
1368 (setq default-custom-frame-properties
1369 (extract-custom-frame-properties (selected-frame)))
1370 ;; like initialize-custom-faces but removes property first.
1371 (mapc (lambda (symbol)
1372 (let ((spec (or (get symbol 'saved-face)
1373 (get symbol 'face-defface-spec))))
1374 (when spec
1375 ;; Reset faces created during auto-autoloads loading.
1376 (reset-face symbol)
1377 ;; And set it according to the spec.
1378 (face-display-set symbol spec nil))))
1379 (face-list))))
1380
1350 1381
1351 (defun make-empty-face (name &optional doc-string temporary) 1382 (defun make-empty-face (name &optional doc-string temporary)
1352 "Like `make-face', but doesn't query the resource database." 1383 "Like `make-face', but doesn't query the resource database."
1353 (let ((init-face-from-resources nil)) 1384 (let ((init-face-from-resources nil))
1354 (make-face name doc-string temporary))) 1385 (make-face name doc-string temporary)))
1395 (x-init-device-faces device)) 1426 (x-init-device-faces device))
1396 ((eq 'mswindows (device-type device)) 1427 ((eq 'mswindows (device-type device))
1397 (mswindows-init-device-faces device)) 1428 (mswindows-init-device-faces device))
1398 ;; Nothing to do for TTYs? 1429 ;; Nothing to do for TTYs?
1399 ) 1430 )
1400 (init-other-random-faces device))) 1431 (or (eq 'stream (device-type device))
1432 (init-other-random-faces device))))
1401 1433
1402 (defun init-frame-faces (frame) 1434 (defun init-frame-faces (frame)
1403 (when init-face-from-resources 1435 (when init-face-from-resources
1404 ;; First, add any frame-local face resources. 1436 ;; First, add any frame-local face resources.
1405 (loop for face in (face-list) do 1437 (loop for face in (face-list) do
1505 1537
1506 ;; Similar for italic. 1538 ;; Similar for italic.
1507 ;; It's unreasonable to expect to be able to make a font italic all 1539 ;; It's unreasonable to expect to be able to make a font italic all
1508 ;; the time. For many languages, italic is an alien concept. 1540 ;; the time. For many languages, italic is an alien concept.
1509 ;; Basically, because italic is not a globally meaningful concept, 1541 ;; Basically, because italic is not a globally meaningful concept,
1510 ;; the use of the italic face should really be oboleted. 1542 ;; the use of the italic face should really be obsoleted.
1511 1543
1512 ;; I disagree with above. In many languages, the concept of capital 1544 ;; I disagree with above. In many languages, the concept of capital
1513 ;; letters is just as alien, and yet we use them. Italic is here to 1545 ;; letters is just as alien, and yet we use them. Italic is here to
1514 ;; stay. -hniksic 1546 ;; stay. -hniksic
1515 1547
1573 1605
1574 If the optional FRAME argument is provided, change only 1606 If the optional FRAME argument is provided, change only
1575 in that frame; otherwise change each frame." 1607 in that frame; otherwise change each frame."
1576 (while (not (find-face face)) 1608 (while (not (find-face face))
1577 (setq face (signal 'wrong-type-argument (list 'facep face)))) 1609 (setq face (signal 'wrong-type-argument (list 'facep face))))
1578 (locate-file pixmap x-bitmap-file-path ".xbm:" 4) 1610 (locate-file pixmap x-bitmap-file-path '(".xbm" ""))
1579 (while (cond ((stringp pixmap) 1611 (while (cond ((stringp pixmap)
1580 (unless (file-readable-p pixmap) 1612 (unless (file-readable-p pixmap)
1581 (setq pixmap `[xbm :file ,pixmap])) 1613 (setq pixmap `[xbm :file ,pixmap]))
1582 nil) 1614 nil)
1583 ((and (consp pixmap) (= (length pixmap) 3)) 1615 ((and (consp pixmap) (= (length pixmap) 3))
1603 (make-face 'underline "Underlined text.") 1635 (make-face 'underline "Underlined text.")
1604 (or (face-differs-from-default-p 'underline) 1636 (or (face-differs-from-default-p 'underline)
1605 (set-face-underline-p 'underline t 'global '(default))) 1637 (set-face-underline-p 'underline t 'global '(default)))
1606 (make-face 'zmacs-region "Used on highlightes region between point and mark.") 1638 (make-face 'zmacs-region "Used on highlightes region between point and mark.")
1607 (make-face 'isearch "Used on region matched by isearch.") 1639 (make-face 'isearch "Used on region matched by isearch.")
1640 (make-face 'isearch-secondary "Face to use for highlighting all matches.")
1608 (make-face 'list-mode-item-selected 1641 (make-face 'list-mode-item-selected
1609 "Face for the selected list item in list-mode.") 1642 "Face for the selected list item in list-mode.")
1610 (make-face 'highlight "Highlight face.") 1643 (make-face 'highlight "Highlight face.")
1611 (make-face 'primary-selection "Primary selection face.") 1644 (make-face 'primary-selection "Primary selection face.")
1612 (make-face 'secondary-selection "Secondary selection face.") 1645 (make-face 'secondary-selection "Secondary selection face.")
1690 (set-face-background 'isearch 1723 (set-face-background 'isearch
1691 '(((x default color) . "paleturquoise") 1724 '(((x default color) . "paleturquoise")
1692 ((x default color) . "green") 1725 ((x default color) . "green")
1693 ((mswindows default color) . "paleturquoise") 1726 ((mswindows default color) . "paleturquoise")
1694 ((mswindows default color) . "green")) 1727 ((mswindows default color) . "green"))
1728 'global)
1729
1730 ;; #### This should really, I mean *really*, be converted to some form
1731 ;; of `defface' one day.
1732 (set-face-foreground 'isearch-secondary
1733 '(((x default color) . "red3")
1734 ((mswindows default color) . "red3"))
1695 'global) 1735 'global)
1696 1736
1697 ;; Define some logical color names to be used when reading the pixmap files. 1737 ;; Define some logical color names to be used when reading the pixmap files.
1698 (if (featurep 'xpm) 1738 (if (featurep 'xpm)
1699 (setq xpm-color-symbols 1739 (setq xpm-color-symbols