annotate lisp/faces.el @ 102335:1cabc699e9e6

*** empty log message ***
author Eli Zaretskii <eliz@gnu.org>
date Sat, 28 Feb 2009 15:53:11 +0000
parents 9076b03251f0
children 56f3fbbbd88c
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1 ;;; faces.el --- Lisp faces
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2
64762
41bb365f41c4 Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 64724
diff changeset
3 ;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
100908
a9dc0e7c3f2b Add 2009 to copyright years.
Glenn Morris <rgm@gnu.org>
parents: 100171
diff changeset
4 ;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
5
38697
a19197c6442f Keyword added and FSF specified as Maintainer.
Pavel Janík <Pavel@Janik.cz>
parents: 38233
diff changeset
6 ;; Maintainer: FSF
45078
829beb9a6a4b Follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents: 44896
diff changeset
7 ;; Keywords: internal
38697
a19197c6442f Keyword added and FSF specified as Maintainer.
Pavel Janík <Pavel@Janik.cz>
parents: 38233
diff changeset
8
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
9 ;; This file is part of GNU Emacs.
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
10
94678
ee5932bf781d Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 94054
diff changeset
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
12 ;; it under the terms of the GNU General Public License as published by
94678
ee5932bf781d Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 94054
diff changeset
13 ;; the Free Software Foundation, either version 3 of the License, or
ee5932bf781d Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 94054
diff changeset
14 ;; (at your option) any later version.
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
15
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
16 ;; GNU Emacs is distributed in the hope that it will be useful,
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
19 ;; GNU General Public License for more details.
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
20
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
21 ;; You should have received a copy of the GNU General Public License
94678
ee5932bf781d Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 94054
diff changeset
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
23
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
24 ;;; Commentary:
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
25
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
26 ;;; Code:
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
27
10107
2af74ff52cd0 At compile time, discard any defsubr definitions
Richard M. Stallman <rms@gnu.org>
parents: 10105
diff changeset
28 (eval-when-compile
92948
73a01bf5cb80 * faces.el (xw-defined-colors):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 92717
diff changeset
29 (require 'cl))
73a01bf5cb80 * faces.el (xw-defined-colors):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 92717
diff changeset
30
73a01bf5cb80 * faces.el (xw-defined-colors):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 92717
diff changeset
31 (declare-function xw-defined-colors "term/x-win" (&optional frame))
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
32
65289
f6a81af3abe8 (help-xref-stack-item): Add defvar.
Juanma Barranquero <lekktu@gmail.com>
parents: 65084
diff changeset
33 (defvar help-xref-stack-item)
96435
414b3d1e76df (face-name-history): New variable.
Juri Linkov <juri@jurta.org>
parents: 96398
diff changeset
34
414b3d1e76df (face-name-history): New variable.
Juri Linkov <juri@jurta.org>
parents: 96398
diff changeset
35 (defvar face-name-history nil
414b3d1e76df (face-name-history): New variable.
Juri Linkov <juri@jurta.org>
parents: 96398
diff changeset
36 "History list for some commands that read face names.
414b3d1e76df (face-name-history): New variable.
Juri Linkov <juri@jurta.org>
parents: 96398
diff changeset
37 Maximum length of the history list is determined by the value
414b3d1e76df (face-name-history): New variable.
Juri Linkov <juri@jurta.org>
parents: 96398
diff changeset
38 of `history-length', which see.")
414b3d1e76df (face-name-history): New variable.
Juri Linkov <juri@jurta.org>
parents: 96398
diff changeset
39
2744
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
40
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
41 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
42 ;;; Font selection.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
43 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
44
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
45 (defgroup font-selection nil
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
46 "Influencing face font selection."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
47 :group 'faces)
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
48
12562
a9b08e50d6ec (x-create-frame-with-faces): Set background-mode
Karl Heuer <kwzh@gnu.org>
parents: 12475
diff changeset
49
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
50 (defcustom face-font-selection-order
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
51 '(:width :height :weight :slant)
100171
d42aff5ca541 * align.el:
Lute Kamstra <lute@gnu.org>
parents: 99144
diff changeset
52 "A list specifying how face font selection chooses fonts.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
53 Each of the four symbols `:width', `:height', `:weight', and `:slant'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
54 must appear once in the list, and the list must not contain any other
79031
7a1822d578cf (face-font-selection-order): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 79026
diff changeset
55 elements. Font selection first tries to find a best matching font
79026
ebc0c510ff84 (face-font-selection-order): Doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents: 78374
diff changeset
56 for those face attributes that appear before in the list. For
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
57 example, if `:slant' appears before `:height', font selection first
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
58 tries to find a font with a suitable slant, even if this results in
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
59 a font height that isn't optimal."
48713
a91fa6973510 (face-font-selection-order)
Andreas Schwab <schwab@suse.de>
parents: 48522
diff changeset
60 :tag "Font selection order"
30306
7a694e8efd12 (face-font-selection-order)
Gerd Moellmann <gerd@gnu.org>
parents: 30188
diff changeset
61 :type '(list symbol symbol symbol symbol)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
62 :group 'font-selection
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
63 :set #'(lambda (symbol value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
64 (set-default symbol value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
65 (internal-set-font-selection-order value)))
17522
209c61e51bd0 (frame-set-background-mode): New function.
Richard M. Stallman <rms@gnu.org>
parents: 17386
diff changeset
66
33371
8259eb8d96c2 (face-font-registry-alternatives): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents: 33008
diff changeset
67
96247
002173686f70 (face-font-family-alternatives, variable-pitch): Use
Andreas Schwab <schwab@suse.de>
parents: 96241
diff changeset
68 ;; In the absence of Fontconfig support, Monospace and Sans Serif are
96241
514c1dae72db (face-font-family-alternatives, variable-pitch): Change "Sans" to the
Chong Yidong <cyd@stupidchicken.com>
parents: 96169
diff changeset
69 ;; unavailable, and we fall back on the courier and helv families,
514c1dae72db (face-font-family-alternatives, variable-pitch): Change "Sans" to the
Chong Yidong <cyd@stupidchicken.com>
parents: 96169
diff changeset
70 ;; which are generally available.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
71 (defcustom face-font-family-alternatives
96169
abc9f7184a8c (fixed-pitch): Use "Monospace" family.
Chong Yidong <cyd@stupidchicken.com>
parents: 96079
diff changeset
72 '(("Monospace" "courier" "fixed")
99144
b7eb74a4d86b * faces.el (face-font-family-alternatives): Add "CMU Typewriter Text"
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 98801
diff changeset
73 ("courier" "CMU Typewriter Text" "fixed")
96247
002173686f70 (face-font-family-alternatives, variable-pitch): Use
Andreas Schwab <schwab@suse.de>
parents: 96241
diff changeset
74 ("Sans Serif" "helv" "helvetica" "arial" "fixed")
27888
3e1c17057b79 (face-font-family-alternatives): Add arial to helv.
Jason Rumney <jasonr@gnu.org>
parents: 27831
diff changeset
75 ("helv" "helvetica" "arial" "fixed"))
100171
d42aff5ca541 * align.el:
Lute Kamstra <lute@gnu.org>
parents: 99144
diff changeset
76 "Alist of alternative font family names.
42705
963ac6b8fb83 Fix typos.
Pavel Janík <Pavel@Janik.cz>
parents: 42670
diff changeset
77 Each element has the form (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...).
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
78 If fonts of family FAMILY can't be loaded, try ALTERNATIVE1, then
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
79 ALTERNATIVE2 etc."
48713
a91fa6973510 (face-font-selection-order)
Andreas Schwab <schwab@suse.de>
parents: 48522
diff changeset
80 :tag "Alternative font families to try"
30306
7a694e8efd12 (face-font-selection-order)
Gerd Moellmann <gerd@gnu.org>
parents: 30188
diff changeset
81 :type '(repeat (repeat string))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
82 :group 'font-selection
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
83 :set #'(lambda (symbol value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
84 (set-default symbol value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
85 (internal-set-alternative-font-family-alist value)))
13725
9729af46fe60 Take optional arg FRAME.
Simon Marshall <simon@gnu.org>
parents: 13704
diff changeset
86
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
87
33371
8259eb8d96c2 (face-font-registry-alternatives): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents: 33008
diff changeset
88 ;; This is defined originally in xfaces.c.
8259eb8d96c2 (face-font-registry-alternatives): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents: 33008
diff changeset
89 (defcustom face-font-registry-alternatives
39549
044b46ec5fff (face-font-registry-alternatives) [windows-nt]: Make
Andrew Innes <andrewi@gnu.org>
parents: 38697
diff changeset
90 (if (eq system-type 'windows-nt)
42969
bdcf2b5f4ae2 (face-font-registry-alternatives) [windows-nt]: Add
Jason Rumney <jasonr@gnu.org>
parents: 42705
diff changeset
91 '(("iso8859-1" "ms-oemlatin")
90682
df64e21eebd0 (face-font-registry-alternatives): Add gb18030.
Kenichi Handa <handa@m17n.org>
parents: 90650
diff changeset
92 ("gb2312.1980" "gb2312" "gbk" "gb18030")
39549
044b46ec5fff (face-font-registry-alternatives) [windows-nt]: Make
Andrew Innes <andrewi@gnu.org>
parents: 38697
diff changeset
93 ("jisx0208.1990" "jisx0208.1983" "jisx0208.1978")
044b46ec5fff (face-font-registry-alternatives) [windows-nt]: Make
Andrew Innes <andrewi@gnu.org>
parents: 38697
diff changeset
94 ("ksc5601.1989" "ksx1001.1992" "ksc5601.1987")
044b46ec5fff (face-font-registry-alternatives) [windows-nt]: Make
Andrew Innes <andrewi@gnu.org>
parents: 38697
diff changeset
95 ("muletibetan-2" "muletibetan-0"))
90682
df64e21eebd0 (face-font-registry-alternatives): Add gb18030.
Kenichi Handa <handa@m17n.org>
parents: 90650
diff changeset
96 '(("gb2312.1980" "gb2312.80&gb8565.88" "gbk" "gb18030")
39549
044b46ec5fff (face-font-registry-alternatives) [windows-nt]: Make
Andrew Innes <andrewi@gnu.org>
parents: 38697
diff changeset
97 ("jisx0208.1990" "jisx0208.1983" "jisx0208.1978")
044b46ec5fff (face-font-registry-alternatives) [windows-nt]: Make
Andrew Innes <andrewi@gnu.org>
parents: 38697
diff changeset
98 ("ksc5601.1989" "ksx1001.1992" "ksc5601.1987")
044b46ec5fff (face-font-registry-alternatives) [windows-nt]: Make
Andrew Innes <andrewi@gnu.org>
parents: 38697
diff changeset
99 ("muletibetan-2" "muletibetan-0")))
100171
d42aff5ca541 * align.el:
Lute Kamstra <lute@gnu.org>
parents: 99144
diff changeset
100 "Alist of alternative font registry names.
42705
963ac6b8fb83 Fix typos.
Pavel Janík <Pavel@Janik.cz>
parents: 42670
diff changeset
101 Each element has the form (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...).
34162
08b928780fd1 (face-font-registry-alternatives): Add entries for CJK
Kenichi Handa <handa@m17n.org>
parents: 34018
diff changeset
102 If fonts of registry REGISTRY can be loaded, font selection
08b928780fd1 (face-font-registry-alternatives): Add entries for CJK
Kenichi Handa <handa@m17n.org>
parents: 34018
diff changeset
103 tries to find a best matching font among all fonts of registry
08b928780fd1 (face-font-registry-alternatives): Add entries for CJK
Kenichi Handa <handa@m17n.org>
parents: 34018
diff changeset
104 REGISTRY, ALTERNATIVE1, ALTERNATIVE2, and etc."
48713
a91fa6973510 (face-font-selection-order)
Andreas Schwab <schwab@suse.de>
parents: 48522
diff changeset
105 :tag "Alternative font registries to try"
33371
8259eb8d96c2 (face-font-registry-alternatives): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents: 33008
diff changeset
106 :type '(repeat (repeat string))
33419
21ac2c51ac59 (face-font-registry-alternatives): Add :version.
Dave Love <fx@gnu.org>
parents: 33371
diff changeset
107 :version "21.1"
33371
8259eb8d96c2 (face-font-registry-alternatives): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents: 33008
diff changeset
108 :group 'font-selection
8259eb8d96c2 (face-font-registry-alternatives): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents: 33008
diff changeset
109 :set #'(lambda (symbol value)
8259eb8d96c2 (face-font-registry-alternatives): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents: 33008
diff changeset
110 (set-default symbol value)
8259eb8d96c2 (face-font-registry-alternatives): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents: 33008
diff changeset
111 (internal-set-alternative-font-registry-alist value)))
8259eb8d96c2 (face-font-registry-alternatives): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents: 33008
diff changeset
112
2744
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
113
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
114 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
115 ;;; Creation, copying.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
116 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2744
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
117
3925
f286657c098e * faces.el (global-face-data): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 3911
diff changeset
118
2744
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
119 (defun face-list ()
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
120 "Return a list of all defined face names."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
121 (mapcar #'car face-new-frame-defaults))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
122
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
123
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
124 ;;; ### If not frame-local initialize by what X resources?
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
125
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
126 (defun make-face (face &optional no-init-from-resources)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
127 "Define a new face with name FACE, a symbol.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
128 NO-INIT-FROM-RESOURCES non-nil means don't initialize frame-local
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
129 variants of FACE from X resources. (X resources recognized are found
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
130 in the global variable `face-x-resources'.) If FACE is already known
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
131 as a face, leave it unmodified. Value is FACE."
96435
414b3d1e76df (face-name-history): New variable.
Juri Linkov <juri@jurta.org>
parents: 96398
diff changeset
132 (interactive (list (read-from-minibuffer
414b3d1e76df (face-name-history): New variable.
Juri Linkov <juri@jurta.org>
parents: 96398
diff changeset
133 "Make face: " nil nil t 'face-name-history)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
134 (unless (facep face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
135 ;; Make frame-local faces (this also makes the global one).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
136 (dolist (frame (frame-list))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
137 (internal-make-lisp-face face frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
138 ;; Add the face to the face menu.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
139 (when (fboundp 'facemenu-add-new-face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
140 (facemenu-add-new-face face))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
141 ;; Define frame-local faces for all frames from X resources.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
142 (unless no-init-from-resources
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
143 (make-face-x-resource-internal face)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
144 face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
145
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
146
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
147 (defun make-empty-face (face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
148 "Define a new, empty face with name FACE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
149 If the face already exists, it is left unmodified. Value is FACE."
96435
414b3d1e76df (face-name-history): New variable.
Juri Linkov <juri@jurta.org>
parents: 96398
diff changeset
150 (interactive (list (read-from-minibuffer
414b3d1e76df (face-name-history): New variable.
Juri Linkov <juri@jurta.org>
parents: 96398
diff changeset
151 "Make empty face: " nil nil t 'face-name-history)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
152 (make-face face 'no-init-from-resources))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
153
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
154
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
155 (defun copy-face (old-face new-face &optional frame new-frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
156 "Define a face just like OLD-FACE, with name NEW-FACE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
157
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
158 If NEW-FACE already exists as a face, it is modified to be like
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
159 OLD-FACE. If it doesn't already exist, it is created.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
160
47258
86c1fc3c48f5 (copy-face): Fix spacing.
Juanma Barranquero <lekktu@gmail.com>
parents: 46267
diff changeset
161 If the optional argument FRAME is given as a frame, NEW-FACE is
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
162 changed on FRAME only.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
163 If FRAME is t, the frame-independent default specification for OLD-FACE
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
164 is copied to NEW-FACE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
165 If FRAME is nil, copying is done for the frame-independent defaults
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
166 and for each existing frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
167
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
168 If the optional fourth argument NEW-FRAME is given,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
169 copy the information from face OLD-FACE on frame FRAME
79615
c70a8429c7d8 (copy-face): Create the new face explicitly if it does not exist already.
Richard M. Stallman <rms@gnu.org>
parents: 79354
diff changeset
170 to NEW-FACE on frame NEW-FRAME. In this case, FRAME may not be nil."
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
171 (let ((inhibit-quit t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
172 (if (null frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
173 (progn
79615
c70a8429c7d8 (copy-face): Create the new face explicitly if it does not exist already.
Richard M. Stallman <rms@gnu.org>
parents: 79354
diff changeset
174 (when new-frame
c70a8429c7d8 (copy-face): Create the new face explicitly if it does not exist already.
Richard M. Stallman <rms@gnu.org>
parents: 79354
diff changeset
175 (error "Copying face %s from all frames to one frame"
c70a8429c7d8 (copy-face): Create the new face explicitly if it does not exist already.
Richard M. Stallman <rms@gnu.org>
parents: 79354
diff changeset
176 old-face))
c70a8429c7d8 (copy-face): Create the new face explicitly if it does not exist already.
Richard M. Stallman <rms@gnu.org>
parents: 79354
diff changeset
177 (make-empty-face new-face)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
178 (dolist (frame (frame-list))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
179 (copy-face old-face new-face frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
180 (copy-face old-face new-face t))
79615
c70a8429c7d8 (copy-face): Create the new face explicitly if it does not exist already.
Richard M. Stallman <rms@gnu.org>
parents: 79354
diff changeset
181 (make-empty-face new-face)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
182 (internal-copy-lisp-face old-face new-face frame new-frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
183 new-face))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
184
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
185
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
186
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
187 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
188 ;;; Obsolete functions
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
189 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
190
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
191 ;; The functions in this section are defined because Lisp packages use
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
192 ;; them, despite the prefix `internal-' suggesting that they are
28840
d0531e35d9f2 Some doc fixes.
Dave Love <fx@gnu.org>
parents: 28214
diff changeset
193 ;; private to the face implementation.
2744
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
194
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
195 (defun internal-find-face (name &optional frame)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
196 "Retrieve the face named NAME.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
197 Return nil if there is no such face.
75579
5e69c78ab3f4 (internal-find-face, internal-get-face): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents: 75566
diff changeset
198 If NAME is already a face, it is simply returned.
5e69c78ab3f4 (internal-find-face, internal-get-face): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents: 75566
diff changeset
199 The optional argument FRAME is ignored."
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
200 (facep name))
29354
4ed4a700358b Update calls to make-obsolete with a WHEN argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28907
diff changeset
201 (make-obsolete 'internal-find-face 'facep "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
202
2744
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
203
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
204 (defun internal-get-face (name &optional frame)
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
205 "Retrieve the face named NAME; error if there is none.
75579
5e69c78ab3f4 (internal-find-face, internal-get-face): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents: 75566
diff changeset
206 If NAME is already a face, it is simply returned.
5e69c78ab3f4 (internal-find-face, internal-get-face): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents: 75566
diff changeset
207 The optional argument FRAME is ignored."
40351
a44d4a7dd8de (internal-get-face): Use facep instead of the obsolete
Eli Zaretskii <eliz@gnu.org>
parents: 39830
diff changeset
208 (or (facep name)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
209 (check-face name)))
46053
ef0684c3e07b (frame-update-faces): Fix obsolescence declaration.
Juanma Barranquero <lekktu@gmail.com>
parents: 46041
diff changeset
210 (make-obsolete 'internal-get-face "see `facep' and `check-face'." "21.1")
2744
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
211
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
212
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
213 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
214 ;;; Predicates, type checks.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
215 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
216
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
217 (defun facep (face)
79651
a926997ba2da (facep): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 79615
diff changeset
218 "Return non-nil if FACE is a face name; nil otherwise.
a926997ba2da (facep): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 79615
diff changeset
219 A face name can be a string or a symbol."
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
220 (internal-lisp-face-p face))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
221
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
222
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
223 (defun check-face (face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
224 "Signal an error if FACE doesn't name a face.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
225 Value is FACE."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
226 (unless (facep face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
227 (error "Not a face: %s" face))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
228 face)
2744
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
229
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
230
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
231 ;; The ID returned is not to be confused with the internally used IDs
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
232 ;; of realized faces. The ID assigned to Lisp faces is used to
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
233 ;; support faces in display table entries.
17386
b251c8820860 (make-face): New arg no-resources.
Richard M. Stallman <rms@gnu.org>
parents: 17173
diff changeset
234
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
235 (defun face-id (face &optional frame)
46267
cd9282aa1d8a (face-id): Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents: 46146
diff changeset
236 "Return the internal ID of face with name FACE.
81148
afd58ab52ea7 (face-id): If the argument is a face alias, return the ID of the target face.
Juanma Barranquero <lekktu@gmail.com>
parents: 76731
diff changeset
237 If FACE is a face-alias, return the ID of the target face.
60495
8e1bab51992b (face-id): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 60162
diff changeset
238 The optional argument FRAME is ignored, since the internal face ID
8e1bab51992b (face-id): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 60162
diff changeset
239 of a face name is the same for all frames."
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
240 (check-face face)
81148
afd58ab52ea7 (face-id): If the argument is a face alias, return the ID of the target face.
Juanma Barranquero <lekktu@gmail.com>
parents: 76731
diff changeset
241 (or (get face 'face)
afd58ab52ea7 (face-id): If the argument is a face alias, return the ID of the target face.
Juanma Barranquero <lekktu@gmail.com>
parents: 76731
diff changeset
242 (face-id (get face 'face-alias))))
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
243
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
244 (defun face-equal (face1 face2 &optional frame)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
245 "Non-nil if faces FACE1 and FACE2 are equal.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
246 Faces are considered equal if all their attributes are equal.
62968
88922a349851 (face-equal): Improve argument/docstring consistency.
Juanma Barranquero <lekktu@gmail.com>
parents: 62947
diff changeset
247 If the optional argument FRAME is given, report on FACE1 and FACE2 in that frame.
88922a349851 (face-equal): Improve argument/docstring consistency.
Juanma Barranquero <lekktu@gmail.com>
parents: 62947
diff changeset
248 If FRAME is t, report on the defaults for FACE1 and FACE2 (for new frames).
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
249 If FRAME is omitted or nil, use the selected frame."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
250 (internal-lisp-face-equal-p face1 face2 frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
251
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
252
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
253 (defun face-differs-from-default-p (face &optional frame)
55899
4592654cd2e9 Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-369
Miles Bader <miles@gnu.org>
parents: 55898
diff changeset
254 "Return non-nil if FACE displays differently from the default face.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
255 If the optional argument FRAME is given, report on face FACE in that frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
256 If FRAME is t, report on the defaults for face FACE (for new frames).
55899
4592654cd2e9 Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-369
Miles Bader <miles@gnu.org>
parents: 55898
diff changeset
257 If FRAME is omitted or nil, use the selected frame."
55902
084530cb1b2f Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-372
Miles Bader <miles@gnu.org>
parents: 55901
diff changeset
258 (let ((attrs
87494
26eb0118cbc6 (face-all-attributes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 87483
diff changeset
259 (delq :inherit (mapcar 'car face-attribute-name-alist)))
55902
084530cb1b2f Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-372
Miles Bader <miles@gnu.org>
parents: 55901
diff changeset
260 (differs nil))
084530cb1b2f Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-372
Miles Bader <miles@gnu.org>
parents: 55901
diff changeset
261 (while (and attrs (not differs))
084530cb1b2f Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-372
Miles Bader <miles@gnu.org>
parents: 55901
diff changeset
262 (let* ((attr (pop attrs))
084530cb1b2f Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-372
Miles Bader <miles@gnu.org>
parents: 55901
diff changeset
263 (attr-val (face-attribute face attr frame t)))
084530cb1b2f Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-372
Miles Bader <miles@gnu.org>
parents: 55901
diff changeset
264 (when (and
084530cb1b2f Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-372
Miles Bader <miles@gnu.org>
parents: 55901
diff changeset
265 (not (eq attr-val 'unspecified))
084530cb1b2f Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-372
Miles Bader <miles@gnu.org>
parents: 55901
diff changeset
266 (display-supports-face-attributes-p (list attr attr-val)
084530cb1b2f Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-372
Miles Bader <miles@gnu.org>
parents: 55901
diff changeset
267 frame))
084530cb1b2f Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-372
Miles Bader <miles@gnu.org>
parents: 55901
diff changeset
268 (setq differs attr))))
084530cb1b2f Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-372
Miles Bader <miles@gnu.org>
parents: 55901
diff changeset
269 differs))
10379
f9d713e8c77c (face-nontrivial-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10375
diff changeset
270
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
271
10379
f9d713e8c77c (face-nontrivial-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10375
diff changeset
272 (defun face-nontrivial-p (face &optional frame)
f9d713e8c77c (face-nontrivial-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10375
diff changeset
273 "True if face FACE has some non-nil attribute.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
274 If the optional argument FRAME is given, report on face FACE in that frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
275 If FRAME is t, report on the defaults for face FACE (for new frames).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
276 If FRAME is omitted or nil, use the selected frame."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
277 (not (internal-lisp-face-empty-p face frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
278
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
279
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
280
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
281 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
282 ;;; Setting face attributes from X resources.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
283 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
284
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
285 (defcustom face-x-resources
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
286 '((:family (".attributeFamily" . "Face.AttributeFamily"))
95862
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
287 (:foundry (".attributeFoundry" . "Face.AttributeFoundry"))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
288 (:width (".attributeWidth" . "Face.AttributeWidth"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
289 (:height (".attributeHeight" . "Face.AttributeHeight"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
290 (:weight (".attributeWeight" . "Face.AttributeWeight"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
291 (:slant (".attributeSlant" . "Face.AttributeSlant"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
292 (:foreground (".attributeForeground" . "Face.AttributeForeground"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
293 (:background (".attributeBackground" . "Face.AttributeBackground"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
294 (:overline (".attributeOverline" . "Face.AttributeOverline"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
295 (:strike-through (".attributeStrikeThrough" . "Face.AttributeStrikeThrough"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
296 (:box (".attributeBox" . "Face.AttributeBox"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
297 (:underline (".attributeUnderline" . "Face.AttributeUnderline"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
298 (:inverse-video (".attributeInverse" . "Face.AttributeInverse"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
299 (:stipple
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
300 (".attributeStipple" . "Face.AttributeStipple")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
301 (".attributeBackgroundPixmap" . "Face.AttributeBackgroundPixmap"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
302 (:bold (".attributeBold" . "Face.AttributeBold"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
303 (:italic (".attributeItalic" . "Face.AttributeItalic"))
31193
a15c5cb8ec71 (face-x-resources): Add entry for :inherit.
Miles Bader <miles@gnu.org>
parents: 31190
diff changeset
304 (:font (".attributeFont" . "Face.AttributeFont"))
a15c5cb8ec71 (face-x-resources): Add entry for :inherit.
Miles Bader <miles@gnu.org>
parents: 31190
diff changeset
305 (:inherit (".attributeInherit" . "Face.AttributeInherit")))
100171
d42aff5ca541 * align.el:
Lute Kamstra <lute@gnu.org>
parents: 99144
diff changeset
306 "List of X resources and classes for face attributes.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
307 Each element has the form (ATTRIBUTE ENTRY1 ENTRY2...) where ATTRIBUTE is
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
308 the name of a face attribute, and each ENTRY is a cons of the form
39830
aed9c3afb7ed (describe-face): Call help-setup-xref earlier.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39799
diff changeset
309 \(RESOURCE . CLASS) with RESOURCE being the resource and CLASS being the
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
310 X resource class for the attribute."
31528
a461cad7a942 (face-x-resources): Make custom type more specific.
Dave Love <fx@gnu.org>
parents: 31500
diff changeset
311 :type '(repeat (cons symbol (repeat (cons string string))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
312 :group 'faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
313
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
314
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
315 (declare-function internal-face-x-get-resource "xfaces.c"
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
316 (resource class frame))
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
317
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
318 (declare-function internal-set-lisp-face-attribute-from-resource "xfaces.c"
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
319 (face attr value &optional frame))
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
320
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
321 (defun set-face-attribute-from-resource (face attribute resource class frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
322 "Set FACE's ATTRIBUTE from X resource RESOURCE, class CLASS on FRAME.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
323 Value is the attribute value specified by the resource, or nil
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
324 if not present. This function displays a message if the resource
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
325 specifies an invalid attribute."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
326 (let* ((face-name (face-name face))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
327 (value (internal-face-x-get-resource (concat face-name resource)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
328 class frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
329 (when value
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
330 (condition-case ()
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
331 (internal-set-lisp-face-attribute-from-resource
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
332 face attribute (downcase value) frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
333 (error
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
334 (message "Face %s, frame %s: invalid attribute %s %s from X resource"
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
335 face-name frame attribute value))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
336 value))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
337
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
338
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
339 (defun set-face-attributes-from-resources (face frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
340 "Set attributes of FACE from X resources for FRAME."
97043
9592c50233ab Remove support for Mac Carbon.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 96675
diff changeset
341 (when (memq (framep frame) '(x w32 ns))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
342 (dolist (definition face-x-resources)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
343 (let ((attribute (car definition)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
344 (dolist (entry (cdr definition))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
345 (set-face-attribute-from-resource face attribute (car entry)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
346 (cdr entry) frame))))))
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
347
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
348
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
349 (defun make-face-x-resource-internal (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
350 "Fill frame-local FACE on FRAME from X resources.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
351 FRAME nil or not specified means do it for all frames."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
352 (if (null frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
353 (dolist (frame (frame-list))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
354 (set-face-attributes-from-resources face frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
355 (set-face-attributes-from-resources face frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
356
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
357
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
358
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
359 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
360 ;;; Retrieving face attributes.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
361 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
362
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
363 (defun face-name (face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
364 "Return the name of face FACE."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
365 (symbol-name (check-face face)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
366
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
367
87494
26eb0118cbc6 (face-all-attributes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 87483
diff changeset
368 (defun face-all-attributes (face &optional frame)
26eb0118cbc6 (face-all-attributes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 87483
diff changeset
369 "Return an alist stating the attributes of FACE.
26eb0118cbc6 (face-all-attributes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 87483
diff changeset
370 Each element of the result has the form (ATTR-NAME . ATTR-VALUE).
26eb0118cbc6 (face-all-attributes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 87483
diff changeset
371 Normally the value describes the default attributes,
26eb0118cbc6 (face-all-attributes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 87483
diff changeset
372 but if you specify FRAME, the value describes the attributes
26eb0118cbc6 (face-all-attributes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 87483
diff changeset
373 of FACE on FRAME."
87502
a6788888f377 (face-all-attributes): If FRAME is nil, return defaults.
Richard M. Stallman <rms@gnu.org>
parents: 87494
diff changeset
374 (mapcar (lambda (pair)
a6788888f377 (face-all-attributes): If FRAME is nil, return defaults.
Richard M. Stallman <rms@gnu.org>
parents: 87494
diff changeset
375 (let ((attr (car pair)))
a6788888f377 (face-all-attributes): If FRAME is nil, return defaults.
Richard M. Stallman <rms@gnu.org>
parents: 87494
diff changeset
376 (cons attr (face-attribute face attr (or frame t)))))
87494
26eb0118cbc6 (face-all-attributes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 87483
diff changeset
377 face-attribute-name-alist))
26eb0118cbc6 (face-all-attributes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 87483
diff changeset
378
40399
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
379 (defun face-attribute (face attribute &optional frame inherit)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
380 "Return the value of FACE's ATTRIBUTE on FRAME.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
381 If the optional argument FRAME is given, report on face FACE in that frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
382 If FRAME is t, report on the defaults for face FACE (for new frames).
40399
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
383 If FRAME is omitted or nil, use the selected frame.
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
384
67049
580816de789f * faces.el: Revert 2005-11-17 change. :ignore-defface is now
Chong Yidong <cyd@stupidchicken.com>
parents: 66975
diff changeset
385 If INHERIT is nil, only attributes directly defined by FACE are considered,
580816de789f * faces.el: Revert 2005-11-17 change. :ignore-defface is now
Chong Yidong <cyd@stupidchicken.com>
parents: 66975
diff changeset
386 so the return value may be `unspecified', or a relative value.
40399
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
387 If INHERIT is non-nil, FACE's definition of ATTRIBUTE is merged with the
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
388 faces specified by its `:inherit' attribute; however the return value
67049
580816de789f * faces.el: Revert 2005-11-17 change. :ignore-defface is now
Chong Yidong <cyd@stupidchicken.com>
parents: 66975
diff changeset
389 may still be `unspecified' or relative.
40399
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
390 If INHERIT is a face or a list of faces, then the result is further merged
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
391 with that face (or faces), until it becomes specified and absolute.
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
392
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
393 To ensure that the return value is always specified and absolute, use a
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
394 value of `default' for INHERIT; this will resolve any unspecified or
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
395 relative values by merging with the `default' face (which is always
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
396 completely specified)."
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
397 (let ((value (internal-get-lisp-face-attribute face attribute frame)))
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
398 (when (and inherit (face-attribute-relative-p attribute value))
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
399 ;; VALUE is relative, so merge with inherited faces
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
400 (let ((inh-from (face-attribute face :inherit frame)))
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
401 (unless (or (null inh-from) (eq inh-from 'unspecified))
66596
56a63119fa20 (face-attribute): Handle the case where a face inherits from
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 66360
diff changeset
402 (condition-case nil
56a63119fa20 (face-attribute): Handle the case where a face inherits from
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 66360
diff changeset
403 (setq value
56a63119fa20 (face-attribute): Handle the case where a face inherits from
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 66360
diff changeset
404 (face-attribute-merged-with attribute value inh-from frame))
56a63119fa20 (face-attribute): Handle the case where a face inherits from
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 66360
diff changeset
405 ;; The `inherit' attribute may point to non existent faces.
56a63119fa20 (face-attribute): Handle the case where a face inherits from
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 66360
diff changeset
406 (error nil)))))
40399
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
407 (when (and inherit
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
408 (not (eq inherit t))
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
409 (face-attribute-relative-p attribute value))
43711
d15360503e4e (face-spec-choose): Allow `t' to appear before the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43550
diff changeset
410 ;; We should merge with INHERIT as well
40399
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
411 (setq value (face-attribute-merged-with attribute value inherit frame)))
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
412 value))
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
413
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
414 (defun face-attribute-merged-with (attribute value faces &optional frame)
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
415 "Merges ATTRIBUTE, initially VALUE, with faces from FACES until absolute.
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
416 FACES may be either a single face or a list of faces.
64539
c94d5f576885 (describe-face): "?\ " -> "?\s".
Juanma Barranquero <lekktu@gmail.com>
parents: 64497
diff changeset
417 \[This is an internal function.]"
40399
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
418 (cond ((not (face-attribute-relative-p attribute value))
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
419 value)
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
420 ((null faces)
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
421 value)
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
422 ((consp faces)
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
423 (face-attribute-merged-with
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
424 attribute
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
425 (face-attribute-merged-with attribute value (car faces) frame)
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
426 (cdr faces)
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
427 frame))
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
428 (t
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
429 (merge-face-attribute attribute
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
430 value
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
431 (face-attribute faces attribute frame t)))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
432
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
433
40399
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
434 (defmacro face-attribute-specified-or (value &rest body)
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
435 "Return VALUE, unless it's `unspecified', in which case evaluate BODY and return the result."
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
436 (let ((temp (make-symbol "value")))
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
437 `(let ((,temp ,value))
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
438 (if (not (eq ,temp 'unspecified))
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
439 ,temp
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
440 ,@body))))
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
441
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
442 (defun face-foreground (face &optional frame inherit)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
443 "Return the foreground color name of FACE, or nil if unspecified.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
444 If the optional argument FRAME is given, report on face FACE in that frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
445 If FRAME is t, report on the defaults for face FACE (for new frames).
40399
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
446 If FRAME is omitted or nil, use the selected frame.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
447
40399
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
448 If INHERIT is nil, only a foreground color directly defined by FACE is
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
449 considered, so the return value may be nil.
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
450 If INHERIT is t, and FACE doesn't define a foreground color, then any
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
451 foreground color that FACE inherits through its `:inherit' attribute
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
452 is considered as well; however the return value may still be nil.
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
453 If INHERIT is a face or a list of faces, then it is used to try to
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
454 resolve an unspecified foreground color.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
455
40399
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
456 To ensure that a valid color is always returned, use a value of
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
457 `default' for INHERIT; this will resolve any unspecified values by
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
458 merging with the `default' face (which is always completely specified)."
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
459 (face-attribute-specified-or (face-attribute face :foreground frame inherit)
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
460 nil))
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
461
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
462 (defun face-background (face &optional frame inherit)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
463 "Return the background color name of FACE, or nil if unspecified.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
464 If the optional argument FRAME is given, report on face FACE in that frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
465 If FRAME is t, report on the defaults for face FACE (for new frames).
40399
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
466 If FRAME is omitted or nil, use the selected frame.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
467
40399
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
468 If INHERIT is nil, only a background color directly defined by FACE is
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
469 considered, so the return value may be nil.
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
470 If INHERIT is t, and FACE doesn't define a background color, then any
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
471 background color that FACE inherits through its `:inherit' attribute
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
472 is considered as well; however the return value may still be nil.
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
473 If INHERIT is a face or a list of faces, then it is used to try to
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
474 resolve an unspecified background color.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
475
40399
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
476 To ensure that a valid color is always returned, use a value of
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
477 `default' for INHERIT; this will resolve any unspecified values by
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
478 merging with the `default' face (which is always completely specified)."
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
479 (face-attribute-specified-or (face-attribute face :background frame inherit)
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
480 nil))
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
481
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
482 (defun face-stipple (face &optional frame inherit)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
483 "Return the stipple pixmap name of FACE, or nil if unspecified.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
484 If the optional argument FRAME is given, report on face FACE in that frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
485 If FRAME is t, report on the defaults for face FACE (for new frames).
40399
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
486 If FRAME is omitted or nil, use the selected frame.
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
487
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
488 If INHERIT is nil, only a stipple directly defined by FACE is
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
489 considered, so the return value may be nil.
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
490 If INHERIT is t, and FACE doesn't define a stipple, then any stipple
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
491 that FACE inherits through its `:inherit' attribute is considered as
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
492 well; however the return value may still be nil.
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
493 If INHERIT is a face or a list of faces, then it is used to try to
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
494 resolve an unspecified stipple.
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
495
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
496 To ensure that a valid stipple or nil is always returned, use a value of
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
497 `default' for INHERIT; this will resolve any unspecified values by merging
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
498 with the `default' face (which is always completely specified)."
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
499 (face-attribute-specified-or (face-attribute face :stipple frame inherit)
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
500 nil))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
501
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
502
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
503 (defalias 'face-background-pixmap 'face-stipple)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
504
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
505
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
506 (defun face-underline-p (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
507 "Return non-nil if FACE is underlined.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
508 If the optional argument FRAME is given, report on face FACE in that frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
509 If FRAME is t, report on the defaults for face FACE (for new frames).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
510 If FRAME is omitted or nil, use the selected frame."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
511 (eq (face-attribute face :underline frame) t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
512
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
513
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
514 (defun face-inverse-video-p (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
515 "Return non-nil if FACE is in inverse video on FRAME.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
516 If the optional argument FRAME is given, report on face FACE in that frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
517 If FRAME is t, report on the defaults for face FACE (for new frames).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
518 If FRAME is omitted or nil, use the selected frame."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
519 (eq (face-attribute face :inverse-video frame) t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
520
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
521
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
522 (defun face-bold-p (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
523 "Return non-nil if the font of FACE is bold on FRAME.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
524 If the optional argument FRAME is given, report on face FACE in that frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
525 If FRAME is t, report on the defaults for face FACE (for new frames).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
526 If FRAME is omitted or nil, use the selected frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
527 Use `face-attribute' for finer control."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
528 (let ((bold (face-attribute face :weight frame)))
25561
67c224f5cc1a (face-bold-p): Don't return t if face has lighter
Gerd Moellmann <gerd@gnu.org>
parents: 25545
diff changeset
529 (memq bold '(semi-bold bold extra-bold ultra-bold))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
530
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
531
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
532 (defun face-italic-p (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
533 "Return non-nil if the font of FACE is italic on FRAME.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
534 If the optional argument FRAME is given, report on face FACE in that frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
535 If FRAME is t, report on the defaults for face FACE (for new frames).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
536 If FRAME is omitted or nil, use the selected frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
537 Use `face-attribute' for finer control."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
538 (let ((italic (face-attribute face :slant frame)))
25616
4dbea85f5af0 (face-italic-p): Return t only for values `italic'
Gerd Moellmann <gerd@gnu.org>
parents: 25588
diff changeset
539 (memq italic '(italic oblique))))
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
540
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
541
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
542
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
543 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
544 ;;; Face documentation.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
545 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
546
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
547 (defun face-documentation (face)
63660
47c90f7c23df (face-documentation, set-face-attribute)
Glenn Morris <rgm@gnu.org>
parents: 63650
diff changeset
548 "Get the documentation string for FACE.
47c90f7c23df (face-documentation, set-face-attribute)
Glenn Morris <rgm@gnu.org>
parents: 63650
diff changeset
549 If FACE is a face-alias, get the documentation for the target face."
47c90f7c23df (face-documentation, set-face-attribute)
Glenn Morris <rgm@gnu.org>
parents: 63650
diff changeset
550 (let ((alias (get face 'face-alias))
47c90f7c23df (face-documentation, set-face-attribute)
Glenn Morris <rgm@gnu.org>
parents: 63650
diff changeset
551 doc)
47c90f7c23df (face-documentation, set-face-attribute)
Glenn Morris <rgm@gnu.org>
parents: 63650
diff changeset
552 (if alias
47c90f7c23df (face-documentation, set-face-attribute)
Glenn Morris <rgm@gnu.org>
parents: 63650
diff changeset
553 (progn
47c90f7c23df (face-documentation, set-face-attribute)
Glenn Morris <rgm@gnu.org>
parents: 63650
diff changeset
554 (setq doc (get alias 'face-documentation))
47c90f7c23df (face-documentation, set-face-attribute)
Glenn Morris <rgm@gnu.org>
parents: 63650
diff changeset
555 (format "%s is an alias for the face `%s'.%s" face alias
47c90f7c23df (face-documentation, set-face-attribute)
Glenn Morris <rgm@gnu.org>
parents: 63650
diff changeset
556 (if doc (format "\n%s" doc)
47c90f7c23df (face-documentation, set-face-attribute)
Glenn Morris <rgm@gnu.org>
parents: 63650
diff changeset
557 "")))
47c90f7c23df (face-documentation, set-face-attribute)
Glenn Morris <rgm@gnu.org>
parents: 63650
diff changeset
558 (get face 'face-documentation))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
559
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
560
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
561 (defun set-face-documentation (face string)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
562 "Set the documentation string for FACE to STRING."
26927
27d6c0e07ea8 (set-face-attribute): Purecopy the attributes set.
Dave Love <fx@gnu.org>
parents: 26902
diff changeset
563 ;; Perhaps the text should go in DOC.
26657
b5c0d55411ad (set-face-documentation): Purecopy STRING.
Dave Love <fx@gnu.org>
parents: 26353
diff changeset
564 (put face 'face-documentation (purecopy string)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
565
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
566
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
567 (defalias 'face-doc-string 'face-documentation)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
568 (defalias 'set-face-doc-string 'set-face-documentation)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
569
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
570
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
571
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
572 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
573 ;; Setting face attributes.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
574 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
575
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
576
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
577 (defun set-face-attribute (face frame &rest args)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
578 "Set attributes of FACE on FRAME from ARGS.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
579
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
580 FRAME nil means change attributes on all frames. FRAME t means change
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
581 the default for new frames (this is done automatically each time an
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
582 attribute is changed on all frames).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
583
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
584 ARGS must come in pairs ATTRIBUTE VALUE. ATTRIBUTE must be a valid
67049
580816de789f * faces.el: Revert 2005-11-17 change. :ignore-defface is now
Chong Yidong <cyd@stupidchicken.com>
parents: 66975
diff changeset
585 face attribute name. All attributes can be set to `unspecified';
580816de789f * faces.el: Revert 2005-11-17 change. :ignore-defface is now
Chong Yidong <cyd@stupidchicken.com>
parents: 66975
diff changeset
586 this fact is not further mentioned below.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
587
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
588 The following attributes are recognized:
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
589
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
590 `:family'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
591
96292
fcffe32b9669 (set-face-attribute): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents: 96247
diff changeset
592 VALUE must be a string specifying the font family, e.g. ``monospace'',
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
593 or a fontset alias name. If a font family is specified, wild-cards `*'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
594 and `?' are allowed.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
595
95862
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
596 `:foundry'
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
597
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
598 VALUE must be a string specifying the font foundry,
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
599 e.g. ``adobe''. If a font foundry is specified, wild-cards `*'
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
600 and `?' are allowed.
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
601
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
602 `:width'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
603
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
604 VALUE specifies the relative proportionate width of the font to use.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
605 It must be one of the symbols `ultra-condensed', `extra-condensed',
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
606 `condensed', `semi-condensed', `normal', `semi-expanded', `expanded',
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
607 `extra-expanded', or `ultra-expanded'.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
608
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
609 `:height'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
610
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
611 VALUE must be either an integer specifying the height of the font to use
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
612 in 1/10 pt, a floating point number specifying the amount by which to
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
613 scale any underlying face, or a function, which is called with the old
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
614 height (from the underlying face), and should return the new height.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
615
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
616 `:weight'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
617
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
618 VALUE specifies the weight of the font to use. It must be one of the
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
619 symbols `ultra-bold', `extra-bold', `bold', `semi-bold', `normal',
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
620 `semi-light', `light', `extra-light', `ultra-light'.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
621
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
622 `:slant'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
623
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
624 VALUE specifies the slant of the font to use. It must be one of the
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
625 symbols `italic', `oblique', `normal', `reverse-italic', or
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
626 `reverse-oblique'.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
627
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
628 `:foreground', `:background'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
629
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
630 VALUE must be a color name, a string.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
631
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
632 `:underline'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
633
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
634 VALUE specifies whether characters in FACE should be underlined. If
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
635 VALUE is t, underline with foreground color of the face. If VALUE is
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
636 a string, underline with that color. If VALUE is nil, explicitly
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
637 don't underline.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
638
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
639 `:overline'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
640
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
641 VALUE specifies whether characters in FACE should be overlined. If
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
642 VALUE is t, overline with foreground color of the face. If VALUE is a
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
643 string, overline with that color. If VALUE is nil, explicitly don't
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
644 overline.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
645
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
646 `:strike-through'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
647
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
648 VALUE specifies whether characters in FACE should be drawn with a line
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
649 striking through them. If VALUE is t, use the foreground color of the
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
650 face. If VALUE is a string, strike-through with that color. If VALUE
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
651 is nil, explicitly don't strike through.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
652
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
653 `:box'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
654
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
655 VALUE specifies whether characters in FACE should have a box drawn
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
656 around them. If VALUE is nil, explicitly don't draw boxes. If
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
657 VALUE is t, draw a box with lines of width 1 in the foreground color
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
658 of the face. If VALUE is a string, the string must be a color name,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
659 and the box is drawn in that color with a line width of 1. Otherwise,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
660 VALUE must be a property list of the form `(:line-width WIDTH
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
661 :color COLOR :style STYLE)'. If a keyword/value pair is missing from
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
662 the property list, a default value will be used for the value, as
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
663 specified below. WIDTH specifies the width of the lines to draw; it
36009
3f009240cc7d (set-face-attribute): Describe the case of a negative
Kenichi Handa <handa@m17n.org>
parents: 34682
diff changeset
664 defaults to 1. If WIDTH is negative, the absolute value is the width
3f009240cc7d (set-face-attribute): Describe the case of a negative
Kenichi Handa <handa@m17n.org>
parents: 34682
diff changeset
665 of the lines, and draw top/bottom lines inside the characters area,
3f009240cc7d (set-face-attribute): Describe the case of a negative
Kenichi Handa <handa@m17n.org>
parents: 34682
diff changeset
666 not around it. COLOR is the name of the color to draw in, default is
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
667 the foreground color of the face for simple boxes, and the background
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
668 color of the face for 3D boxes. STYLE specifies whether a 3D box
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
669 should be draw. If STYLE is `released-button', draw a box looking
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
670 like a released 3D button. If STYLE is `pressed-button' draw a box
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
671 that appears like a pressed button. If STYLE is nil, the default if
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
672 the property list doesn't contain a style specification, draw a 2D
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
673 box.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
674
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
675 `:inverse-video'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
676
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
677 VALUE specifies whether characters in FACE should be displayed in
28840
d0531e35d9f2 Some doc fixes.
Dave Love <fx@gnu.org>
parents: 28214
diff changeset
678 inverse video. VALUE must be one of t or nil.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
679
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
680 `:stipple'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
681
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
682 If VALUE is a string, it must be the name of a file of pixmap data.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
683 The directories listed in the `x-bitmap-file-path' variable are
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
684 searched. Alternatively, VALUE may be a list of the form (WIDTH
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
685 HEIGHT DATA) where WIDTH and HEIGHT are the size in pixels, and DATA
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
686 is a string containing the raw bits of the bitmap. VALUE nil means
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
687 explicitly don't use a stipple pattern.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
688
95862
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
689 For convenience, attributes `:family', `:foundry', `:width',
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
690 `:height', `:weight', and `:slant' may also be set in one step
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
691 from an X font name:
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
692
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
693 `:font'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
694
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
695 Set font-related face attributes from VALUE. VALUE must be a valid
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
696 XLFD font name. If it is a font name pattern, the first matching font
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
697 will be used.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
698
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
699 For compatibility with Emacs 20, keywords `:bold' and `:italic' can
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
700 be used to specify that a bold or italic font should be used. VALUE
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
701 must be t or nil in that case. A value of `unspecified' is not allowed.
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
702
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
703 `:inherit'
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
704
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
705 VALUE is the name of a face from which to inherit attributes, or a list
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
706 of face names. Attributes from inherited faces are merged into the face
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
707 like an underlying face would be, with higher priority than underlying faces."
98728
a962df9a86fb (set-face-attribute): Set family and foundry before other attributes.
Chong Yidong <cyd@stupidchicken.com>
parents: 98659
diff changeset
708 (setq args (purecopy args))
a962df9a86fb (set-face-attribute): Set family and foundry before other attributes.
Chong Yidong <cyd@stupidchicken.com>
parents: 98659
diff changeset
709 (let ((where (if (null frame) 0 frame))
a962df9a86fb (set-face-attribute): Set family and foundry before other attributes.
Chong Yidong <cyd@stupidchicken.com>
parents: 98659
diff changeset
710 (spec args)
a962df9a86fb (set-face-attribute): Set family and foundry before other attributes.
Chong Yidong <cyd@stupidchicken.com>
parents: 98659
diff changeset
711 family foundry)
51280
c2efaecb5d8f (set-face-attribute): Set face-modified prop to t
Richard M. Stallman <rms@gnu.org>
parents: 51248
diff changeset
712 ;; If we set the new-frame defaults, this face is modified outside Custom.
c2efaecb5d8f (set-face-attribute): Set face-modified prop to t
Richard M. Stallman <rms@gnu.org>
parents: 51248
diff changeset
713 (if (memq where '(0 t))
63660
47c90f7c23df (face-documentation, set-face-attribute)
Glenn Morris <rgm@gnu.org>
parents: 63650
diff changeset
714 (put (or (get face 'face-alias) face) 'face-modified t))
98728
a962df9a86fb (set-face-attribute): Set family and foundry before other attributes.
Chong Yidong <cyd@stupidchicken.com>
parents: 98659
diff changeset
715 ;; If family and/or foundry are specified, set it first. Certain
a962df9a86fb (set-face-attribute): Set family and foundry before other attributes.
Chong Yidong <cyd@stupidchicken.com>
parents: 98659
diff changeset
716 ;; face attributes, e.g. :weight semi-condensed, are not supported
a962df9a86fb (set-face-attribute): Set family and foundry before other attributes.
Chong Yidong <cyd@stupidchicken.com>
parents: 98659
diff changeset
717 ;; in every font. See bug#1127.
a962df9a86fb (set-face-attribute): Set family and foundry before other attributes.
Chong Yidong <cyd@stupidchicken.com>
parents: 98659
diff changeset
718 (while spec
a962df9a86fb (set-face-attribute): Set family and foundry before other attributes.
Chong Yidong <cyd@stupidchicken.com>
parents: 98659
diff changeset
719 (cond ((eq (car spec) :family)
a962df9a86fb (set-face-attribute): Set family and foundry before other attributes.
Chong Yidong <cyd@stupidchicken.com>
parents: 98659
diff changeset
720 (setq family (cadr spec)))
a962df9a86fb (set-face-attribute): Set family and foundry before other attributes.
Chong Yidong <cyd@stupidchicken.com>
parents: 98659
diff changeset
721 ((eq (car spec) :foundry)
a962df9a86fb (set-face-attribute): Set family and foundry before other attributes.
Chong Yidong <cyd@stupidchicken.com>
parents: 98659
diff changeset
722 (setq foundry (cadr spec))))
a962df9a86fb (set-face-attribute): Set family and foundry before other attributes.
Chong Yidong <cyd@stupidchicken.com>
parents: 98659
diff changeset
723 (setq spec (cddr spec)))
a962df9a86fb (set-face-attribute): Set family and foundry before other attributes.
Chong Yidong <cyd@stupidchicken.com>
parents: 98659
diff changeset
724 (when (or family foundry)
a962df9a86fb (set-face-attribute): Set family and foundry before other attributes.
Chong Yidong <cyd@stupidchicken.com>
parents: 98659
diff changeset
725 (when (and (stringp family)
a962df9a86fb (set-face-attribute): Set family and foundry before other attributes.
Chong Yidong <cyd@stupidchicken.com>
parents: 98659
diff changeset
726 (string-match "\\([^-]*\\)-\\([^-]*\\)" family))
a962df9a86fb (set-face-attribute): Set family and foundry before other attributes.
Chong Yidong <cyd@stupidchicken.com>
parents: 98659
diff changeset
727 (unless foundry
a962df9a86fb (set-face-attribute): Set family and foundry before other attributes.
Chong Yidong <cyd@stupidchicken.com>
parents: 98659
diff changeset
728 (setq foundry (match-string 2 family)))
a962df9a86fb (set-face-attribute): Set family and foundry before other attributes.
Chong Yidong <cyd@stupidchicken.com>
parents: 98659
diff changeset
729 (setq family (match-string 1 family)))
a962df9a86fb (set-face-attribute): Set family and foundry before other attributes.
Chong Yidong <cyd@stupidchicken.com>
parents: 98659
diff changeset
730 (when (stringp family)
a962df9a86fb (set-face-attribute): Set family and foundry before other attributes.
Chong Yidong <cyd@stupidchicken.com>
parents: 98659
diff changeset
731 (internal-set-lisp-face-attribute face :family (purecopy family)
a962df9a86fb (set-face-attribute): Set family and foundry before other attributes.
Chong Yidong <cyd@stupidchicken.com>
parents: 98659
diff changeset
732 where))
a962df9a86fb (set-face-attribute): Set family and foundry before other attributes.
Chong Yidong <cyd@stupidchicken.com>
parents: 98659
diff changeset
733 (when (stringp foundry)
a962df9a86fb (set-face-attribute): Set family and foundry before other attributes.
Chong Yidong <cyd@stupidchicken.com>
parents: 98659
diff changeset
734 (internal-set-lisp-face-attribute face :foundry (purecopy foundry)
a962df9a86fb (set-face-attribute): Set family and foundry before other attributes.
Chong Yidong <cyd@stupidchicken.com>
parents: 98659
diff changeset
735 where)))
31439
d7a98f35b441 (set-face-attribute): Simplify by calling
Gerd Moellmann <gerd@gnu.org>
parents: 31401
diff changeset
736 (while args
98728
a962df9a86fb (set-face-attribute): Set family and foundry before other attributes.
Chong Yidong <cyd@stupidchicken.com>
parents: 98659
diff changeset
737 (unless (memq (car args) '(:family :foundry))
96398
36c91bfee166 (inhibit-face-set-after-frame-default): Var deleted.
Chong Yidong <cyd@stupidchicken.com>
parents: 96292
diff changeset
738 (internal-set-lisp-face-attribute face (car args)
36c91bfee166 (inhibit-face-set-after-frame-default): Var deleted.
Chong Yidong <cyd@stupidchicken.com>
parents: 96292
diff changeset
739 (purecopy (cadr args))
36c91bfee166 (inhibit-face-set-after-frame-default): Var deleted.
Chong Yidong <cyd@stupidchicken.com>
parents: 96292
diff changeset
740 where))
98728
a962df9a86fb (set-face-attribute): Set family and foundry before other attributes.
Chong Yidong <cyd@stupidchicken.com>
parents: 98659
diff changeset
741 (setq args (cddr args)))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
742
26337
6bf33b333eb2 (make-face-bold, make-face-unbold, make-face-italic)
Gerd Moellmann <gerd@gnu.org>
parents: 25947
diff changeset
743 (defun make-face-bold (face &optional frame noerror)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
744 "Make the font of FACE be bold, if possible.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
745 FRAME nil or not specified means change face on all frames.
26337
6bf33b333eb2 (make-face-bold, make-face-unbold, make-face-italic)
Gerd Moellmann <gerd@gnu.org>
parents: 25947
diff changeset
746 Argument NOERROR is ignored and retained for compatibility.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
747 Use `set-face-attribute' for finer control of the font weight."
40456
1f5aee41efe9 (read-face-name): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents: 40454
diff changeset
748 (interactive (list (read-face-name "Make which face bold")))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
749 (set-face-attribute face frame :weight 'bold))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
750
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
751
26337
6bf33b333eb2 (make-face-bold, make-face-unbold, make-face-italic)
Gerd Moellmann <gerd@gnu.org>
parents: 25947
diff changeset
752 (defun make-face-unbold (face &optional frame noerror)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
753 "Make the font of FACE be non-bold, if possible.
26337
6bf33b333eb2 (make-face-bold, make-face-unbold, make-face-italic)
Gerd Moellmann <gerd@gnu.org>
parents: 25947
diff changeset
754 FRAME nil or not specified means change face on all frames.
6bf33b333eb2 (make-face-bold, make-face-unbold, make-face-italic)
Gerd Moellmann <gerd@gnu.org>
parents: 25947
diff changeset
755 Argument NOERROR is ignored and retained for compatibility."
40456
1f5aee41efe9 (read-face-name): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents: 40454
diff changeset
756 (interactive (list (read-face-name "Make which face non-bold")))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
757 (set-face-attribute face frame :weight 'normal))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
758
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
759
26337
6bf33b333eb2 (make-face-bold, make-face-unbold, make-face-italic)
Gerd Moellmann <gerd@gnu.org>
parents: 25947
diff changeset
760 (defun make-face-italic (face &optional frame noerror)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
761 "Make the font of FACE be italic, if possible.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
762 FRAME nil or not specified means change face on all frames.
26337
6bf33b333eb2 (make-face-bold, make-face-unbold, make-face-italic)
Gerd Moellmann <gerd@gnu.org>
parents: 25947
diff changeset
763 Argument NOERROR is ignored and retained for compatibility.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
764 Use `set-face-attribute' for finer control of the font slant."
40456
1f5aee41efe9 (read-face-name): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents: 40454
diff changeset
765 (interactive (list (read-face-name "Make which face italic")))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
766 (set-face-attribute face frame :slant 'italic))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
767
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
768
26337
6bf33b333eb2 (make-face-bold, make-face-unbold, make-face-italic)
Gerd Moellmann <gerd@gnu.org>
parents: 25947
diff changeset
769 (defun make-face-unitalic (face &optional frame noerror)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
770 "Make the font of FACE be non-italic, if possible.
28840
d0531e35d9f2 Some doc fixes.
Dave Love <fx@gnu.org>
parents: 28214
diff changeset
771 FRAME nil or not specified means change face on all frames.
d0531e35d9f2 Some doc fixes.
Dave Love <fx@gnu.org>
parents: 28214
diff changeset
772 Argument NOERROR is ignored and retained for compatibility."
40456
1f5aee41efe9 (read-face-name): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents: 40454
diff changeset
773 (interactive (list (read-face-name "Make which face non-italic")))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
774 (set-face-attribute face frame :slant 'normal))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
775
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
776
26337
6bf33b333eb2 (make-face-bold, make-face-unbold, make-face-italic)
Gerd Moellmann <gerd@gnu.org>
parents: 25947
diff changeset
777 (defun make-face-bold-italic (face &optional frame noerror)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
778 "Make the font of FACE be bold and italic, if possible.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
779 FRAME nil or not specified means change face on all frames.
26337
6bf33b333eb2 (make-face-bold, make-face-unbold, make-face-italic)
Gerd Moellmann <gerd@gnu.org>
parents: 25947
diff changeset
780 Argument NOERROR is ignored and retained for compatibility.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
781 Use `set-face-attribute' for finer control of font weight and slant."
40456
1f5aee41efe9 (read-face-name): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents: 40454
diff changeset
782 (interactive (list (read-face-name "Make which face bold-italic")))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
783 (set-face-attribute face frame :weight 'bold :slant 'italic))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
784
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
785
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
786 (defun set-face-font (face font &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
787 "Change font-related attributes of FACE to those of FONT (a string).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
788 FRAME nil or not specified means change face on all frames.
95862
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
789 This sets the attributes `:family', `:foundry', `:width',
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
790 `:height', `:weight', and `:slant'. When called interactively,
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
791 prompt for the face and font."
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
792 (interactive (read-face-and-attribute :font))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
793 (set-face-attribute face frame :font font))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
794
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
795
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
796 ;; Implementation note: Emulating gray background colors with a
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
797 ;; stipple pattern is now part of the face realization process, and is
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
798 ;; done in C depending on the frame on which the face is realized.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
799
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
800 (defun set-face-background (face color &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
801 "Change the background color of face FACE to COLOR (a string).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
802 FRAME nil or not specified means change face on all frames.
59281
95516eef1d5b (set-face-background, set-face-foreground): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 59262
diff changeset
803 COLOR can be a system-defined color name (see `list-colors-display')
95516eef1d5b (set-face-background, set-face-foreground): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 59262
diff changeset
804 or a hex spec of the form #RRGGBB.
95516eef1d5b (set-face-background, set-face-foreground): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 59262
diff changeset
805 When called interactively, prompts for the face and color."
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
806 (interactive (read-face-and-attribute :background))
36060
d9b4d1370073 (set-face-background, set-face-foreground)
Miles Bader <miles@gnu.org>
parents: 36035
diff changeset
807 (set-face-attribute face frame :background (or color 'unspecified)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
808
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
809
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
810 (defun set-face-foreground (face color &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
811 "Change the foreground color of face FACE to COLOR (a string).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
812 FRAME nil or not specified means change face on all frames.
59281
95516eef1d5b (set-face-background, set-face-foreground): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 59262
diff changeset
813 COLOR can be a system-defined color name (see `list-colors-display')
95516eef1d5b (set-face-background, set-face-foreground): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 59262
diff changeset
814 or a hex spec of the form #RRGGBB.
95516eef1d5b (set-face-background, set-face-foreground): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 59262
diff changeset
815 When called interactively, prompts for the face and color."
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
816 (interactive (read-face-and-attribute :foreground))
36060
d9b4d1370073 (set-face-background, set-face-foreground)
Miles Bader <miles@gnu.org>
parents: 36035
diff changeset
817 (set-face-attribute face frame :foreground (or color 'unspecified)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
818
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
819
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
820 (defun set-face-stipple (face stipple &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
821 "Change the stipple pixmap of face FACE to STIPPLE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
822 FRAME nil or not specified means change face on all frames.
28840
d0531e35d9f2 Some doc fixes.
Dave Love <fx@gnu.org>
parents: 28214
diff changeset
823 STIPPLE should be a string, the name of a file of pixmap data.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
824 The directories listed in the `x-bitmap-file-path' variable are searched.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
825
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
826 Alternatively, STIPPLE may be a list of the form (WIDTH HEIGHT DATA)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
827 where WIDTH and HEIGHT are the size in pixels,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
828 and DATA is a string, containing the raw bits of the bitmap."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
829 (interactive (read-face-and-attribute :stipple))
36060
d9b4d1370073 (set-face-background, set-face-foreground)
Miles Bader <miles@gnu.org>
parents: 36035
diff changeset
830 (set-face-attribute face frame :stipple (or stipple 'unspecified)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
831
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
832
75591
a0f90fb2d33d (set-face-underline-p, modify-face): Rename arg UNDERLINE-P
Juanma Barranquero <lekktu@gmail.com>
parents: 75579
diff changeset
833 (defun set-face-underline-p (face underline &optional frame)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
834 "Specify whether face FACE is underlined.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
835 UNDERLINE nil means FACE explicitly doesn't underline.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
836 UNDERLINE non-nil means FACE explicitly does underlining
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
837 with the same of the foreground color.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
838 If UNDERLINE is a string, underline with the color named UNDERLINE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
839 FRAME nil or not specified means change face on all frames.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
840 Use `set-face-attribute' to ``unspecify'' underlining."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
841 (interactive
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
842 (let ((list (read-face-and-attribute :underline)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
843 (list (car list) (eq (car (cdr list)) t))))
75591
a0f90fb2d33d (set-face-underline-p, modify-face): Rename arg UNDERLINE-P
Juanma Barranquero <lekktu@gmail.com>
parents: 75579
diff changeset
844 (set-face-attribute face frame :underline underline))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
845
65068
6606e83775f0 (set-face-underline): Delete this duplicate function
Juri Linkov <juri@jurta.org>
parents: 64762
diff changeset
846 (define-obsolete-function-alias 'set-face-underline
6606e83775f0 (set-face-underline): Delete this duplicate function
Juri Linkov <juri@jurta.org>
parents: 64762
diff changeset
847 'set-face-underline-p "22.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
848
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
849
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
850 (defun set-face-inverse-video-p (face inverse-video-p &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
851 "Specify whether face FACE is in inverse video.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
852 INVERSE-VIDEO-P non-nil means FACE displays explicitly in inverse video.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
853 INVERSE-VIDEO-P nil means FACE explicitly is not in inverse video.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
854 FRAME nil or not specified means change face on all frames.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
855 Use `set-face-attribute' to ``unspecify'' the inverse video attribute."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
856 (interactive
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
857 (let ((list (read-face-and-attribute :inverse-video)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
858 (list (car list) (eq (car (cdr list)) t))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
859 (set-face-attribute face frame :inverse-video inverse-video-p))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
860
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
861
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
862 (defun set-face-bold-p (face bold-p &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
863 "Specify whether face FACE is bold.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
864 BOLD-P non-nil means FACE should explicitly display bold.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
865 BOLD-P nil means FACE should explicitly display non-bold.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
866 FRAME nil or not specified means change face on all frames.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
867 Use `set-face-attribute' or `modify-face' for finer control."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
868 (if (null bold-p)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
869 (make-face-unbold face frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
870 (make-face-bold face frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
871
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
872
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
873 (defun set-face-italic-p (face italic-p &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
874 "Specify whether face FACE is italic.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
875 ITALIC-P non-nil means FACE should explicitly display italic.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
876 ITALIC-P nil means FACE should explicitly display non-italic.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
877 FRAME nil or not specified means change face on all frames.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
878 Use `set-face-attribute' or `modify-face' for finer control."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
879 (if (null italic-p)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
880 (make-face-unitalic face frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
881 (make-face-italic face frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
882
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
883
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
884 (defalias 'set-face-background-pixmap 'set-face-stipple)
10379
f9d713e8c77c (face-nontrivial-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10375
diff changeset
885
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
886
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
887 (defun invert-face (face &optional frame)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
888 "Swap the foreground and background colors of FACE.
40454
ce83eda9592d (invert-face): Check for 'unspecified, not for nil,
Eli Zaretskii <eliz@gnu.org>
parents: 40399
diff changeset
889 If FRAME is omitted or nil, it means change face on all frames.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
890 If FACE specifies neither foreground nor background color,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
891 set its foreground and background to the background and foreground
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
892 of the default face. Value is FACE."
40456
1f5aee41efe9 (read-face-name): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents: 40454
diff changeset
893 (interactive (list (read-face-name "Invert face")))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
894 (let ((fg (face-attribute face :foreground frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
895 (bg (face-attribute face :background frame)))
40454
ce83eda9592d (invert-face): Check for 'unspecified, not for nil,
Eli Zaretskii <eliz@gnu.org>
parents: 40399
diff changeset
896 (if (not (and (eq fg 'unspecified) (eq bg 'unspecified)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
897 (set-face-attribute face frame :foreground bg :background fg)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
898 (set-face-attribute face frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
899 :foreground
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
900 (face-attribute 'default :background frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
901 :background
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
902 (face-attribute 'default :foreground frame))))
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
903 face)
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
904
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
905
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
906 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
907 ;;; Interactively modifying faces.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
908 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
909
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
910 (defun read-face-name (prompt &optional string-describing-default multiple)
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
911 "Read a face, defaulting to the face or faces on the char after point.
71521
1109575a2873 * help-mode.el (help-xref-symbol-regexp): Add property as a keyword
Nick Roberts <nickrob@snap.net.nz>
parents: 71231
diff changeset
912 If it has the property `read-face-name', that overrides the `face' property.
71591
defa6bf31164 (read-face-name): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 71521
diff changeset
913 PROMPT should be a string that describes what the caller will do with the face;
defa6bf31164 (read-face-name): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 71521
diff changeset
914 it should not end in a space.
defa6bf31164 (read-face-name): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 71521
diff changeset
915 STRING-DESCRIBING-DEFAULT should describe what default the caller will use if
defa6bf31164 (read-face-name): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 71521
diff changeset
916 the user just types RET; you can omit it.
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
917 If MULTIPLE is non-nil, return a list of faces (possibly only one).
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
918 Otherwise, return a single face."
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
919 (let ((faceprop (or (get-char-property (point) 'read-face-name)
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
920 (get-char-property (point) 'face)))
63382
9cbfa983c1cf (read-face-name): Use complete-in-turn complete non-aliases
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 63311
diff changeset
921 (aliasfaces nil)
9cbfa983c1cf (read-face-name): Use complete-in-turn complete non-aliases
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 63311
diff changeset
922 (nonaliasfaces nil)
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
923 faces)
63984
37ff9b4c3659 (read-face-name): Put the code for getting a face name
Juri Linkov <juri@jurta.org>
parents: 63881
diff changeset
924 ;; Try to get a face name from the buffer.
37ff9b4c3659 (read-face-name): Put the code for getting a face name
Juri Linkov <juri@jurta.org>
parents: 63881
diff changeset
925 (if (memq (intern-soft (thing-at-point 'symbol)) (face-list))
37ff9b4c3659 (read-face-name): Put the code for getting a face name
Juri Linkov <juri@jurta.org>
parents: 63881
diff changeset
926 (setq faces (list (intern-soft (thing-at-point 'symbol)))))
37ff9b4c3659 (read-face-name): Put the code for getting a face name
Juri Linkov <juri@jurta.org>
parents: 63881
diff changeset
927 ;; Add the named faces that the `face' property uses.
59262
c9bf2e1b7e1a (read-face-name): Don't treat an attribute spec as a list of faces.
Richard M. Stallman <rms@gnu.org>
parents: 59077
diff changeset
928 (if (and (listp faceprop)
c9bf2e1b7e1a (read-face-name): Don't treat an attribute spec as a list of faces.
Richard M. Stallman <rms@gnu.org>
parents: 59077
diff changeset
929 ;; Don't treat an attribute spec as a list of faces.
c9bf2e1b7e1a (read-face-name): Don't treat an attribute spec as a list of faces.
Richard M. Stallman <rms@gnu.org>
parents: 59077
diff changeset
930 (not (keywordp (car faceprop)))
c9bf2e1b7e1a (read-face-name): Don't treat an attribute spec as a list of faces.
Richard M. Stallman <rms@gnu.org>
parents: 59077
diff changeset
931 (not (memq (car faceprop) '(foreground-color background-color))))
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
932 (dolist (f faceprop)
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
933 (if (symbolp f)
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
934 (push f faces)))
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
935 (if (symbolp faceprop)
59262
c9bf2e1b7e1a (read-face-name): Don't treat an attribute spec as a list of faces.
Richard M. Stallman <rms@gnu.org>
parents: 59077
diff changeset
936 (push faceprop faces)))
64724
719375653e09 (read-face-name): Delete duplicate faces.
Juri Linkov <juri@jurta.org>
parents: 64539
diff changeset
937 (delete-dups faces)
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
938
63382
9cbfa983c1cf (read-face-name): Use complete-in-turn complete non-aliases
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 63311
diff changeset
939 ;; Build up the completion tables.
9cbfa983c1cf (read-face-name): Use complete-in-turn complete non-aliases
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 63311
diff changeset
940 (mapatoms (lambda (s)
9cbfa983c1cf (read-face-name): Use complete-in-turn complete non-aliases
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 63311
diff changeset
941 (if (custom-facep s)
9cbfa983c1cf (read-face-name): Use complete-in-turn complete non-aliases
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 63311
diff changeset
942 (if (get s 'face-alias)
9cbfa983c1cf (read-face-name): Use complete-in-turn complete non-aliases
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 63311
diff changeset
943 (push (symbol-name s) aliasfaces)
9cbfa983c1cf (read-face-name): Use complete-in-turn complete non-aliases
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 63311
diff changeset
944 (push (symbol-name s) nonaliasfaces)))))
9cbfa983c1cf (read-face-name): Use complete-in-turn complete non-aliases
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 63311
diff changeset
945
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
946 ;; If we only want one, and the default is more than one,
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
947 ;; discard the unwanted ones now.
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
948 (unless multiple
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
949 (if faces
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
950 (setq faces (list (car faces)))))
63984
37ff9b4c3659 (read-face-name): Put the code for getting a face name
Juri Linkov <juri@jurta.org>
parents: 63881
diff changeset
951 (require 'crm)
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
952 (let* ((input
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
953 ;; Read the input.
63984
37ff9b4c3659 (read-face-name): Put the code for getting a face name
Juri Linkov <juri@jurta.org>
parents: 63881
diff changeset
954 (completing-read-multiple
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
955 (if (or faces string-describing-default)
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
956 (format "%s (default %s): " prompt
63984
37ff9b4c3659 (read-face-name): Put the code for getting a face name
Juri Linkov <juri@jurta.org>
parents: 63881
diff changeset
957 (if faces (mapconcat 'symbol-name faces ",")
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
958 string-describing-default))
44896
fc1fdc78c3eb (read-face-name): Format the prompt correctly when there's no default.
Miles Bader <miles@gnu.org>
parents: 44892
diff changeset
959 (format "%s: " prompt))
94054
41482de59a50 (read-face-name): Use `completion-table-in-turn', not `complete-in-turn'.
Juanma Barranquero <lekktu@gmail.com>
parents: 93834
diff changeset
960 (completion-table-in-turn nonaliasfaces aliasfaces)
96435
414b3d1e76df (face-name-history): New variable.
Juri Linkov <juri@jurta.org>
parents: 96398
diff changeset
961 nil t nil 'face-name-history
63984
37ff9b4c3659 (read-face-name): Put the code for getting a face name
Juri Linkov <juri@jurta.org>
parents: 63881
diff changeset
962 (if faces (mapconcat 'symbol-name faces ","))))
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
963 ;; Canonicalize the output.
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
964 (output
63984
37ff9b4c3659 (read-face-name): Put the code for getting a face name
Juri Linkov <juri@jurta.org>
parents: 63881
diff changeset
965 (cond ((or (equal input "") (equal input '("")))
37ff9b4c3659 (read-face-name): Put the code for getting a face name
Juri Linkov <juri@jurta.org>
parents: 63881
diff changeset
966 faces)
37ff9b4c3659 (read-face-name): Put the code for getting a face name
Juri Linkov <juri@jurta.org>
parents: 63881
diff changeset
967 ((stringp input)
37ff9b4c3659 (read-face-name): Put the code for getting a face name
Juri Linkov <juri@jurta.org>
parents: 63881
diff changeset
968 (mapcar 'intern (split-string input ", *" t)))
37ff9b4c3659 (read-face-name): Put the code for getting a face name
Juri Linkov <juri@jurta.org>
parents: 63881
diff changeset
969 ((listp input)
37ff9b4c3659 (read-face-name): Put the code for getting a face name
Juri Linkov <juri@jurta.org>
parents: 63881
diff changeset
970 (mapcar 'intern input))
37ff9b4c3659 (read-face-name): Put the code for getting a face name
Juri Linkov <juri@jurta.org>
parents: 63881
diff changeset
971 (input))))
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
972 ;; Return either a list of faces or just one face.
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
973 (if multiple
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
974 output
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
975 (car output)))))
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
976
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
977 ;; Not defined without X, but behind window-system test.
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
978 (defvar x-bitmap-file-path)
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
979
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
980 (defun face-valid-attribute-values (attribute &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
981 "Return valid values for face attribute ATTRIBUTE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
982 The optional argument FRAME is used to determine available fonts
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
983 and colors. If it is nil or not specified, the selected frame is
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
984 used. Value is an alist of (NAME . VALUE) if ATTRIBUTE expects a value
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
985 out of a set of discrete values. Value is `integerp' if ATTRIBUTE expects
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
986 an integer value."
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
987 (let ((valid
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
988 (case attribute
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
989 (:family
83004
7900111db01c Converted display hooks to be display-local. Plus many bugfixes.
Karoly Lorentey <lorentey@elte.hu>
parents: 52401
diff changeset
990 (if (window-system frame)
101025
18e1be1514e1 (face-valid-attribute-values): Use string as value for :family
Chong Yidong <cyd@stupidchicken.com>
parents: 100908
diff changeset
991 (mapcar (lambda (x) (cons x x))
94956
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
992 (font-family-list))
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
993 ;; Only one font on TTYs.
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
994 (list (cons "default" "default"))))
95862
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
995 (:foundry
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
996 (list nil))
94956
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
997 (:width
97325
85f30f831ede (face-valid-attribute-values): Fix handling the value
Kenichi Handa <handa@m17n.org>
parents: 97048
diff changeset
998 (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
94956
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
999 font-width-table))
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
1000 (:weight
97325
85f30f831ede (face-valid-attribute-values): Fix handling the value
Kenichi Handa <handa@m17n.org>
parents: 97048
diff changeset
1001 (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
94956
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
1002 font-weight-table))
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
1003 (:slant
97325
85f30f831ede (face-valid-attribute-values): Fix handling the value
Kenichi Handa <handa@m17n.org>
parents: 97048
diff changeset
1004 (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
94956
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
1005 font-slant-table))
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
1006 (:inverse-video
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
1007 (mapcar #'(lambda (x) (cons (symbol-name x) x))
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
1008 (internal-lisp-face-attribute-values attribute)))
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1009 ((:underline :overline :strike-through :box)
83004
7900111db01c Converted display hooks to be display-local. Plus many bugfixes.
Karoly Lorentey <lorentey@elte.hu>
parents: 52401
diff changeset
1010 (if (window-system frame)
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1011 (nconc (mapcar #'(lambda (x) (cons (symbol-name x) x))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1012 (internal-lisp-face-attribute-values attribute))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1013 (mapcar #'(lambda (c) (cons c c))
75703
374c5b932d28 (face-valid-attribute-values): Use `defined-colors',
Juanma Barranquero <lekktu@gmail.com>
parents: 75696
diff changeset
1014 (defined-colors frame)))
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1015 (mapcar #'(lambda (x) (cons (symbol-name x) x))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1016 (internal-lisp-face-attribute-values attribute))))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1017 ((:foreground :background)
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1018 (mapcar #'(lambda (c) (cons c c))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1019 (defined-colors frame)))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1020 ((:height)
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1021 'integerp)
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1022 (:stipple
101149
9076b03251f0 (face-valid-attribute-values): No stipple on w32. (Bug#884)
Jason Rumney <jasonr@gnu.org>
parents: 101128
diff changeset
1023 (and (memq (window-system frame) '(x ns)) ; No stipple on w32
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1024 (mapcar #'list
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1025 (apply #'nconc
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1026 (mapcar (lambda (dir)
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1027 (and (file-readable-p dir)
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1028 (file-directory-p dir)
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1029 (directory-files dir)))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1030 x-bitmap-file-path)))))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1031 (:inherit
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1032 (cons '("none" . nil)
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1033 (mapcar #'(lambda (c) (cons (symbol-name c) c))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1034 (face-list))))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1035 (t
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1036 (error "Internal error")))))
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1037 (if (and (listp valid) (not (memq attribute '(:inherit))))
25245
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
1038 (nconc (list (cons "unspecified" 'unspecified)) valid)
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
1039 valid)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1040
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1041
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1042 (defvar face-attribute-name-alist
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1043 '((:family . "font family")
95862
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
1044 (:foundry . "font foundry")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1045 (:width . "character set width")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1046 (:height . "height in 1/10 pt")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1047 (:weight . "weight")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1048 (:slant . "slant")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1049 (:underline . "underline")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1050 (:overline . "overline")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1051 (:strike-through . "strike-through")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1052 (:box . "box")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1053 (:inverse-video . "inverse-video display")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1054 (:foreground . "foreground color")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1055 (:background . "background color")
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1056 (:stipple . "background stipple")
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1057 (:inherit . "inheritance"))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1058 "An alist of descriptive names for face attributes.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1059 Each element has the form (ATTRIBUTE-NAME . DESCRIPTION) where
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1060 ATTRIBUTE-NAME is a face attribute name (a keyword symbol), and
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1061 DESCRIPTION is a descriptive name for ATTRIBUTE-NAME.")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1062
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1063
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1064 (defun face-descriptive-attribute-name (attribute)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1065 "Return a descriptive name for ATTRIBUTE."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1066 (cdr (assq attribute face-attribute-name-alist)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1067
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1068
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1069 (defun face-read-string (face default name &optional completion-alist)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1070 "Interactively read a face attribute string value.
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1071 FACE is the face whose attribute is read. If non-nil, DEFAULT is the
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1072 default string to return if no new value is entered. NAME is a
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1073 descriptive name of the attribute for prompting. COMPLETION-ALIST is an
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1074 alist of valid values, if non-nil.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1075
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1076 Entering nothing accepts the default string DEFAULT.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1077 Value is the new attribute value."
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1078 ;; Capitalize NAME (we don't use `capitalize' because that capitalizes
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1079 ;; each word in a string separately).
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1080 (setq name (concat (upcase (substring name 0 1)) (substring name 1)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1081 (let* ((completion-ignore-case t)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1082 (value (completing-read
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1083 (if default
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1084 (format "%s for face `%s' (default %s): "
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1085 name face default)
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1086 (format "%s for face `%s': " name face))
66959
35ab5e34fdf5 (face-read-string): Set the default value arg of completing-read.
Juri Linkov <juri@jurta.org>
parents: 66717
diff changeset
1087 completion-alist nil nil nil nil default)))
25245
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
1088 (if (equal value "") default value)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1089
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1090
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1091 (defun face-read-integer (face default name)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1092 "Interactively read an integer face attribute value.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1093 FACE is the face whose attribute is read. DEFAULT is the default
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1094 value to return if no new value is entered. NAME is a descriptive
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1095 name of the attribute for prompting. Value is the new attribute value."
25245
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
1096 (let ((new-value
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
1097 (face-read-string face
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1098 (format "%s" default)
25245
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
1099 name
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
1100 (list (cons "unspecified" 'unspecified)))))
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1101 (cond ((equal new-value "unspecified")
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1102 'unspecified)
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1103 ((member new-value '("unspecified-fg" "unspecified-bg"))
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1104 new-value)
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1105 (t
62402
a7e02ef1e3d6 Replace `string-to-int' by `string-to-number'.
Juanma Barranquero <lekktu@gmail.com>
parents: 62386
diff changeset
1106 (string-to-number new-value)))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1107
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1108
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1109 (defun read-face-attribute (face attribute &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1110 "Interactively read a new value for FACE's ATTRIBUTE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1111 Optional argument FRAME nil or unspecified means read an attribute value
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1112 of a global face. Value is the new attribute value."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1113 (let* ((old-value (face-attribute face attribute frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1114 (attribute-name (face-descriptive-attribute-name attribute))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1115 (valid (face-valid-attribute-values attribute frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1116 new-value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1117 ;; Represent complex attribute values as strings by printing them
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1118 ;; out. Stipple can be a vector; (WIDTH HEIGHT DATA). Box can be
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1119 ;; a list `(:width WIDTH :color COLOR)' or `(:width WIDTH :shadow
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1120 ;; SHADOW)'.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1121 (when (and (or (eq attribute :stipple)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1122 (eq attribute :box))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1123 (or (consp old-value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1124 (vectorp old-value)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1125 (setq old-value (prin1-to-string old-value)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1126 (cond ((listp valid)
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1127 (let ((default
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1128 (or (car (rassoc old-value valid))
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1129 (format "%s" old-value))))
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1130 (setq new-value
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1131 (face-read-string face default attribute-name valid))
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1132 (if (equal new-value default)
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1133 ;; Nothing changed, so don't bother with all the stuff
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1134 ;; below. In particular, this avoids a non-tty color
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1135 ;; from being canonicalized for a tty when the user
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1136 ;; just uses the default.
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1137 (setq new-value old-value)
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1138 ;; Terminal frames can support colors that don't appear
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1139 ;; explicitly in VALID, using color approximation code
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1140 ;; in tty-colors.el.
34585
1e66e14d9695 (read-face-attribute): If there's no entry for the user's input in
Miles Bader <miles@gnu.org>
parents: 34246
diff changeset
1141 (when (and (memq attribute '(:foreground :background))
97043
9592c50233ab Remove support for Mac Carbon.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 96675
diff changeset
1142 (not (memq (window-system frame) '(x w32 ns)))
34585
1e66e14d9695 (read-face-attribute): If there's no entry for the user's input in
Miles Bader <miles@gnu.org>
parents: 34246
diff changeset
1143 (not (member new-value
1e66e14d9695 (read-face-attribute): If there's no entry for the user's input in
Miles Bader <miles@gnu.org>
parents: 34246
diff changeset
1144 '("unspecified"
1e66e14d9695 (read-face-attribute): If there's no entry for the user's input in
Miles Bader <miles@gnu.org>
parents: 34246
diff changeset
1145 "unspecified-fg" "unspecified-bg"))))
34587
Miles Bader <miles@gnu.org>
parents: 34585
diff changeset
1146 (setq new-value (car (tty-color-desc new-value frame))))
34585
1e66e14d9695 (read-face-attribute): If there's no entry for the user's input in
Miles Bader <miles@gnu.org>
parents: 34246
diff changeset
1147 (when (assoc new-value valid)
1e66e14d9695 (read-face-attribute): If there's no entry for the user's input in
Miles Bader <miles@gnu.org>
parents: 34246
diff changeset
1148 (setq new-value (cdr (assoc new-value valid)))))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1149 ((eq valid 'integerp)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1150 (setq new-value (face-read-integer face old-value attribute-name)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1151 (t (error "Internal error")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1152 ;; Convert stipple and box value text we read back to a list or
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1153 ;; vector if it looks like one. This makes the assumption that a
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1154 ;; pixmap file name won't start with an open-paren.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1155 (when (and (or (eq attribute :stipple)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1156 (eq attribute :box))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1157 (stringp new-value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1158 (string-match "^[[(]" new-value))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1159 (setq new-value (read new-value)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1160 new-value))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1161
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1162 (declare-function fontset-list "fontset.c" ())
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1163 (declare-function x-list-fonts "xfaces.c"
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1164 (pattern &optional face frame maximum width))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1165
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1166 (defun read-face-font (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1167 "Read the name of a font for FACE on FRAME.
64539
c94d5f576885 (describe-face): "?\ " -> "?\s".
Juanma Barranquero <lekktu@gmail.com>
parents: 64497
diff changeset
1168 If optional argument FRAME is nil or omitted, use the selected frame."
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1169 (let ((completion-ignore-case t))
31197
39d437913f44 (read-face-font, read-face-and-attribute): Tweak prompts.
Miles Bader <miles@gnu.org>
parents: 31193
diff changeset
1170 (completing-read (format "Set font attributes of face `%s' from font: " face)
89909
68c22ea6027c Sync to HEAD
Kenichi Handa <handa@m17n.org>
parents: 89678
diff changeset
1171 (append (fontset-list) (x-list-fonts "*" nil frame)))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1172
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1173
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1174 (defun read-all-face-attributes (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1175 "Interactively read all attributes for FACE.
64539
c94d5f576885 (describe-face): "?\ " -> "?\s".
Juanma Barranquero <lekktu@gmail.com>
parents: 64497
diff changeset
1176 If optional argument FRAME is nil or omitted, use the selected frame.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1177 Value is a property list of attribute names and new values."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1178 (let (result)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1179 (dolist (attribute face-attribute-name-alist result)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1180 (setq result (cons (car attribute)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1181 (cons (read-face-attribute face (car attribute) frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1182 result))))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1183
37467
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1184 (defun modify-face (&optional face foreground background stipple
75591
a0f90fb2d33d (set-face-underline-p, modify-face): Rename arg UNDERLINE-P
Juanma Barranquero <lekktu@gmail.com>
parents: 75579
diff changeset
1185 bold-p italic-p underline inverse-p frame)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1186 "Modify attributes of faces interactively.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1187 If optional argument FRAME is nil or omitted, modify the face used
37467
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1188 for newly created frame, i.e. the global face.
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1189 For non-interactive use, `set-face-attribute' is preferred.
64539
c94d5f576885 (describe-face): "?\ " -> "?\s".
Juanma Barranquero <lekktu@gmail.com>
parents: 64497
diff changeset
1190 When called from Lisp, if FACE is nil, all arguments but FRAME are ignored
37467
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1191 and the face and its settings are obtained by querying the user."
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1192 (interactive)
37467
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1193 (if face
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1194 (set-face-attribute face frame
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1195 :foreground (or foreground 'unspecified)
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1196 :background (or background 'unspecified)
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1197 :stipple stipple
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1198 :bold bold-p
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1199 :italic italic-p
75591
a0f90fb2d33d (set-face-underline-p, modify-face): Rename arg UNDERLINE-P
Juanma Barranquero <lekktu@gmail.com>
parents: 75579
diff changeset
1200 :underline underline
37467
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1201 :inverse-video inverse-p)
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1202 (setq face (read-face-name "Modify face"))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1203 (apply #'set-face-attribute face frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1204 (read-all-face-attributes face frame))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1205
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1206 (defun read-face-and-attribute (attribute &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1207 "Read face name and face attribute value.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1208 ATTRIBUTE is the attribute whose new value is read.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1209 FRAME nil or unspecified means read attribute value of global face.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1210 Value is a list (FACE NEW-VALUE) where FACE is the face read
37467
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1211 \(a symbol), and NEW-VALUE is value read."
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1212 (cond ((eq attribute :font)
31197
39d437913f44 (read-face-font, read-face-and-attribute): Tweak prompts.
Miles Bader <miles@gnu.org>
parents: 31193
diff changeset
1213 (let* ((prompt "Set font-related attributes of face")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1214 (face (read-face-name prompt))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1215 (font (read-face-font face frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1216 (list face font)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1217 (t
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1218 (let* ((attribute-name (face-descriptive-attribute-name attribute))
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1219 (prompt (format "Set %s of face" attribute-name))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1220 (face (read-face-name prompt))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1221 (new-value (read-face-attribute face attribute frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1222 (list face new-value)))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1223
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1224
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1225
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1226 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1227 ;;; Listing faces.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1228 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1229
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1230 (defvar list-faces-sample-text
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1231 "abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ"
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1232 "*Text string to display as the sample text for `list-faces-display'.")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1233
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1234
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1235 ;; The name list-faces would be more consistent, but let's avoid a
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1236 ;; conflict with Lucid, which uses that name differently.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1237
48914
bb52f186fa1e (help-xref-stack): Add defvar to avoid warning.
Richard M. Stallman <rms@gnu.org>
parents: 48713
diff changeset
1238 (defvar help-xref-stack)
59872
d7da3e10bfef (list-faces-display): Add optional argument.
Richard M. Stallman <rms@gnu.org>
parents: 59281
diff changeset
1239 (defun list-faces-display (&optional regexp)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1240 "List all faces, using the same sample text in each.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1241 The sample text is a string that comes from the variable
59872
d7da3e10bfef (list-faces-display): Add optional argument.
Richard M. Stallman <rms@gnu.org>
parents: 59281
diff changeset
1242 `list-faces-sample-text'.
d7da3e10bfef (list-faces-display): Add optional argument.
Richard M. Stallman <rms@gnu.org>
parents: 59281
diff changeset
1243
d7da3e10bfef (list-faces-display): Add optional argument.
Richard M. Stallman <rms@gnu.org>
parents: 59281
diff changeset
1244 If REGEXP is non-nil, list only those faces with names matching
d7da3e10bfef (list-faces-display): Add optional argument.
Richard M. Stallman <rms@gnu.org>
parents: 59281
diff changeset
1245 this regular expression. When called interactively with a prefix
d7da3e10bfef (list-faces-display): Add optional argument.
Richard M. Stallman <rms@gnu.org>
parents: 59281
diff changeset
1246 arg, prompt for a regular expression."
d7da3e10bfef (list-faces-display): Add optional argument.
Richard M. Stallman <rms@gnu.org>
parents: 59281
diff changeset
1247 (interactive (list (and current-prefix-arg
96435
414b3d1e76df (face-name-history): New variable.
Juri Linkov <juri@jurta.org>
parents: 96398
diff changeset
1248 (read-regexp "List faces matching regexp"))))
62947
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1249 (let ((all-faces (zerop (length regexp)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1250 (frame (selected-frame))
62947
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1251 (max-length 0)
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1252 faces line-format
27716
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1253 disp-frame window face-name)
62947
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1254 ;; We filter and take the max length in one pass
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1255 (setq faces
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1256 (delq nil
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1257 (mapcar (lambda (f)
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1258 (let ((s (symbol-name f)))
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1259 (when (or all-faces (string-match regexp s))
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1260 (setq max-length (max (length s) max-length))
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1261 f)))
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1262 (sort (face-list) #'string-lessp))))
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1263 (unless faces
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1264 (error "No faces matching \"%s\"" regexp))
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1265 (setq max-length (1+ max-length)
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1266 line-format (format "%%-%ds" max-length))
86010
d42c1cd75af4 (list-faces-display, describe-face):
Martin Rudalics <rudalics@gmx.at>
parents: 85996
diff changeset
1267 (with-help-window "*Faces*"
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1268 (save-excursion
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1269 (set-buffer standard-output)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1270 (setq truncate-lines t)
27716
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1271 (insert
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1272 (substitute-command-keys
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1273 (concat
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1274 "Use "
27736
b4d0a1247b35 (list-faces-display): Use display-mouse-p, not window-system.
Eli Zaretskii <eliz@gnu.org>
parents: 27716
diff changeset
1275 (if (display-mouse-p) "\\[help-follow-mouse] or ")
27831
05cce359cbf0 (list-faces-display): Fix header typo.
Dave Love <fx@gnu.org>
parents: 27736
diff changeset
1276 "\\[help-follow] on a face name to customize it\n"
43550
fc7733c201af (list-faces-display): Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents: 43392
diff changeset
1277 "or on its sample text for a description of the face.\n\n")))
27716
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1278 (setq help-xref-stack nil)
59872
d7da3e10bfef (list-faces-display): Add optional argument.
Richard M. Stallman <rms@gnu.org>
parents: 59281
diff changeset
1279 (dolist (face faces)
27716
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1280 (setq face-name (symbol-name face))
62947
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1281 (insert (format line-format face-name))
27716
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1282 ;; Hyperlink to a customization buffer for the face. Using
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1283 ;; the help xref mechanism may not be the best way.
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1284 (save-excursion
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1285 (save-match-data
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1286 (search-backward face-name)
62534
bf6a0cd0e835 (list-faces-display): Make back button respect optional regexp arg.
Nick Roberts <nickrob@snap.net.nz>
parents: 62498
diff changeset
1287 (setq help-xref-stack-item `(list-faces-display ,regexp))
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1288 (help-xref-button 0 'help-customize-face face)))
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1289 (let ((beg (point))
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1290 (line-beg (line-beginning-position)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1291 (insert list-faces-sample-text)
27716
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1292 ;; Hyperlink to a help buffer for the face.
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1293 (save-excursion
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1294 (save-match-data
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1295 (search-backward list-faces-sample-text)
39799
99f30ac48ec0 (list-faces-display, describe-face): Fix args to `help-xref-button'.
Miles Bader <miles@gnu.org>
parents: 39549
diff changeset
1296 (help-xref-button 0 'help-face face)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1297 (insert "\n")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1298 (put-text-property beg (1- (point)) 'face face)
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1299 ;; Make all face commands default to the proper face
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1300 ;; anywhere in the line.
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1301 (put-text-property line-beg (1- (point)) 'read-face-name face)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1302 ;; If the sample text has multiple lines, line up all of them.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1303 (goto-char beg)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1304 (forward-line 1)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1305 (while (not (eobp))
62947
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1306 (insert-char ?\s max-length)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1307 (forward-line 1))))
86010
d42c1cd75af4 (list-faces-display, describe-face):
Martin Rudalics <rudalics@gmx.at>
parents: 85996
diff changeset
1308 (goto-char (point-min))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1309 ;; If the *Faces* buffer appears in a different frame,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1310 ;; copy all the face definitions from FRAME,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1311 ;; so that the display will reflect the frame that was selected.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1312 (setq window (get-buffer-window (get-buffer "*Faces*") t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1313 (setq disp-frame (if window (window-frame window)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1314 (car (frame-list))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1315 (or (eq frame disp-frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1316 (let ((faces (face-list)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1317 (while faces
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1318 (copy-face (car faces) (car faces) frame disp-frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1319 (setq faces (cdr faces)))))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1320
59872
d7da3e10bfef (list-faces-display): Add optional argument.
Richard M. Stallman <rms@gnu.org>
parents: 59281
diff changeset
1321
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1322 (defun describe-face (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1323 "Display the properties of face FACE on FRAME.
45314
d752ae89321a (describe-face): Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents: 45255
diff changeset
1324 Interactively, FACE defaults to the faces of the character after point
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1325 and FRAME defaults to the selected frame.
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1326
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1327 If the optional argument FRAME is given, report on face FACE in that frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1328 If FRAME is t, report on the defaults for face FACE (for new frames).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1329 If FRAME is omitted or nil, use the selected frame."
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1330 (interactive (list (read-face-name "Describe face" "= `default' face" t)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1331 (let* ((attrs '((:family . "Family")
95862
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
1332 (:foundry . "Foundry")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1333 (:width . "Width")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1334 (:height . "Height")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1335 (:weight . "Weight")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1336 (:slant . "Slant")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1337 (:foreground . "Foreground")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1338 (:background . "Background")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1339 (:underline . "Underline")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1340 (:overline . "Overline")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1341 (:strike-through . "Strike-through")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1342 (:box . "Box")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1343 (:inverse-video . "Inverse")
28214
73c16c6e401e (read-face-font): Fix TABLE arg to completing-read.
Kenichi Handa <handa@m17n.org>
parents: 27928
diff changeset
1344 (:stipple . "Stipple")
89129
ed1d9d1cfc71 (describe-face): Describe :fontset property too.
Kenichi Handa <handa@m17n.org>
parents: 43550
diff changeset
1345 (:font . "Font")
ed1d9d1cfc71 (describe-face): Describe :fontset property too.
Kenichi Handa <handa@m17n.org>
parents: 43550
diff changeset
1346 (:fontset . "Fontset")
31179
354c781f2864 (describe-face): Add support for :inherit attribute.
Miles Bader <miles@gnu.org>
parents: 30971
diff changeset
1347 (:inherit . "Inherit")))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1348 (max-width (apply #'max (mapcar #'(lambda (x) (length (cdr x)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1349 attrs))))
39830
aed9c3afb7ed (describe-face): Call help-setup-xref earlier.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39799
diff changeset
1350 (help-setup-xref (list #'describe-face face) (interactive-p))
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1351 (unless face
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1352 (setq face 'default))
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1353 (if (not (listp face))
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1354 (setq face (list face)))
86010
d42c1cd75af4 (list-faces-display, describe-face):
Martin Rudalics <rudalics@gmx.at>
parents: 85996
diff changeset
1355 (with-help-window (help-buffer)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1356 (save-excursion
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1357 (set-buffer standard-output)
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1358 (dolist (f face)
85297
01f68ac2fb98 (describe-face): Allow handling a string as the face name.
Juri Linkov <juri@jurta.org>
parents: 85272
diff changeset
1359 (if (stringp f) (setq f (intern f)))
101128
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1360 ;; We may get called for anonymous faces (i.e., faces
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1361 ;; expressed using prop-value plists). Those can't be
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1362 ;; usefully customized, so ignore them.
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1363 (when (symbolp f)
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1364 (insert "Face: " (symbol-name f))
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1365 (if (not (facep f))
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1366 (insert " undefined face.\n")
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1367 (let ((customize-label "customize this face")
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1368 file-name)
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1369 (insert (concat " (" (propertize "sample" 'font-lock-face f) ")"))
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1370 (princ (concat " (" customize-label ")\n"))
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1371 (insert "Documentation: "
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1372 (or (face-documentation f)
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1373 "Not documented as a face.")
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1374 "\n")
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1375 (with-current-buffer standard-output
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1376 (save-excursion
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1377 (re-search-backward
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1378 (concat "\\(" customize-label "\\)") nil t)
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1379 (help-xref-button 1 'help-customize-face f)))
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1380 (setq file-name (find-lisp-object-file-name f 'defface))
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1381 (when file-name
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1382 (princ "Defined in `")
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1383 (princ (file-name-nondirectory file-name))
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1384 (princ "'")
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1385 ;; Make a hyperlink to the library.
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1386 (save-excursion
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1387 (re-search-backward "`\\([^`']+\\)'" nil t)
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1388 (help-xref-button 1 'help-face-def f file-name))
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1389 (princ ".")
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1390 (terpri)
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1391 (terpri))
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1392 (dolist (a attrs)
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1393 (let ((attr (face-attribute f (car a) frame)))
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1394 (insert (make-string (- max-width (length (cdr a))) ?\s)
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1395 (cdr a) ": " (format "%s" attr))
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1396 (if (and (eq (car a) :inherit)
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1397 (not (eq attr 'unspecified)))
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1398 ;; Make a hyperlink to the parent face.
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1399 (save-excursion
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1400 (re-search-backward ": \\([^:]+\\)" nil t)
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1401 (help-xref-button 1 'help-face attr)))
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1402 (insert "\n")))))
311f898c790b (describe-face): Ignore anonymous faces.
Chong Yidong <cyd@stupidchicken.com>
parents: 101054
diff changeset
1403 (terpri)))))))
39799
99f30ac48ec0 (list-faces-display, describe-face): Fix args to `help-xref-button'.
Miles Bader <miles@gnu.org>
parents: 39549
diff changeset
1404
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1405
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1406 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1407 ;;; Face specifications (defface).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1408 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1409
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1410 ;; Parameter FRAME Is kept for call compatibility to with previous
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1411 ;; face implementation.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1412
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1413 (defun face-attr-construct (face &optional frame)
64539
c94d5f576885 (describe-face): "?\ " -> "?\s".
Juanma Barranquero <lekktu@gmail.com>
parents: 64497
diff changeset
1414 "Return a `defface'-style attribute list for FACE on FRAME.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1415 Value is a property list of pairs ATTRIBUTE VALUE for all specified
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1416 face attributes of FACE where ATTRIBUTE is the attribute name and
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1417 VALUE is the specified value of that attribute."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1418 (let (result)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1419 (dolist (entry face-attribute-name-alist result)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1420 (let* ((attribute (car entry))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1421 (value (face-attribute face attribute)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1422 (unless (eq value 'unspecified)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1423 (setq result (nconc (list attribute value) result)))))))
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1424
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1425
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1426 (defun face-spec-set-match-display (display frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1427 "Non-nil if DISPLAY matches FRAME.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1428 DISPLAY is part of a spec such as can be used in `defface'.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1429 If FRAME is nil, the current FRAME is used."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1430 (let* ((conjuncts display)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1431 conjunct req options
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1432 ;; t means we have succeeded against all the conjuncts in
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1433 ;; DISPLAY that have been tested so far.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1434 (match t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1435 (if (eq conjuncts t)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1436 (setq conjuncts nil))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1437 (while (and conjuncts match)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1438 (setq conjunct (car conjuncts)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1439 conjuncts (cdr conjuncts)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1440 req (car conjunct)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1441 options (cdr conjunct)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1442 match (cond ((eq req 'type)
83004
7900111db01c Converted display hooks to be display-local. Plus many bugfixes.
Karoly Lorentey <lorentey@elte.hu>
parents: 52401
diff changeset
1443 (or (memq (window-system frame) options)
33447
45961172564e (face-spec-set-match-display): Revert the change from
Eli Zaretskii <eliz@gnu.org>
parents: 33419
diff changeset
1444 ;; FIXME: This should be revisited to use
45961172564e (face-spec-set-match-display): Revert the change from
Eli Zaretskii <eliz@gnu.org>
parents: 33419
diff changeset
1445 ;; display-graphic-p, provided that the
45961172564e (face-spec-set-match-display): Revert the change from
Eli Zaretskii <eliz@gnu.org>
parents: 33419
diff changeset
1446 ;; color selection depends on the number
45961172564e (face-spec-set-match-display): Revert the change from
Eli Zaretskii <eliz@gnu.org>
parents: 33419
diff changeset
1447 ;; of supported colors, and all defface's
45961172564e (face-spec-set-match-display): Revert the change from
Eli Zaretskii <eliz@gnu.org>
parents: 33419
diff changeset
1448 ;; are changed to look at number of colors
45961172564e (face-spec-set-match-display): Revert the change from
Eli Zaretskii <eliz@gnu.org>
parents: 33419
diff changeset
1449 ;; instead of (type graphic) etc.
83004
7900111db01c Converted display hooks to be display-local. Plus many bugfixes.
Karoly Lorentey <lorentey@elte.hu>
parents: 52401
diff changeset
1450 (and (null (window-system frame))
33447
45961172564e (face-spec-set-match-display): Revert the change from
Eli Zaretskii <eliz@gnu.org>
parents: 33419
diff changeset
1451 (memq 'tty options))
25887
099a3776ff00 (face-spec-set-match-display): Recognize `type' of
Gerd Moellmann <gerd@gnu.org>
parents: 25814
diff changeset
1452 (and (memq 'motif options)
099a3776ff00 (face-spec-set-match-display): Recognize `type' of
Gerd Moellmann <gerd@gnu.org>
parents: 25814
diff changeset
1453 (featurep 'motif))
55545
70c4138d3b8d * custom.el (defface): Document that type can have value gtk.
Jan Djärv <jan.h.d@swipnet.se>
parents: 54574
diff changeset
1454 (and (memq 'gtk options)
70c4138d3b8d * custom.el (defface): Document that type can have value gtk.
Jan Djärv <jan.h.d@swipnet.se>
parents: 54574
diff changeset
1455 (featurep 'gtk))
25887
099a3776ff00 (face-spec-set-match-display): Recognize `type' of
Gerd Moellmann <gerd@gnu.org>
parents: 25814
diff changeset
1456 (and (memq 'lucid options)
099a3776ff00 (face-spec-set-match-display): Recognize `type' of
Gerd Moellmann <gerd@gnu.org>
parents: 25814
diff changeset
1457 (featurep 'x-toolkit)
55545
70c4138d3b8d * custom.el (defface): Document that type can have value gtk.
Jan Djärv <jan.h.d@swipnet.se>
parents: 54574
diff changeset
1458 (not (featurep 'motif))
70c4138d3b8d * custom.el (defface): Document that type can have value gtk.
Jan Djärv <jan.h.d@swipnet.se>
parents: 54574
diff changeset
1459 (not (featurep 'gtk)))
25887
099a3776ff00 (face-spec-set-match-display): Recognize `type' of
Gerd Moellmann <gerd@gnu.org>
parents: 25814
diff changeset
1460 (and (memq 'x-toolkit options)
099a3776ff00 (face-spec-set-match-display): Recognize `type' of
Gerd Moellmann <gerd@gnu.org>
parents: 25814
diff changeset
1461 (featurep 'x-toolkit))))
54151
9a5c3b661a40 (face-spec-set-match-display): Add a new attribute, `min-colors'.
Eli Zaretskii <eliz@gnu.org>
parents: 52401
diff changeset
1462 ((eq req 'min-colors)
9a5c3b661a40 (face-spec-set-match-display): Add a new attribute, `min-colors'.
Eli Zaretskii <eliz@gnu.org>
parents: 52401
diff changeset
1463 (>= (display-color-cells frame) (car options)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1464 ((eq req 'class)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1465 (memq (frame-parameter frame 'display-type) options))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1466 ((eq req 'background)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1467 (memq (frame-parameter frame 'background-mode)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1468 options))
45722
c553d91619aa (display-supports-face-attributes-p): Work correctly if DISPLAY is a frame.
Miles Bader <miles@gnu.org>
parents: 45717
diff changeset
1469 ((eq req 'supports)
c553d91619aa (display-supports-face-attributes-p): Work correctly if DISPLAY is a frame.
Miles Bader <miles@gnu.org>
parents: 45717
diff changeset
1470 (display-supports-face-attributes-p options frame))
28840
d0531e35d9f2 Some doc fixes.
Dave Love <fx@gnu.org>
parents: 28214
diff changeset
1471 (t (error "Unknown req `%S' with options `%S'"
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1472 req options)))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1473 match))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1474
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1475
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1476 (defun face-spec-choose (spec &optional frame)
32758
a0ca98ed466a (face-user-default-spec, face-default-spec): New functions.
Miles Bader <miles@gnu.org>
parents: 32756
diff changeset
1477 "Choose the proper attributes for FRAME, out of SPEC.
a0ca98ed466a (face-user-default-spec, face-default-spec): New functions.
Miles Bader <miles@gnu.org>
parents: 32756
diff changeset
1478 If SPEC is nil, return nil."
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1479 (unless frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1480 (setq frame (selected-frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1481 (let ((tail spec)
58935
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1482 result defaults)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1483 (while tail
32940
80681aca0859 (face-spec-choose): Change syntax so that the list of attribute-value
Miles Bader <miles@gnu.org>
parents: 32801
diff changeset
1484 (let* ((entry (pop tail))
80681aca0859 (face-spec-choose): Change syntax so that the list of attribute-value
Miles Bader <miles@gnu.org>
parents: 32801
diff changeset
1485 (display (car entry))
58935
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1486 (attrs (cdr entry))
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1487 thisval)
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1488 ;; Get the attributes as actually specified by this alternative.
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1489 (setq thisval
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1490 (if (null (cdr attrs)) ;; was (listp (car attrs))
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1491 ;; Old-style entry, the attribute list is the
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1492 ;; first element.
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1493 (car attrs)
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1494 attrs))
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1495
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1496 ;; If the condition is `default', that sets the default
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1497 ;; for following conditions.
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1498 (if (eq display 'default)
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1499 (setq defaults thisval)
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1500 ;; Otherwise, if it matches, use it.
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1501 (when (face-spec-set-match-display display frame)
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1502 (setq result thisval)
43711
d15360503e4e (face-spec-choose): Allow `t' to appear before the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43550
diff changeset
1503 (setq tail nil)))))
58935
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1504 (if defaults (append result defaults) result)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1505
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1506
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1507 (defun face-spec-reset-face (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1508 "Reset all attributes of FACE on FRAME to unspecified."
31401
0b8165a82e34 (set-face-attribute, face-spec-reset-face)
Gerd Moellmann <gerd@gnu.org>
parents: 31197
diff changeset
1509 (let ((attrs face-attribute-name-alist))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1510 (while attrs
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1511 (let ((attr-and-name (car attrs)))
31401
0b8165a82e34 (set-face-attribute, face-spec-reset-face)
Gerd Moellmann <gerd@gnu.org>
parents: 31197
diff changeset
1512 (set-face-attribute face frame (car attr-and-name) 'unspecified))
0b8165a82e34 (set-face-attribute, face-spec-reset-face)
Gerd Moellmann <gerd@gnu.org>
parents: 31197
diff changeset
1513 (setq attrs (cdr attrs)))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1514
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1515
87483
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1516 (defun face-spec-set (face spec &optional for-defface)
92446
43421f91b96e (face-spec-set): Fix typos in docstring.
Juanma Barranquero <lekktu@gmail.com>
parents: 92115
diff changeset
1517 "Set FACE's face spec, which controls its appearance, to SPEC.
87483
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1518 If FOR-DEFFACE is t, set the base spec, the one that `defface'
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1519 and Custom set. (In that case, the caller must put it in the
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1520 appropriate property, because that depends on the caller.)
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1521 If FOR-DEFFACE is nil, set the overriding spec (and store it
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1522 in the `face-override-spec' property of FACE).
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1523
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1524 The appearance of FACE is controlled by the base spec,
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1525 by any custom theme specs on top of that, and by the
92446
43421f91b96e (face-spec-set): Fix typos in docstring.
Juanma Barranquero <lekktu@gmail.com>
parents: 92115
diff changeset
1526 overriding spec on top of all the rest.
87483
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1527
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1528 FOR-DEFFACE can also be a frame, in which case we set the
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1529 frame-specific attributes of FACE for that frame based on SPEC.
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1530 That usage is deprecated.
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1531
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1532 See `defface' for information about the format and meaning of SPEC."
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1533 (if (framep for-defface)
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1534 ;; Handle the deprecated case where third arg is a frame.
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1535 (face-spec-set-2 face for-defface spec)
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1536 (if for-defface
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1537 ;; When we reset the face based on its custom spec, then it is
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1538 ;; unmodified as far as Custom is concerned.
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1539 (put (or (get face 'face-alias) face) 'face-modified nil)
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1540 ;; When we change a face based on a spec from outside custom,
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1541 ;; record it for future frames.
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1542 (put (or (get face 'face-alias) face) 'face-override-spec spec))
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1543 ;; Reset each frame according to the rules implied by all its specs.
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1544 (dolist (frame (frame-list))
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1545 (face-spec-recalc face frame))))
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1546
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1547 (defun face-spec-recalc (face frame)
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1548 "Reset the face attributes of FACE on FRAME according to its specs.
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1549 This applies the defface/custom spec first, then the custom theme specs,
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1550 then the override spec."
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1551 (face-spec-reset-face face frame)
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1552 (let ((face-sym (or (get face 'face-alias) face)))
95787
09e6bd8a641a (face-spec-recalc): When the face is set using Customize, avoid
Chong Yidong <cyd@stupidchicken.com>
parents: 95184
diff changeset
1553 (or (get face 'customized-face)
09e6bd8a641a (face-spec-recalc): When the face is set using Customize, avoid
Chong Yidong <cyd@stupidchicken.com>
parents: 95184
diff changeset
1554 (get face 'saved-face)
09e6bd8a641a (face-spec-recalc): When the face is set using Customize, avoid
Chong Yidong <cyd@stupidchicken.com>
parents: 95184
diff changeset
1555 (face-spec-set-2 face frame (face-default-spec face)))
87483
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1556 (let ((theme-faces (reverse (get face-sym 'theme-face))))
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1557 (dolist (spec theme-faces)
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1558 (face-spec-set-2 face frame (cadr spec))))
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1559 (face-spec-set-2 face frame (get face-sym 'face-override-spec))))
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1560
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1561 (defun face-spec-set-2 (face frame spec)
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1562 "Set the face attributes of FACE on FRAME according to SPEC."
98801
72d21af5dec4 (face-spec-set-2): Don't pass invalid attributes to set-face-attribute.
Chong Yidong <cyd@stupidchicken.com>
parents: 98728
diff changeset
1563 (let* ((spec (face-spec-choose spec frame))
72d21af5dec4 (face-spec-set-2): Don't pass invalid attributes to set-face-attribute.
Chong Yidong <cyd@stupidchicken.com>
parents: 98728
diff changeset
1564 attrs)
72d21af5dec4 (face-spec-set-2): Don't pass invalid attributes to set-face-attribute.
Chong Yidong <cyd@stupidchicken.com>
parents: 98728
diff changeset
1565 (while spec
72d21af5dec4 (face-spec-set-2): Don't pass invalid attributes to set-face-attribute.
Chong Yidong <cyd@stupidchicken.com>
parents: 98728
diff changeset
1566 (when (assq (car spec) face-x-resources)
72d21af5dec4 (face-spec-set-2): Don't pass invalid attributes to set-face-attribute.
Chong Yidong <cyd@stupidchicken.com>
parents: 98728
diff changeset
1567 (push (car spec) attrs)
72d21af5dec4 (face-spec-set-2): Don't pass invalid attributes to set-face-attribute.
Chong Yidong <cyd@stupidchicken.com>
parents: 98728
diff changeset
1568 (push (cadr spec) attrs))
72d21af5dec4 (face-spec-set-2): Don't pass invalid attributes to set-face-attribute.
Chong Yidong <cyd@stupidchicken.com>
parents: 98728
diff changeset
1569 (setq spec (cddr spec)))
72d21af5dec4 (face-spec-set-2): Don't pass invalid attributes to set-face-attribute.
Chong Yidong <cyd@stupidchicken.com>
parents: 98728
diff changeset
1570 (apply 'set-face-attribute face frame (nreverse attrs))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1571
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1572 (defun face-attr-match-p (face attrs &optional frame)
30971
9a23751378f3 (face-attr-match-p):
Miles Bader <miles@gnu.org>
parents: 30306
diff changeset
1573 "Return t if attributes of FACE match values in plist ATTRS.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1574 Optional parameter FRAME is the frame whose definition of FACE
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1575 is used. If nil or omitted, use the selected frame."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1576 (unless frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1577 (setq frame (selected-frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1578 (let ((list face-attribute-name-alist)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1579 (match t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1580 (while (and match (not (null list)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1581 (let* ((attr (car (car list)))
30971
9a23751378f3 (face-attr-match-p):
Miles Bader <miles@gnu.org>
parents: 30306
diff changeset
1582 (specified-value
9a23751378f3 (face-attr-match-p):
Miles Bader <miles@gnu.org>
parents: 30306
diff changeset
1583 (if (plist-member attrs attr)
9a23751378f3 (face-attr-match-p):
Miles Bader <miles@gnu.org>
parents: 30306
diff changeset
1584 (plist-get attrs attr)
9a23751378f3 (face-attr-match-p):
Miles Bader <miles@gnu.org>
parents: 30306
diff changeset
1585 'unspecified))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1586 (value-now (face-attribute face attr frame)))
30971
9a23751378f3 (face-attr-match-p):
Miles Bader <miles@gnu.org>
parents: 30306
diff changeset
1587 (setq match (equal specified-value value-now))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1588 (setq list (cdr list))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1589 match))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1590
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1591 (defun face-spec-match-p (face spec &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1592 "Return t if FACE, on FRAME, matches what SPEC says it should look like."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1593 (face-attr-match-p face (face-spec-choose spec frame) frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1594
32795
975cc2648ee4 (face-default-spec, face-user-default-spec): Make defsubsts.
Miles Bader <miles@gnu.org>
parents: 32758
diff changeset
1595 (defsubst face-default-spec (face)
975cc2648ee4 (face-default-spec, face-user-default-spec): Make defsubsts.
Miles Bader <miles@gnu.org>
parents: 32758
diff changeset
1596 "Return the default face-spec for FACE, ignoring any user customization.
975cc2648ee4 (face-default-spec, face-user-default-spec): Make defsubsts.
Miles Bader <miles@gnu.org>
parents: 32758
diff changeset
1597 If there is no default for FACE, return nil."
975cc2648ee4 (face-default-spec, face-user-default-spec): Make defsubsts.
Miles Bader <miles@gnu.org>
parents: 32758
diff changeset
1598 (get face 'face-defface-spec))
975cc2648ee4 (face-default-spec, face-user-default-spec): Make defsubsts.
Miles Bader <miles@gnu.org>
parents: 32758
diff changeset
1599
975cc2648ee4 (face-default-spec, face-user-default-spec): Make defsubsts.
Miles Bader <miles@gnu.org>
parents: 32758
diff changeset
1600 (defsubst face-user-default-spec (face)
32758
a0ca98ed466a (face-user-default-spec, face-default-spec): New functions.
Miles Bader <miles@gnu.org>
parents: 32756
diff changeset
1601 "Return the user's customized face-spec for FACE, or the default if none.
37467
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1602 If there is neither a user setting nor a default for FACE, return nil."
63637
de897c139738 (face-user-default-spec): Try getting `customized-face' prior to `saved-face'.
Juri Linkov <juri@jurta.org>
parents: 63594
diff changeset
1603 (or (get face 'customized-face)
de897c139738 (face-user-default-spec): Try getting `customized-face' prior to `saved-face'.
Juri Linkov <juri@jurta.org>
parents: 63594
diff changeset
1604 (get face 'saved-face)
32795
975cc2648ee4 (face-default-spec, face-user-default-spec): Make defsubsts.
Miles Bader <miles@gnu.org>
parents: 32758
diff changeset
1605 (face-default-spec face)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1606
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1607
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1608 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26736
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1609 ;;; Frame-type independent color support.
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1610 ;;; We keep the old x-* names as aliases for back-compatibility.
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1611 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1612
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1613 (defun defined-colors (&optional frame)
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1614 "Return a list of colors supported for a particular frame.
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1615 The argument FRAME specifies which frame to try.
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1616 The value may be different for frames on different display types.
71231
f91f3db3c52a (defined-colors): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 70178
diff changeset
1617 If FRAME doesn't support colors, the value is nil.
f91f3db3c52a (defined-colors): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 70178
diff changeset
1618 If FRAME is nil, that stands for the selected frame."
97043
9592c50233ab Remove support for Mac Carbon.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 96675
diff changeset
1619 (if (memq (framep (or frame (selected-frame))) '(x w32 ns))
26736
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1620 (xw-defined-colors frame)
27090
52e469fb402a (read-face-attribute, defined-colors, color-defined-p):
Eli Zaretskii <eliz@gnu.org>
parents: 26927
diff changeset
1621 (mapcar 'car (tty-color-alist frame))))
26736
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1622 (defalias 'x-defined-colors 'defined-colors)
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1623
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1624 (declare-function xw-color-defined-p "xfns.c" (color &optional frame))
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1625
26736
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1626 (defun color-defined-p (color &optional frame)
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1627 "Return non-nil if color COLOR is supported on frame FRAME.
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1628 If FRAME is omitted or nil, use the selected frame.
27117
6838a53d4992 (face-read-integer, read-face-attribute)
Eli Zaretskii <eliz@gnu.org>
parents: 27090
diff changeset
1629 If COLOR is the symbol `unspecified' or one of the strings
6838a53d4992 (face-read-integer, read-face-attribute)
Eli Zaretskii <eliz@gnu.org>
parents: 27090
diff changeset
1630 \"unspecified-fg\" or \"unspecified-bg\", the value is nil."
32734
92b46ad86f6a (color-values, color-defined-p): Use `member', not
Miles Bader <miles@gnu.org>
parents: 32649
diff changeset
1631 (if (member color '(unspecified "unspecified-bg" "unspecified-fg"))
26736
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1632 nil
97043
9592c50233ab Remove support for Mac Carbon.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 96675
diff changeset
1633 (if (member (framep (or frame (selected-frame))) '(x w32 ns))
26736
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1634 (xw-color-defined-p color frame)
27090
52e469fb402a (read-face-attribute, defined-colors, color-defined-p):
Eli Zaretskii <eliz@gnu.org>
parents: 26927
diff changeset
1635 (numberp (tty-color-translate color frame)))))
26736
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1636 (defalias 'x-color-defined-p 'color-defined-p)
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1637
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1638 (declare-function xw-color-values "xfns.c" (color &optional frame))
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1639
26736
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1640 (defun color-values (color &optional frame)
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1641 "Return a description of the color named COLOR on frame FRAME.
75884
ab51c2b6faf8 (color-values): Revert changes to docstring from 2007-01-31 and 2000-09-07.
Juanma Barranquero <lekktu@gmail.com>
parents: 75705
diff changeset
1642 The value is a list of integer RGB values--(RED GREEN BLUE).
ab51c2b6faf8 (color-values): Revert changes to docstring from 2007-01-31 and 2000-09-07.
Juanma Barranquero <lekktu@gmail.com>
parents: 75705
diff changeset
1643 These values appear to range from 0 to 65280 or 65535, depending
ab51c2b6faf8 (color-values): Revert changes to docstring from 2007-01-31 and 2000-09-07.
Juanma Barranquero <lekktu@gmail.com>
parents: 75705
diff changeset
1644 on the system; white is \(65280 65280 65280\) or \(65535 65535 65535\).
26736
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1645 If FRAME is omitted or nil, use the selected frame.
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1646 If FRAME cannot display COLOR, the value is nil.
27117
6838a53d4992 (face-read-integer, read-face-attribute)
Eli Zaretskii <eliz@gnu.org>
parents: 27090
diff changeset
1647 If COLOR is the symbol `unspecified' or one of the strings
6838a53d4992 (face-read-integer, read-face-attribute)
Eli Zaretskii <eliz@gnu.org>
parents: 27090
diff changeset
1648 \"unspecified-fg\" or \"unspecified-bg\", the value is nil."
32734
92b46ad86f6a (color-values, color-defined-p): Use `member', not
Miles Bader <miles@gnu.org>
parents: 32649
diff changeset
1649 (if (member color '(unspecified "unspecified-fg" "unspecified-bg"))
26736
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1650 nil
97043
9592c50233ab Remove support for Mac Carbon.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 96675
diff changeset
1651 (if (memq (framep (or frame (selected-frame))) '(x w32 ns))
26736
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1652 (xw-color-values color frame)
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1653 (tty-color-values color frame))))
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1654 (defalias 'x-color-values 'color-values)
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1655
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1656 (declare-function xw-display-color-p "xfns.c" (&optional terminal))
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1657
26736
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1658 (defun display-color-p (&optional display)
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1659 "Return t if DISPLAY supports color.
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1660 The optional argument DISPLAY specifies which display to ask about.
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1661 DISPLAY should be either a frame or a display name (a string).
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1662 If omitted or nil, that stands for the selected frame's display."
97043
9592c50233ab Remove support for Mac Carbon.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 96675
diff changeset
1663 (if (memq (framep-on-display display) '(x w32 ns))
27571
4a4f7f602836 (display-color-p): Use framep-on-display.
Eli Zaretskii <eliz@gnu.org>
parents: 27117
diff changeset
1664 (xw-display-color-p display)
4a4f7f602836 (display-color-p): Use framep-on-display.
Eli Zaretskii <eliz@gnu.org>
parents: 27117
diff changeset
1665 (tty-display-color-p display)))
26736
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1666 (defalias 'x-display-color-p 'display-color-p)
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1667
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1668 (declare-function x-display-grayscale-p "xfns.c" (&optional terminal))
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1669
27571
4a4f7f602836 (display-color-p): Use framep-on-display.
Eli Zaretskii <eliz@gnu.org>
parents: 27117
diff changeset
1670 (defun display-grayscale-p (&optional display)
4a4f7f602836 (display-color-p): Use framep-on-display.
Eli Zaretskii <eliz@gnu.org>
parents: 27117
diff changeset
1671 "Return non-nil if frames on DISPLAY can display shades of gray."
4a4f7f602836 (display-color-p): Use framep-on-display.
Eli Zaretskii <eliz@gnu.org>
parents: 27117
diff changeset
1672 (let ((frame-type (framep-on-display display)))
4a4f7f602836 (display-color-p): Use framep-on-display.
Eli Zaretskii <eliz@gnu.org>
parents: 27117
diff changeset
1673 (cond
97043
9592c50233ab Remove support for Mac Carbon.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 96675
diff changeset
1674 ((memq frame-type '(x w32 ns))
27571
4a4f7f602836 (display-color-p): Use framep-on-display.
Eli Zaretskii <eliz@gnu.org>
parents: 27117
diff changeset
1675 (x-display-grayscale-p display))
4a4f7f602836 (display-color-p): Use framep-on-display.
Eli Zaretskii <eliz@gnu.org>
parents: 27117
diff changeset
1676 (t
4a4f7f602836 (display-color-p): Use framep-on-display.
Eli Zaretskii <eliz@gnu.org>
parents: 27117
diff changeset
1677 (> (tty-color-gray-shades display) 2)))))
4a4f7f602836 (display-color-p): Use framep-on-display.
Eli Zaretskii <eliz@gnu.org>
parents: 27117
diff changeset
1678
85758
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1679 (defun read-color (&optional prompt convert-to-RGB-p allow-empty-name-p msg-p)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1680 "Read a color name or RGB hex value: #RRRRGGGGBBBB.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1681 Completion is available for color names, but not for RGB hex strings.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1682 If the user inputs an RGB hex string, it must have the form
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1683 #XXXXXXXXXXXX or XXXXXXXXXXXX, where each X is a hex digit. The
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1684 number of Xs must be a multiple of 3, with the same number of Xs for
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1685 each of red, green, and blue. The order is red, green, blue.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1686
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1687 In addition to standard color names and RGB hex values, the following
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1688 are available as color candidates. In each case, the corresponding
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1689 color is used.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1690
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1691 * `foreground at point' - foreground under the cursor
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1692 * `background at point' - background under the cursor
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1693
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1694 Checks input to be sure it represents a valid color. If not, raises
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1695 an error (but see exception for empty input with non-nil
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1696 ALLOW-EMPTY-NAME-P).
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1697
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1698 Optional arg PROMPT is the prompt; if nil, uses a default prompt.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1699
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1700 Interactively, or with optional arg CONVERT-TO-RGB-P non-nil, converts
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1701 an input color name to an RGB hex string. Returns the RGB hex string.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1702
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1703 Optional arg ALLOW-EMPTY-NAME-P controls what happens if the user
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1704 enters an empty color name (that is, just hits `RET'). If non-nil,
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1705 then returns an empty color name, \"\". If nil, then raises an error.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1706 Programs must test for \"\" if ALLOW-EMPTY-NAME-P is non-nil. They
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1707 can then perform an appropriate action in case of empty input.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1708
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1709 Interactively, or with optional arg MSG-P non-nil, echoes the color in
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1710 a message."
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1711 (interactive "i\np\ni\np") ; Always convert to RGB interactively.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1712 (let* ((completion-ignore-case t)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1713 (colors (append '("foreground at point" "background at point")
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1714 (defined-colors)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1715 (color (completing-read (or prompt "Color (name or #R+G+B+): ")
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1716 colors))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1717 hex-string)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1718 (cond ((string= "foreground at point" color)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1719 (setq color (foreground-color-at-point)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1720 ((string= "background at point" color)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1721 (setq color (background-color-at-point))))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1722 (unless color
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1723 (setq color ""))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1724 (setq hex-string
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1725 (string-match "^#?\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+$" color))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1726 (if (and allow-empty-name-p (string= "" color))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1727 ""
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1728 (when (and hex-string (not (eq (aref color 0) ?#)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1729 (setq color (concat "#" color))) ; No #; add it.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1730 (unless hex-string
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1731 (when (or (string= "" color) (not (test-completion color colors)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1732 (error "No such color: %S" color))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1733 (when convert-to-RGB-p
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1734 (let ((components (x-color-values color)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1735 (unless components (error "No such color: %S" color))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1736 (unless (string-match "^#\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+$" color)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1737 (setq color (format "#%04X%04X%04X"
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1738 (logand 65535 (nth 0 components))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1739 (logand 65535 (nth 1 components))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1740 (logand 65535 (nth 2 components))))))))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1741 (when msg-p (message "Color: `%s'" color))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1742 color)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1743
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1744 ;; Commented out because I decided it is better to include the
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1745 ;; duplicates in read-color's completion list.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1746
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1747 ;; (defun defined-colors-without-duplicates ()
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1748 ;; "Return the list of defined colors, without the no-space versions.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1749 ;; For each color name, we keep the variant that DOES have spaces."
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1750 ;; (let ((result (copy-sequence (defined-colors)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1751 ;; to-be-rejected)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1752 ;; (save-match-data
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1753 ;; (dolist (this result)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1754 ;; (if (string-match " " this)
92115
b4b2ac0c80f8 (font-weight-table): Fix value of `semi-light'.
Juanma Barranquero <lekktu@gmail.com>
parents: 92112
diff changeset
1755 ;; (push (replace-regexp-in-string " " ""
85758
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1756 ;; this)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1757 ;; to-be-rejected)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1758 ;; (dolist (elt to-be-rejected)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1759 ;; (let ((as-found (car (member-ignore-case elt result))))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1760 ;; (setq result (delete as-found result)))))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1761 ;; result))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1762
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1763 (defun face-at-point ()
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1764 "Return the face of the character after point.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1765 If it has more than one face, return the first one.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1766 Return nil if it has no specified face."
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1767 (let* ((faceprop (or (get-char-property (point) 'read-face-name)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1768 (get-char-property (point) 'face)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1769 'default))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1770 (face (cond ((symbolp faceprop) faceprop)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1771 ;; List of faces (don't treat an attribute spec).
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1772 ;; Just use the first face.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1773 ((and (consp faceprop) (not (keywordp (car faceprop)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1774 (not (memq (car faceprop)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1775 '(foreground-color background-color))))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1776 (car faceprop))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1777 (t nil)))) ; Invalid face value.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1778 (if (facep face) face nil)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1779
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1780 (defun foreground-color-at-point ()
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1781 "Return the foreground color of the character after point."
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1782 ;; `face-at-point' alone is not sufficient. It only gets named faces.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1783 ;; Need also pick up any face properties that are not associated with named faces.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1784 (let ((face (or (face-at-point)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1785 (get-char-property (point) 'read-face-name)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1786 (get-char-property (point) 'face))))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1787 (cond ((and face (symbolp face))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1788 (let ((value (face-foreground face nil 'default)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1789 (if (member value '("unspecified-fg" "unspecified-bg"))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1790 nil
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1791 value)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1792 ((consp face)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1793 (cond ((memq 'foreground-color face) (cdr (memq 'foreground-color face)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1794 ((memq ':foreground face) (cadr (memq ':foreground face)))))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1795 (t nil)))) ; Invalid face value.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1796
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1797 (defun background-color-at-point ()
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1798 "Return the background color of the character after point."
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1799 ;; `face-at-point' alone is not sufficient. It only gets named faces.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1800 ;; Need also pick up any face properties that are not associated with named faces.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1801 (let ((face (or (face-at-point)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1802 (get-char-property (point) 'read-face-name)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1803 (get-char-property (point) 'face))))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1804 (cond ((and face (symbolp face))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1805 (let ((value (face-background face nil 'default)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1806 (if (member value '("unspecified-fg" "unspecified-bg"))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1807 nil
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1808 value)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1809 ((consp face)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1810 (cond ((memq 'background-color face) (cdr (memq 'background-color face)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1811 ((memq ':background face) (cadr (memq ':background face)))))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1812 (t nil)))) ; Invalid face value.
26736
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1813
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1814 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1815 ;;; Background mode.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1816 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1817
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1818 (defcustom frame-background-mode nil
100171
d42aff5ca541 * align.el:
Lute Kamstra <lute@gnu.org>
parents: 99144
diff changeset
1819 "The brightness of the background.
63637
de897c139738 (face-user-default-spec): Try getting `customized-face' prior to `saved-face'.
Juri Linkov <juri@jurta.org>
parents: 63594
diff changeset
1820 Set this to the symbol `dark' if your background color is dark,
67503
71e68cea180c (frame-background-mode): Replace `choice-item' keywords
Juri Linkov <juri@jurta.org>
parents: 67049
diff changeset
1821 `light' if your background is light, or nil (automatic by default)
71e68cea180c (frame-background-mode): Replace `choice-item' keywords
Juri Linkov <juri@jurta.org>
parents: 67049
diff changeset
1822 if you want Emacs to examine the brightness for you. Don't set this
71e68cea180c (frame-background-mode): Replace `choice-item' keywords
Juri Linkov <juri@jurta.org>
parents: 67049
diff changeset
1823 variable with `setq'; this won't have the expected effect."
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1824 :group 'faces
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1825 :set #'(lambda (var value)
29769
18a16ab69699 (frame-background-mode): Use set-default, not set, in setter.
Dave Love <fx@gnu.org>
parents: 29354
diff changeset
1826 (set-default var value)
31528
a461cad7a942 (face-x-resources): Make custom type more specific.
Dave Love <fx@gnu.org>
parents: 31500
diff changeset
1827 (mapc 'frame-set-background-mode (frame-list)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1828 :initialize 'custom-initialize-changed
67503
71e68cea180c (frame-background-mode): Replace `choice-item' keywords
Juri Linkov <juri@jurta.org>
parents: 67049
diff changeset
1829 :type '(choice (const dark)
71e68cea180c (frame-background-mode): Replace `choice-item' keywords
Juri Linkov <juri@jurta.org>
parents: 67049
diff changeset
1830 (const light)
71e68cea180c (frame-background-mode): Replace `choice-item' keywords
Juri Linkov <juri@jurta.org>
parents: 67049
diff changeset
1831 (const :tag "automatic" nil)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1832
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1833
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1834 (declare-function x-get-resource "frame.c"
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1835 (attribute class &optional component subclass))
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1836
98469
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1837 (defvar inhibit-frame-set-background-mode nil)
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1838
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1839 (defun frame-set-background-mode (frame)
32649
47bf921bccd5 (frame-set-background-mode): `unspecified' &c are symbols, not strings.
Miles Bader <miles@gnu.org>
parents: 32641
diff changeset
1840 "Set up display-dependent faces on FRAME.
47bf921bccd5 (frame-set-background-mode): `unspecified' &c are symbols, not strings.
Miles Bader <miles@gnu.org>
parents: 32641
diff changeset
1841 Display-dependent faces are those which have different definitions
47bf921bccd5 (frame-set-background-mode): `unspecified' &c are symbols, not strings.
Miles Bader <miles@gnu.org>
parents: 32641
diff changeset
1842 according to the `background-mode' and `display-type' frame parameters."
98469
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1843 (unless inhibit-frame-set-background-mode
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1844 (let* ((bg-resource
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1845 (and (window-system frame)
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1846 (x-get-resource "backgroundMode" "BackgroundMode")))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1847 (bg-color (frame-parameter frame 'background-color))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1848 (terminal-bg-mode (terminal-parameter frame 'background-mode))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1849 (tty-type (tty-type frame))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1850 (bg-mode
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1851 (cond (frame-background-mode)
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1852 (bg-resource (intern (downcase bg-resource)))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1853 (terminal-bg-mode)
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1854 ((and (null (window-system frame))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1855 ;; Unspecified frame background color can only
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1856 ;; happen on tty's.
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1857 (member bg-color '(nil unspecified "unspecified-bg")))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1858 ;; There is no way to determine the background mode
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1859 ;; automatically, so we make a guess based on the
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1860 ;; terminal type.
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1861 (if (and tty-type
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1862 (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)"
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1863 tty-type))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1864 'light
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1865 'dark))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1866 ((equal bg-color "unspecified-fg") ; inverted colors
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1867 (if (and tty-type
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1868 (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)"
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1869 tty-type))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1870 'dark
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1871 'light))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1872 ((>= (apply '+ (color-values bg-color frame))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1873 ;; Just looking at the screen, colors whose
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1874 ;; values add up to .6 of the white total
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1875 ;; still look dark to me.
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1876 (* (apply '+ (color-values "white" frame)) .6))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1877 'light)
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1878 (t 'dark)))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1879 (display-type
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1880 (cond ((null (window-system frame))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1881 (if (tty-display-color-p frame) 'color 'mono))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1882 ((display-color-p frame)
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1883 'color)
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1884 ((x-display-grayscale-p frame)
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1885 'grayscale)
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1886 (t 'mono)))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1887 (old-bg-mode
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1888 (frame-parameter frame 'background-mode))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1889 (old-display-type
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1890 (frame-parameter frame 'display-type)))
32376
267a06bd1387 (frame-set-background-mode):
Miles Bader <miles@gnu.org>
parents: 32373
diff changeset
1891
98469
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1892 (unless (and (eq bg-mode old-bg-mode) (eq display-type old-display-type))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1893 (let ((locally-modified-faces nil)
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1894 ;; Prevent face-spec-recalc from calling this function
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1895 ;; again, resulting in a loop (bug#911).
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1896 (inhibit-frame-set-background-mode t))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1897 ;; Before modifying the frame parameters, collect a list of
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1898 ;; faces that don't match what their face-spec says they
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1899 ;; should look like. We then avoid changing these faces
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1900 ;; below. These are the faces whose attributes were
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1901 ;; modified on FRAME. We use a negative list on the
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1902 ;; assumption that most faces will be unmodified, so we can
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1903 ;; avoid consing in the common case.
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1904 (dolist (face (face-list))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1905 (and (not (get face 'face-override-spec))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1906 (not (face-spec-match-p face
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1907 (face-user-default-spec face)
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1908 (selected-frame)))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1909 (push face locally-modified-faces)))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1910 ;; Now change to the new frame parameters
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1911 (modify-frame-parameters frame
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1912 (list (cons 'background-mode bg-mode)
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1913 (cons 'display-type display-type)))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1914 ;; For all named faces, choose face specs matching the new frame
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1915 ;; parameters, unless they have been locally modified.
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1916 (dolist (face (face-list))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1917 (unless (memq face locally-modified-faces)
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1918 (face-spec-recalc face frame))))))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1919
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1920
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1921 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1922 ;;; Frame creation.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1923 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1924
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1925 (declare-function x-parse-geometry "frame.c" (string))
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1926
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1927 (defun x-handle-named-frame-geometry (parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1928 "Add geometry parameters for a named frame to parameter list PARAMETERS.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1929 Value is the new parameter list."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1930 (let* ((name (or (cdr (assq 'name parameters))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1931 (cdr (assq 'name default-frame-alist))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1932 (x-resource-name name)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1933 (res-geometry (if name (x-get-resource "geometry" "Geometry"))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1934 (when res-geometry
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1935 (let ((parsed (x-parse-geometry res-geometry)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1936 ;; If the resource specifies a position, call the position
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1937 ;; and size "user-specified".
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1938 (when (or (assq 'top parsed)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1939 (assq 'left parsed))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1940 (setq parsed (append '((user-position . t) (user-size . t)) parsed)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1941 ;; Put the geometry parameters at the end. Copy
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1942 ;; default-frame-alist so that they go after it.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1943 (setq parameters (append parameters default-frame-alist parsed))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1944 parameters))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1945
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1946
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1947 (defun x-handle-reverse-video (frame parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1948 "Handle the reverse-video frame parameter and X resource.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1949 `x-create-frame' does not handle this one."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1950 (when (cdr (or (assq 'reverse parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1951 (assq 'reverse default-frame-alist)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1952 (let ((resource (x-get-resource "reverseVideo"
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1953 "ReverseVideo")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1954 (if resource
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1955 (cons nil (member (downcase resource)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1956 '("on" "true")))))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1957 (let* ((params (frame-parameters frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1958 (bg (cdr (assq 'foreground-color params)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1959 (fg (cdr (assq 'background-color params))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1960 (modify-frame-parameters frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1961 (list (cons 'foreground-color fg)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1962 (cons 'background-color bg)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1963 (if (equal bg (cdr (assq 'border-color params)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1964 (modify-frame-parameters frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1965 (list (cons 'border-color fg))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1966 (if (equal bg (cdr (assq 'mouse-color params)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1967 (modify-frame-parameters frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1968 (list (cons 'mouse-color fg))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1969 (if (equal bg (cdr (assq 'cursor-color params)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1970 (modify-frame-parameters frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1971 (list (cons 'cursor-color fg)))))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1972
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1973 (declare-function x-create-frame "xfns.c" (parms))
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1974 (declare-function x-setup-function-keys "term/x-win" (frame))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1975
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1976 (defun x-create-frame-with-faces (&optional parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1977 "Create a frame from optional frame parameters PARAMETERS.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1978 Parameters not specified by PARAMETERS are taken from
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1979 `default-frame-alist'. If PARAMETERS specify a frame name,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1980 handle X geometry resources for that name. If either PARAMETERS
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1981 or `default-frame-alist' contains a `reverse' parameter, or
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1982 the X resource ``reverseVideo'' is present, handle that.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1983 Value is the new frame created."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1984 (setq parameters (x-handle-named-frame-geometry parameters))
96585
32d47016e1c4 (x-create-frame-with-faces): Don't pass parameters that
Chong Yidong <cyd@stupidchicken.com>
parents: 96549
diff changeset
1985 (let* ((params (copy-tree parameters))
32d47016e1c4 (x-create-frame-with-faces): Don't pass parameters that
Chong Yidong <cyd@stupidchicken.com>
parents: 96549
diff changeset
1986 (visibility-spec (assq 'visibility parameters))
32d47016e1c4 (x-create-frame-with-faces): Don't pass parameters that
Chong Yidong <cyd@stupidchicken.com>
parents: 96549
diff changeset
1987 (delayed-params '(foreground-color background-color font
32d47016e1c4 (x-create-frame-with-faces): Don't pass parameters that
Chong Yidong <cyd@stupidchicken.com>
parents: 96549
diff changeset
1988 border-color cursor-color mouse-color
32d47016e1c4 (x-create-frame-with-faces): Don't pass parameters that
Chong Yidong <cyd@stupidchicken.com>
parents: 96549
diff changeset
1989 visibility scroll-bar-foreground
32d47016e1c4 (x-create-frame-with-faces): Don't pass parameters that
Chong Yidong <cyd@stupidchicken.com>
parents: 96549
diff changeset
1990 scroll-bar-background))
32d47016e1c4 (x-create-frame-with-faces): Don't pass parameters that
Chong Yidong <cyd@stupidchicken.com>
parents: 96549
diff changeset
1991 frame success)
32d47016e1c4 (x-create-frame-with-faces): Don't pass parameters that
Chong Yidong <cyd@stupidchicken.com>
parents: 96549
diff changeset
1992 (dolist (param delayed-params)
32d47016e1c4 (x-create-frame-with-faces): Don't pass parameters that
Chong Yidong <cyd@stupidchicken.com>
parents: 96549
diff changeset
1993 (setq params (assq-delete-all param params)))
32d47016e1c4 (x-create-frame-with-faces): Don't pass parameters that
Chong Yidong <cyd@stupidchicken.com>
parents: 96549
diff changeset
1994 (setq frame (x-create-frame `((visibility . nil) . ,params)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1995 (unwind-protect
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1996 (progn
83316
102194c6d773 Update Lisp code for a terminal-local `function-key-map'.
Karoly Lorentey <lorentey@elte.hu>
parents: 83314
diff changeset
1997 (x-setup-function-keys frame)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1998 (x-handle-reverse-video frame parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1999 (frame-set-background-mode frame)
96549
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2000 (face-set-after-frame-default frame parameters)
83496
f271076dab2d Fix toolbars on X frames when Emacs is started on a tty. (Reported by Richard Lewis.)
Karoly Lorentey <lorentey@elte.hu>
parents: 83488
diff changeset
2001 (if (null visibility-spec)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2002 (make-frame-visible frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2003 (modify-frame-parameters frame (list visibility-spec)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2004 (setq success t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2005 (unless success
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2006 (delete-frame frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2007 frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2008
96549
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2009 (defun face-set-after-frame-default (frame &optional parameters)
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2010 "Initialize the frame-local faces of FRAME.
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2011 Calculate the face definitions using the face specs, custom theme
96585
32d47016e1c4 (x-create-frame-with-faces): Don't pass parameters that
Chong Yidong <cyd@stupidchicken.com>
parents: 96549
diff changeset
2012 settings, X resources, and `face-new-frame-defaults'.
96549
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2013 Finally, apply any relevant face attributes found amongst the
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2014 frame parameters in PARAMETERS and `default-frame-alist'."
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2015 (dolist (face (nreverse (face-list)))
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2016 (condition-case ()
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2017 (progn
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2018 ;; Initialize faces from face spec and custom theme.
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2019 (face-spec-recalc face frame)
96585
32d47016e1c4 (x-create-frame-with-faces): Don't pass parameters that
Chong Yidong <cyd@stupidchicken.com>
parents: 96549
diff changeset
2020 ;; X resouces for the default face are applied during
32d47016e1c4 (x-create-frame-with-faces): Don't pass parameters that
Chong Yidong <cyd@stupidchicken.com>
parents: 96549
diff changeset
2021 ;; x-create-frame.
32d47016e1c4 (x-create-frame-with-faces): Don't pass parameters that
Chong Yidong <cyd@stupidchicken.com>
parents: 96549
diff changeset
2022 (and (not (eq face 'default))
100171
d42aff5ca541 * align.el:
Lute Kamstra <lute@gnu.org>
parents: 99144
diff changeset
2023 (memq (window-system frame) '(x w32 ns))
96585
32d47016e1c4 (x-create-frame-with-faces): Don't pass parameters that
Chong Yidong <cyd@stupidchicken.com>
parents: 96549
diff changeset
2024 (make-face-x-resource-internal face frame))
96549
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2025 ;; Apply attributes specified by face-new-frame-defaults
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2026 (internal-merge-in-global-face face frame))
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2027 ;; Don't let invalid specs prevent frame creation.
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2028 (error nil)))
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2029 ;; Apply attributes specified by frame parameters.
75696
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2030 (let ((face-params '((foreground-color default :foreground)
96549
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2031 (background-color default :background)
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2032 (font default :font)
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2033 (border-color border :background)
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2034 (cursor-color cursor :background)
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2035 (scroll-bar-foreground scroll-bar :foreground)
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2036 (scroll-bar-background scroll-bar :background)
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2037 (mouse-color mouse :background))))
75696
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2038 (dolist (param face-params)
96549
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2039 (let* ((param-name (nth 0 param))
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2040 (value (cdr (or (assq param-name parameters)
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2041 (assq param-name default-frame-alist)))))
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2042 (if value
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2043 (set-face-attribute (nth 1 param) frame
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2044 (nth 2 param) value))))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2045
33008
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2046 (defun tty-handle-reverse-video (frame parameters)
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2047 "Handle the reverse-video frame parameter for terminal frames."
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2048 (when (cdr (or (assq 'reverse parameters)
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2049 (assq 'reverse default-frame-alist)))
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2050 (let* ((params (frame-parameters frame))
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2051 (bg (cdr (assq 'foreground-color params)))
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2052 (fg (cdr (assq 'background-color params))))
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2053 (modify-frame-parameters frame
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2054 (list (cons 'foreground-color fg)
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2055 (cons 'background-color bg)))
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2056 (if (equal bg (cdr (assq 'mouse-color params)))
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2057 (modify-frame-parameters frame
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2058 (list (cons 'mouse-color fg))))
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2059 (if (equal bg (cdr (assq 'cursor-color params)))
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2060 (modify-frame-parameters frame
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2061 (list (cons 'cursor-color fg)))))))
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2062
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2063
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2064 (defun tty-create-frame-with-faces (&optional parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2065 "Create a frame from optional frame parameters PARAMETERS.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2066 Parameters not specified by PARAMETERS are taken from
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2067 `default-frame-alist'. If either PARAMETERS or `default-frame-alist'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2068 contains a `reverse' parameter, handle that. Value is the new frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2069 created."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2070 (let ((frame (make-terminal-frame parameters))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2071 success)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2072 (unwind-protect
83129
b1ded6fb31d1 Use with-selected-frame.
Karoly Lorentey <lorentey@elte.hu>
parents: 83123
diff changeset
2073 (with-selected-frame frame
33008
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2074 (tty-handle-reverse-video frame (frame-parameters frame))
83359
8f0c7632f259 Slightly refactor the terminal initialization code for simplicity.
Karoly Lorentey <lorentey@elte.hu>
parents: 83358
diff changeset
2075
85415
b1e285a2d293 (tty-create-frame-with-faces): Make sure not only
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85311
diff changeset
2076 (unless (terminal-parameter frame 'terminal-initted)
b1e285a2d293 (tty-create-frame-with-faces): Make sure not only
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85311
diff changeset
2077 (set-terminal-parameter frame 'terminal-initted t)
b1e285a2d293 (tty-create-frame-with-faces): Make sure not only
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85311
diff changeset
2078 (set-locale-environment nil frame)
b1e285a2d293 (tty-create-frame-with-faces): Make sure not only
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85311
diff changeset
2079 (tty-run-terminal-initialization frame))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2080 (frame-set-background-mode frame)
96549
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2081 (face-set-after-frame-default frame parameters)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2082 (setq success t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2083 (unless success
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2084 (delete-frame frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2085 frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2086
83523
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2087 (defun tty-find-type (pred type)
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2088 "Return the longest prefix of TYPE to which PRED returns non-nil.
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2089 TYPE should be a tty type name such as \"xterm-16color\".
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2090
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2091 The function tries only those prefixes that are followed by a
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2092 dash or underscore in the original type name, like \"xterm\" in
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2093 the above example."
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2094 (let (hyphend)
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2095 (while (and type
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2096 (not (funcall pred type)))
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2097 ;; Strip off last hyphen and what follows, then try again
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2098 (setq type
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2099 (if (setq hyphend (string-match "[-_][^-_]+$" type))
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2100 (substring type 0 hyphend)
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2101 nil))))
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2102 type)
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2103
83524
673d62ad74b5 Fix and/or simplify terminal initialization files.
Karoly Lorentey <lorentey@elte.hu>
parents: 83523
diff changeset
2104 (defun tty-run-terminal-initialization (frame &optional type)
673d62ad74b5 Fix and/or simplify terminal initialization files.
Karoly Lorentey <lorentey@elte.hu>
parents: 83523
diff changeset
2105 "Run the special initialization code for the terminal type of FRAME.
673d62ad74b5 Fix and/or simplify terminal initialization files.
Karoly Lorentey <lorentey@elte.hu>
parents: 83523
diff changeset
2106 The optional TYPE parameter may be used to override the autodetected
673d62ad74b5 Fix and/or simplify terminal initialization files.
Karoly Lorentey <lorentey@elte.hu>
parents: 83523
diff changeset
2107 terminal type to a different value."
673d62ad74b5 Fix and/or simplify terminal initialization files.
Karoly Lorentey <lorentey@elte.hu>
parents: 83523
diff changeset
2108 (setq type (or type (tty-type frame)))
83359
8f0c7632f259 Slightly refactor the terminal initialization code for simplicity.
Karoly Lorentey <lorentey@elte.hu>
parents: 83358
diff changeset
2109 ;; Load library for our terminal type.
8f0c7632f259 Slightly refactor the terminal initialization code for simplicity.
Karoly Lorentey <lorentey@elte.hu>
parents: 83358
diff changeset
2110 ;; User init file can set term-file-prefix to nil to prevent this.
8f0c7632f259 Slightly refactor the terminal initialization code for simplicity.
Karoly Lorentey <lorentey@elte.hu>
parents: 83358
diff changeset
2111 (with-selected-frame frame
85415
b1e285a2d293 (tty-create-frame-with-faces): Make sure not only
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85311
diff changeset
2112 (unless (null term-file-prefix)
83523
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2113 (let* (term-init-func)
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2114 ;; First, load the terminal initialization file, if it is
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2115 ;; available and it hasn't been loaded already.
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2116 (tty-find-type #'(lambda (type)
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2117 (let ((file (locate-library (concat term-file-prefix type))))
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2118 (and file
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2119 (or (assoc file load-history)
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2120 (load file t t)))))
83524
673d62ad74b5 Fix and/or simplify terminal initialization files.
Karoly Lorentey <lorentey@elte.hu>
parents: 83523
diff changeset
2121 type)
83523
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2122 ;; Next, try to find a matching initialization function, and call it.
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2123 (tty-find-type #'(lambda (type)
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2124 (fboundp (setq term-init-func
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2125 (intern (concat "terminal-init-" type)))))
83524
673d62ad74b5 Fix and/or simplify terminal initialization files.
Karoly Lorentey <lorentey@elte.hu>
parents: 83523
diff changeset
2126 type)
83380
94f174e5569d Merged from miles@gnu.org--gnu-2005 (patch 543)
Karoly Lorentey <lorentey@elte.hu>
parents: 83359
diff changeset
2127 (when (fboundp term-init-func)
83523
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2128 (funcall term-init-func))
6ce7108f7eef Don't load terminit files repeatedly. Also, don't call terminit functions more than once per terminal.
Karoly Lorentey <lorentey@elte.hu>
parents: 83513
diff changeset
2129 (set-terminal-parameter frame 'terminal-initted term-init-func)))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2130
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2131 ;; Called from C function init_display to initialize faces of the
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2132 ;; dumped terminal frame on startup.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2133
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2134 (defun tty-set-up-initial-frame-faces ()
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2135 (let ((frame (selected-frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2136 (frame-set-background-mode frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2137 (face-set-after-frame-default frame)))
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
2138
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2139
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2140
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2141
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2142 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2143 ;;; Compatiblity with 20.2
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2144 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2145
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2146 ;; Update a frame's faces when we change its default font.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2147
55883
cde9d1fff89c (frame-update-faces): Add empty docstring so the one for `ignore' doesn't
Juanma Barranquero <lekktu@gmail.com>
parents: 55545
diff changeset
2148 (defalias 'frame-update-faces 'ignore "")
46053
ef0684c3e07b (frame-update-faces): Fix obsolescence declaration.
Juanma Barranquero <lekktu@gmail.com>
parents: 46041
diff changeset
2149 (make-obsolete 'frame-update-faces "no longer necessary." "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2150
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2151 ;; Update the colors of FACE, after FRAME's own colors have been
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2152 ;; changed.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2153
64539
c94d5f576885 (describe-face): "?\ " -> "?\s".
Juanma Barranquero <lekktu@gmail.com>
parents: 64497
diff changeset
2154 (define-obsolete-function-alias 'frame-update-face-colors
c94d5f576885 (describe-face): "?\ " -> "?\s".
Juanma Barranquero <lekktu@gmail.com>
parents: 64497
diff changeset
2155 'frame-set-background-mode "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2156
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2157
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2158 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2159 ;;; Standard faces.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2160 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2161
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2162 (defgroup basic-faces nil
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2163 "The standard faces of Emacs."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2164 :group 'faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2165
93694
a60642ce1ede (default): Ensure the face-defface-spec property is set.
Chong Yidong <cyd@stupidchicken.com>
parents: 92948
diff changeset
2166 (defface default
a60642ce1ede (default): Ensure the face-defface-spec property is set.
Chong Yidong <cyd@stupidchicken.com>
parents: 92948
diff changeset
2167 '((t nil)) ; If this were nil, face-defface-spec would not be set.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2168 "Basic default face."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2169 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2170
65730
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2171 (defface bold
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2172 '((t :weight bold))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2173 "Basic bold face."
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2174 :group 'basic-faces)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2175
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2176 (defface italic
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2177 '((((supports :slant italic))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2178 :slant italic)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2179 (((supports :underline t))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2180 :underline t)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2181 (t
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2182 ;; default to italic, even it doesn't appear to be supported,
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2183 ;; because in some cases the display engine will do it's own
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2184 ;; workaround (to `dim' on ttys)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2185 :slant italic))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2186 "Basic italic face."
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2187 :group 'basic-faces)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2188
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2189 (defface bold-italic
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2190 '((t :weight bold :slant italic))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2191 "Basic bold-italic face."
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2192 :group 'basic-faces)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2193
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2194 (defface underline
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2195 '((((supports :underline t))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2196 :underline t)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2197 (((supports :weight bold))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2198 :weight bold)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2199 (t :underline t))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2200 "Basic underlined face."
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2201 :group 'basic-faces)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2202
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2203 (defface fixed-pitch
96169
abc9f7184a8c (fixed-pitch): Use "Monospace" family.
Chong Yidong <cyd@stupidchicken.com>
parents: 96079
diff changeset
2204 '((t :family "Monospace"))
65730
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2205 "The basic fixed-pitch face."
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2206 :group 'basic-faces)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2207
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2208 (defface variable-pitch
96247
002173686f70 (face-font-family-alternatives, variable-pitch): Use
Andreas Schwab <schwab@suse.de>
parents: 96241
diff changeset
2209 '((t :family "Sans Serif"))
65730
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2210 "The basic variable-pitch face."
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2211 :group 'basic-faces)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2212
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2213 (defface shadow
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2214 '((((class color grayscale) (min-colors 88) (background light))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2215 :foreground "grey50")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2216 (((class color grayscale) (min-colors 88) (background dark))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2217 :foreground "grey70")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2218 (((class color) (min-colors 8) (background light))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2219 :foreground "green")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2220 (((class color) (min-colors 8) (background dark))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2221 :foreground "yellow"))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2222 "Basic face for shadowed text."
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2223 :group 'basic-faces
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2224 :version "22.1")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2225
68341
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2226 (defface link
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2227 '((((class color) (min-colors 88) (background light))
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2228 :foreground "blue1" :underline t)
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2229 (((class color) (background light))
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2230 :foreground "blue" :underline t)
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2231 (((class color) (min-colors 88) (background dark))
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2232 :foreground "cyan1" :underline t)
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2233 (((class color) (background dark))
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2234 :foreground "cyan" :underline t)
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2235 (t :inherit underline))
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2236 "Basic face for unvisited links."
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2237 :group 'basic-faces
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2238 :version "22.1")
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2239
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2240 (defface link-visited
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2241 '((default :inherit link)
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2242 (((class color) (background light)) :foreground "magenta4")
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2243 (((class color) (background dark)) :foreground "violet"))
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2244 "Basic face for visited links."
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2245 :group 'basic-faces
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2246 :version "22.1")
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2247
65730
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2248 (defface highlight
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2249 '((((class color) (min-colors 88) (background light))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2250 :background "darkseagreen2")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2251 (((class color) (min-colors 88) (background dark))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2252 :background "darkolivegreen")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2253 (((class color) (min-colors 16) (background light))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2254 :background "darkseagreen2")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2255 (((class color) (min-colors 16) (background dark))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2256 :background "darkolivegreen")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2257 (((class color) (min-colors 8))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2258 :background "green" :foreground "black")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2259 (t :inverse-video t))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2260 "Basic face for highlighting."
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2261 :group 'basic-faces)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2262
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2263 (defface region
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2264 '((((class color) (min-colors 88) (background dark))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2265 :background "blue3")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2266 (((class color) (min-colors 88) (background light))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2267 :background "lightgoldenrod2")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2268 (((class color) (min-colors 16) (background dark))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2269 :background "blue3")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2270 (((class color) (min-colors 16) (background light))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2271 :background "lightgoldenrod2")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2272 (((class color) (min-colors 8))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2273 :background "blue" :foreground "white")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2274 (((type tty) (class mono))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2275 :inverse-video t)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2276 (t :background "gray"))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2277 "Basic face for highlighting the region."
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2278 :version "21.1"
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2279 :group 'basic-faces)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2280
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2281 (defface secondary-selection
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2282 '((((class color) (min-colors 88) (background light))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2283 :background "yellow1")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2284 (((class color) (min-colors 88) (background dark))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2285 :background "SkyBlue4")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2286 (((class color) (min-colors 16) (background light))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2287 :background "yellow")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2288 (((class color) (min-colors 16) (background dark))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2289 :background "SkyBlue4")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2290 (((class color) (min-colors 8))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2291 :background "cyan" :foreground "black")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2292 (t :inverse-video t))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2293 "Basic face for displaying the secondary selection."
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2294 :group 'basic-faces)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2295
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2296 (defface trailing-whitespace
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2297 '((((class color) (background light))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2298 :background "red1")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2299 (((class color) (background dark))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2300 :background "red1")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2301 (t :inverse-video t))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2302 "Basic face for highlighting trailing whitespace."
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2303 :version "21.1"
67503
71e68cea180c (frame-background-mode): Replace `choice-item' keywords
Juri Linkov <juri@jurta.org>
parents: 67049
diff changeset
2304 :group 'whitespace-faces ; like `show-trailing-whitespace'
65730
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2305 :group 'basic-faces)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2306
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2307 (defface escape-glyph
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2308 '((((background dark)) :foreground "cyan")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2309 ;; See the comment in minibuffer-prompt for
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2310 ;; the reason not to use blue on MS-DOS.
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2311 (((type pc)) :foreground "magenta")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2312 ;; red4 is too dark, but some say blue is too loud.
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2313 ;; brown seems to work ok. -- rms.
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2314 (t :foreground "brown"))
72280
67323a6ea60e (escape-glyph): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 71591
diff changeset
2315 "Face for characters displayed as sequences using `^' or `\\'."
65730
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2316 :group 'basic-faces
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2317 :version "22.1")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2318
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2319 (defface nobreak-space
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2320 '((((class color) (min-colors 88)) :inherit escape-glyph :underline t)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2321 (((class color) (min-colors 8)) :background "magenta")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2322 (t :inverse-video t))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2323 "Face for displaying nobreak space."
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2324 :group 'basic-faces
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2325 :version "22.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2326
68214
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2327 (defgroup mode-line-faces nil
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2328 "Faces used in the mode line."
72879
3931d05c811a (mode-line-faces): Group mode-line instead of modeline.
Richard M. Stallman <rms@gnu.org>
parents: 72280
diff changeset
2329 :group 'mode-line
68214
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2330 :group 'faces
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2331 :version "22.1")
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2332
25650
8b06b47a1fea (mode-line): Replaces `modeline'.
Gerd Moellmann <gerd@gnu.org>
parents: 25616
diff changeset
2333 (defface mode-line
59077
294a7f7e3daf (mode-line, mode-line-inactive): Use min-colors.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 59054
diff changeset
2334 '((((class color) (min-colors 88))
43711
d15360503e4e (face-spec-choose): Allow `t' to appear before the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43550
diff changeset
2335 :box (:line-width -1 :style released-button)
d15360503e4e (face-spec-choose): Allow `t' to appear before the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43550
diff changeset
2336 :background "grey75" :foreground "black")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2337 (t
43711
d15360503e4e (face-spec-choose): Allow `t' to appear before the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43550
diff changeset
2338 :inverse-video t))
43204
1b0f33edf842 (mode-line-inactive): New face for mode-line for
Kim F. Storm <storm@cua.dk>
parents: 42969
diff changeset
2339 "Basic mode line face for selected window."
25687
afad62240679 (mode-line, header-line, tool-bar, ): Add :version.
Dave Love <fx@gnu.org>
parents: 25650
diff changeset
2340 :version "21.1"
68214
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2341 :group 'mode-line-faces
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2342 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2343
43204
1b0f33edf842 (mode-line-inactive): New face for mode-line for
Kim F. Storm <storm@cua.dk>
parents: 42969
diff changeset
2344 (defface mode-line-inactive
58935
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
2345 '((default
43711
d15360503e4e (face-spec-choose): Allow `t' to appear before the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43550
diff changeset
2346 :inherit mode-line)
59077
294a7f7e3daf (mode-line, mode-line-inactive): Use min-colors.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 59054
diff changeset
2347 (((class color) (min-colors 88) (background light))
43204
1b0f33edf842 (mode-line-inactive): New face for mode-line for
Kim F. Storm <storm@cua.dk>
parents: 42969
diff changeset
2348 :weight light
1b0f33edf842 (mode-line-inactive): New face for mode-line for
Kim F. Storm <storm@cua.dk>
parents: 42969
diff changeset
2349 :box (:line-width -1 :color "grey75" :style nil)
1b0f33edf842 (mode-line-inactive): New face for mode-line for
Kim F. Storm <storm@cua.dk>
parents: 42969
diff changeset
2350 :foreground "grey20" :background "grey90")
59077
294a7f7e3daf (mode-line, mode-line-inactive): Use min-colors.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 59054
diff changeset
2351 (((class color) (min-colors 88) (background dark) )
43247
4c5a2e2ddf43 (mode-line-inactive): Add dark-background variant.
Miles Bader <miles@gnu.org>
parents: 43204
diff changeset
2352 :weight light
4c5a2e2ddf43 (mode-line-inactive): Add dark-background variant.
Miles Bader <miles@gnu.org>
parents: 43204
diff changeset
2353 :box (:line-width -1 :color "grey40" :style nil)
43711
d15360503e4e (face-spec-choose): Allow `t' to appear before the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43550
diff changeset
2354 :foreground "grey80" :background "grey30"))
43204
1b0f33edf842 (mode-line-inactive): New face for mode-line for
Kim F. Storm <storm@cua.dk>
parents: 42969
diff changeset
2355 "Basic mode line face for non-selected windows."
59996
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 59872
diff changeset
2356 :version "22.1"
68214
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2357 :group 'mode-line-faces
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2358 :group 'basic-faces)
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2359
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2360 (defface mode-line-highlight
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2361 '((((class color) (min-colors 88))
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2362 :box (:line-width 2 :color "grey40" :style released-button))
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2363 (t
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2364 :inherit highlight))
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2365 "Basic mode line face for highlighting."
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2366 :version "22.1"
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2367 :group 'mode-line-faces
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2368 :group 'basic-faces)
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2369
92717
fec088bf4a02 (mode-line-emphasis): New face.
Glenn Morris <rgm@gnu.org>
parents: 92446
diff changeset
2370 (defface mode-line-emphasis
fec088bf4a02 (mode-line-emphasis): New face.
Glenn Morris <rgm@gnu.org>
parents: 92446
diff changeset
2371 '((t (:weight bold)))
fec088bf4a02 (mode-line-emphasis): New face.
Glenn Morris <rgm@gnu.org>
parents: 92446
diff changeset
2372 "Face used to emphasize certain mode line features.
fec088bf4a02 (mode-line-emphasis): New face.
Glenn Morris <rgm@gnu.org>
parents: 92446
diff changeset
2373 Use the face `mode-line-highlight' for features that can be selected."
fec088bf4a02 (mode-line-emphasis): New face.
Glenn Morris <rgm@gnu.org>
parents: 92446
diff changeset
2374 :version "23.1"
fec088bf4a02 (mode-line-emphasis): New face.
Glenn Morris <rgm@gnu.org>
parents: 92446
diff changeset
2375 :group 'mode-line-faces
fec088bf4a02 (mode-line-emphasis): New face.
Glenn Morris <rgm@gnu.org>
parents: 92446
diff changeset
2376 :group 'basic-faces)
fec088bf4a02 (mode-line-emphasis): New face.
Glenn Morris <rgm@gnu.org>
parents: 92446
diff changeset
2377
68214
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2378 (defface mode-line-buffer-id
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2379 '((t (:weight bold)))
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2380 "Face used for buffer identification parts of the mode line."
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2381 :version "22.1"
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2382 :group 'mode-line-faces
43204
1b0f33edf842 (mode-line-inactive): New face for mode-line for
Kim F. Storm <storm@cua.dk>
parents: 42969
diff changeset
2383 :group 'basic-faces)
1b0f33edf842 (mode-line-inactive): New face for mode-line for
Kim F. Storm <storm@cua.dk>
parents: 42969
diff changeset
2384
25650
8b06b47a1fea (mode-line): Replaces `modeline'.
Gerd Moellmann <gerd@gnu.org>
parents: 25616
diff changeset
2385 ;; Make `modeline' an alias for `mode-line', for compatibility.
8b06b47a1fea (mode-line): Replaces `modeline'.
Gerd Moellmann <gerd@gnu.org>
parents: 25616
diff changeset
2386 (put 'modeline 'face-alias 'mode-line)
43204
1b0f33edf842 (mode-line-inactive): New face for mode-line for
Kim F. Storm <storm@cua.dk>
parents: 42969
diff changeset
2387 (put 'modeline-inactive 'face-alias 'mode-line-inactive)
63311
212616057d0b (modeline-highlight): Rename from (the erroneous) `modeline-higilight'.
Eli Zaretskii <eliz@gnu.org>
parents: 63140
diff changeset
2388 (put 'modeline-highlight 'face-alias 'mode-line-highlight)
68214
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2389 (put 'modeline-buffer-id 'face-alias 'mode-line-buffer-id)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2390
25545
b0a117037bde (header-line): Renamed from `top-line'.
Gerd Moellmann <gerd@gnu.org>
parents: 25542
diff changeset
2391 (defface header-line
58935
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
2392 '((default
54574
76b831799f4d (read-face-font): Don't cons up unnecessarily.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54161
diff changeset
2393 :inherit mode-line)
76b831799f4d (read-face-font): Don't cons up unnecessarily.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54161
diff changeset
2394 (((type tty))
32404
d355f52b4497 (header-line): Change tty-variant to use underlining.
Miles Bader <miles@gnu.org>
parents: 32378
diff changeset
2395 ;; This used to be `:inverse-video t', but that doesn't look very
d355f52b4497 (header-line): Change tty-variant to use underlining.
Miles Bader <miles@gnu.org>
parents: 32378
diff changeset
2396 ;; good when combined with inverse-video mode-lines and multiple
d355f52b4497 (header-line): Change tty-variant to use underlining.
Miles Bader <miles@gnu.org>
parents: 32378
diff changeset
2397 ;; windows. Underlining looks better, and is more consistent with
d355f52b4497 (header-line): Change tty-variant to use underlining.
Miles Bader <miles@gnu.org>
parents: 32378
diff changeset
2398 ;; the window-system face variants, which deemphasize the
d355f52b4497 (header-line): Change tty-variant to use underlining.
Miles Bader <miles@gnu.org>
parents: 32378
diff changeset
2399 ;; header-line in relation to the mode-line face. If a terminal
d355f52b4497 (header-line): Change tty-variant to use underlining.
Miles Bader <miles@gnu.org>
parents: 32378
diff changeset
2400 ;; can't underline, then the header-line will end up without any
d355f52b4497 (header-line): Change tty-variant to use underlining.
Miles Bader <miles@gnu.org>
parents: 32378
diff changeset
2401 ;; highlighting; this may be too confusing in general, although it
d355f52b4497 (header-line): Change tty-variant to use underlining.
Miles Bader <miles@gnu.org>
parents: 32378
diff changeset
2402 ;; happens to look good with the only current use of header-lines,
d355f52b4497 (header-line): Change tty-variant to use underlining.
Miles Bader <miles@gnu.org>
parents: 32378
diff changeset
2403 ;; the info browser. XXX
54574
76b831799f4d (read-face-font): Don't cons up unnecessarily.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54161
diff changeset
2404 :inverse-video nil ;Override the value inherited from mode-line.
46146
f883ac732e39 (header-line): Don't use a `common' clause for inheriting from the mode-line
Miles Bader <miles@gnu.org>
parents: 46145
diff changeset
2405 :underline t)
32756
ccfb1ed059ca (header-line): Make more reasonable on mono/grayscale displays.
Miles Bader <miles@gnu.org>
parents: 32752
diff changeset
2406 (((class color grayscale) (background light))
33465
900ca3da6e01 (header-line): Use `:box nil' for color/gs displays too.
Miles Bader <miles@gnu.org>
parents: 33447
diff changeset
2407 :background "grey90" :foreground "grey20"
54574
76b831799f4d (read-face-font): Don't cons up unnecessarily.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54161
diff changeset
2408 :box nil)
32756
ccfb1ed059ca (header-line): Make more reasonable on mono/grayscale displays.
Miles Bader <miles@gnu.org>
parents: 32752
diff changeset
2409 (((class color grayscale) (background dark))
33465
900ca3da6e01 (header-line): Use `:box nil' for color/gs displays too.
Miles Bader <miles@gnu.org>
parents: 33447
diff changeset
2410 :background "grey20" :foreground "grey90"
54574
76b831799f4d (read-face-font): Don't cons up unnecessarily.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54161
diff changeset
2411 :box nil)
32756
ccfb1ed059ca (header-line): Make more reasonable on mono/grayscale displays.
Miles Bader <miles@gnu.org>
parents: 32752
diff changeset
2412 (((class mono) (background light))
33465
900ca3da6e01 (header-line): Use `:box nil' for color/gs displays too.
Miles Bader <miles@gnu.org>
parents: 33447
diff changeset
2413 :background "white" :foreground "black"
900ca3da6e01 (header-line): Use `:box nil' for color/gs displays too.
Miles Bader <miles@gnu.org>
parents: 33447
diff changeset
2414 :inverse-video nil
900ca3da6e01 (header-line): Use `:box nil' for color/gs displays too.
Miles Bader <miles@gnu.org>
parents: 33447
diff changeset
2415 :box nil
54574
76b831799f4d (read-face-font): Don't cons up unnecessarily.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54161
diff changeset
2416 :underline t)
32756
ccfb1ed059ca (header-line): Make more reasonable on mono/grayscale displays.
Miles Bader <miles@gnu.org>
parents: 32752
diff changeset
2417 (((class mono) (background dark))
33465
900ca3da6e01 (header-line): Use `:box nil' for color/gs displays too.
Miles Bader <miles@gnu.org>
parents: 33447
diff changeset
2418 :background "black" :foreground "white"
900ca3da6e01 (header-line): Use `:box nil' for color/gs displays too.
Miles Bader <miles@gnu.org>
parents: 33447
diff changeset
2419 :inverse-video nil
900ca3da6e01 (header-line): Use `:box nil' for color/gs displays too.
Miles Bader <miles@gnu.org>
parents: 33447
diff changeset
2420 :box nil
54574
76b831799f4d (read-face-font): Don't cons up unnecessarily.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54161
diff changeset
2421 :underline t))
25545
b0a117037bde (header-line): Renamed from `top-line'.
Gerd Moellmann <gerd@gnu.org>
parents: 25542
diff changeset
2422 "Basic header-line face."
25687
afad62240679 (mode-line, header-line, tool-bar, ): Add :version.
Dave Love <fx@gnu.org>
parents: 25650
diff changeset
2423 :version "21.1"
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2424 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2425
75166
d9e4f75aee3d (momentary): Change :group to basic-faces where all
Juri Linkov <juri@jurta.org>
parents: 75109
diff changeset
2426 (defface vertical-border
d9e4f75aee3d (momentary): Change :group to basic-faces where all
Juri Linkov <juri@jurta.org>
parents: 75109
diff changeset
2427 '((((type tty)) :inherit mode-line-inactive))
d9e4f75aee3d (momentary): Change :group to basic-faces where all
Juri Linkov <juri@jurta.org>
parents: 75109
diff changeset
2428 "Face used for vertical window dividers on ttys."
d9e4f75aee3d (momentary): Change :group to basic-faces where all
Juri Linkov <juri@jurta.org>
parents: 75109
diff changeset
2429 :version "22.1"
d9e4f75aee3d (momentary): Change :group to basic-faces where all
Juri Linkov <juri@jurta.org>
parents: 75109
diff changeset
2430 :group 'basic-faces)
d9e4f75aee3d (momentary): Change :group to basic-faces where all
Juri Linkov <juri@jurta.org>
parents: 75109
diff changeset
2431
65084
87a66a9a9328 (minibuffer-prompt): Doc fix.
Juri Linkov <juri@jurta.org>
parents: 65068
diff changeset
2432 (defface minibuffer-prompt
87a66a9a9328 (minibuffer-prompt): Doc fix.
Juri Linkov <juri@jurta.org>
parents: 65068
diff changeset
2433 '((((background dark)) :foreground "cyan")
87a66a9a9328 (minibuffer-prompt): Doc fix.
Juri Linkov <juri@jurta.org>
parents: 65068
diff changeset
2434 ;; Don't use blue because many users of the MS-DOS port customize
87a66a9a9328 (minibuffer-prompt): Doc fix.
Juri Linkov <juri@jurta.org>
parents: 65068
diff changeset
2435 ;; their foreground color to be blue.
87a66a9a9328 (minibuffer-prompt): Doc fix.
Juri Linkov <juri@jurta.org>
parents: 65068
diff changeset
2436 (((type pc)) :foreground "magenta")
76292
81d50597174e (minibuffer-prompt): Use medium blue by default.
Richard M. Stallman <rms@gnu.org>
parents: 75884
diff changeset
2437 (t :foreground "medium blue"))
65084
87a66a9a9328 (minibuffer-prompt): Doc fix.
Juri Linkov <juri@jurta.org>
parents: 65068
diff changeset
2438 "Face for minibuffer prompts.
87a66a9a9328 (minibuffer-prompt): Doc fix.
Juri Linkov <juri@jurta.org>
parents: 65068
diff changeset
2439 By default, Emacs automatically adds this face to the value of
87a66a9a9328 (minibuffer-prompt): Doc fix.
Juri Linkov <juri@jurta.org>
parents: 65068
diff changeset
2440 `minibuffer-prompt-properties', which is a list of text properties
87a66a9a9328 (minibuffer-prompt): Doc fix.
Juri Linkov <juri@jurta.org>
parents: 65068
diff changeset
2441 used to display the prompt text."
59996
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 59872
diff changeset
2442 :version "22.1"
42298
d020b569f212 (minibuffer-prompt): New face.
Richard M. Stallman <rms@gnu.org>
parents: 40456
diff changeset
2443 :group 'basic-faces)
d020b569f212 (minibuffer-prompt): New face.
Richard M. Stallman <rms@gnu.org>
parents: 40456
diff changeset
2444
d020b569f212 (minibuffer-prompt): New face.
Richard M. Stallman <rms@gnu.org>
parents: 40456
diff changeset
2445 (setq minibuffer-prompt-properties
d020b569f212 (minibuffer-prompt): New face.
Richard M. Stallman <rms@gnu.org>
parents: 40456
diff changeset
2446 (append minibuffer-prompt-properties (list 'face 'minibuffer-prompt)))
d020b569f212 (minibuffer-prompt): New face.
Richard M. Stallman <rms@gnu.org>
parents: 40456
diff changeset
2447
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2448 (defface fringe
29943
b8314fd10792 (fringe): Change face for different backgrounds.
Gerd Moellmann <gerd@gnu.org>
parents: 29880
diff changeset
2449 '((((class color) (background light))
43711
d15360503e4e (face-spec-choose): Allow `t' to appear before the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43550
diff changeset
2450 :background "grey95")
d15360503e4e (face-spec-choose): Allow `t' to appear before the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43550
diff changeset
2451 (((class color) (background dark))
d15360503e4e (face-spec-choose): Allow `t' to appear before the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43550
diff changeset
2452 :background "grey10")
d15360503e4e (face-spec-choose): Allow `t' to appear before the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43550
diff changeset
2453 (t
d15360503e4e (face-spec-choose): Allow `t' to appear before the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43550
diff changeset
2454 :background "gray"))
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2455 "Basic face for the fringes to the left and right of windows under X."
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2456 :version "21.1"
27716
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
2457 :group 'frames
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2458 :group 'basic-faces)
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2459
70178
667cd756c089 (scroll-bar, border, cursor, mouse): Avoid nil spec in defface.
Luc Teirlinck <teirllm@auburn.edu>
parents: 68651
diff changeset
2460 (defface scroll-bar '((t nil))
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2461 "Basic face for the scroll bar colors under X."
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2462 :version "21.1"
27716
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
2463 :group 'frames
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2464 :group 'basic-faces)
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2465
70178
667cd756c089 (scroll-bar, border, cursor, mouse): Avoid nil spec in defface.
Luc Teirlinck <teirllm@auburn.edu>
parents: 68651
diff changeset
2466 (defface border '((t nil))
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2467 "Basic face for the frame border under X."
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2468 :version "21.1"
27716
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
2469 :group 'frames
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2470 :group 'basic-faces)
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2471
70178
667cd756c089 (scroll-bar, border, cursor, mouse): Avoid nil spec in defface.
Luc Teirlinck <teirllm@auburn.edu>
parents: 68651
diff changeset
2472 (defface cursor '((t nil))
57105
8f14c8ea51a1 (cursor): Add face-no-inherit property. Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 55902
diff changeset
2473 "Basic face for the cursor color under X.
8f14c8ea51a1 (cursor): Add face-no-inherit property. Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 55902
diff changeset
2474 Note: Other faces cannot inherit from the cursor face."
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2475 :version "21.1"
27716
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
2476 :group 'cursor
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2477 :group 'basic-faces)
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2478
57105
8f14c8ea51a1 (cursor): Add face-no-inherit property. Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 55902
diff changeset
2479 (put 'cursor 'face-no-inherit t)
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2480
70178
667cd756c089 (scroll-bar, border, cursor, mouse): Avoid nil spec in defface.
Luc Teirlinck <teirllm@auburn.edu>
parents: 68651
diff changeset
2481 (defface mouse '((t nil))
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2482 "Basic face for the mouse color under X."
25137
1bee9402f747 (bitmap-area): Add :version.
Dave Love <fx@gnu.org>
parents: 25090
diff changeset
2483 :version "21.1"
27716
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
2484 :group 'mouse
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2485 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2486
65730
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2487 (defface tool-bar
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2488 '((default
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2489 :box (:line-width 1 :style released-button)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2490 :foreground "black")
97043
9592c50233ab Remove support for Mac Carbon.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 96675
diff changeset
2491 (((type x w32 ns) (class color))
65730
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2492 :background "grey75")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2493 (((type x) (class mono))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2494 :background "grey"))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2495 "Basic tool-bar face."
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2496 :version "21.1"
25687
afad62240679 (mode-line, header-line, tool-bar, ): Add :version.
Dave Love <fx@gnu.org>
parents: 25650
diff changeset
2497 :group 'basic-faces)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2498
65730
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2499 (defface menu
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2500 '((((type tty))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2501 :inverse-video t)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2502 (((type x-toolkit))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2503 )
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2504 (t
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2505 :inverse-video t))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2506 "Basic face for the font and colors of the menu bar and popup menus."
25687
afad62240679 (mode-line, header-line, tool-bar, ): Add :version.
Dave Love <fx@gnu.org>
parents: 25650
diff changeset
2507 :version "21.1"
65730
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2508 :group 'menu
25687
afad62240679 (mode-line, header-line, tool-bar, ): Add :version.
Dave Love <fx@gnu.org>
parents: 25650
diff changeset
2509 :group 'basic-faces)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2510
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2511
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2512 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2513 ;;; Manipulating font names.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2514 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2515
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2516 ;; This is here for compatibilty with Emacs 20.2. For example,
28907
6d7ba0ba3bc3 Declare more functions obsolete.
Dave Love <fx@gnu.org>
parents: 28849
diff changeset
2517 ;; international/fontset.el uses x-resolve-font-name. The following
6d7ba0ba3bc3 Declare more functions obsolete.
Dave Love <fx@gnu.org>
parents: 28849
diff changeset
2518 ;; functions are not used in the face implementation itself.
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2519
16687
049c87a96dca Change defconsts to defvars.
Richard M. Stallman <rms@gnu.org>
parents: 16590
diff changeset
2520 (defvar x-font-regexp nil)
049c87a96dca Change defconsts to defvars.
Richard M. Stallman <rms@gnu.org>
parents: 16590
diff changeset
2521 (defvar x-font-regexp-head nil)
049c87a96dca Change defconsts to defvars.
Richard M. Stallman <rms@gnu.org>
parents: 16590
diff changeset
2522 (defvar x-font-regexp-weight nil)
049c87a96dca Change defconsts to defvars.
Richard M. Stallman <rms@gnu.org>
parents: 16590
diff changeset
2523 (defvar x-font-regexp-slant nil)
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2524
12668
7660e82d0346 (x-font-regexp-weight-subnum, x-font-regexp-slant-subnum)
Karl Heuer <kwzh@gnu.org>
parents: 12651
diff changeset
2525 (defconst x-font-regexp-weight-subnum 1)
7660e82d0346 (x-font-regexp-weight-subnum, x-font-regexp-slant-subnum)
Karl Heuer <kwzh@gnu.org>
parents: 12651
diff changeset
2526 (defconst x-font-regexp-slant-subnum 2)
7660e82d0346 (x-font-regexp-weight-subnum, x-font-regexp-slant-subnum)
Karl Heuer <kwzh@gnu.org>
parents: 12651
diff changeset
2527 (defconst x-font-regexp-swidth-subnum 3)
7660e82d0346 (x-font-regexp-weight-subnum, x-font-regexp-slant-subnum)
Karl Heuer <kwzh@gnu.org>
parents: 12651
diff changeset
2528 (defconst x-font-regexp-adstyle-subnum 4)
7660e82d0346 (x-font-regexp-weight-subnum, x-font-regexp-slant-subnum)
Karl Heuer <kwzh@gnu.org>
parents: 12651
diff changeset
2529
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2530 ;;; Regexps matching font names in "Host Portable Character Representation."
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2531 ;;;
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2532 (let ((- "[-?]")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2533 (foundry "[^-]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2534 (family "[^-]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2535 (weight "\\(bold\\|demibold\\|medium\\)") ; 1
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2536 ; (weight\? "\\(\\*\\|bold\\|demibold\\|medium\\|\\)") ; 1
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2537 (weight\? "\\([^-]*\\)") ; 1
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2538 (slant "\\([ior]\\)") ; 2
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2539 ; (slant\? "\\([ior?*]?\\)") ; 2
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2540 (slant\? "\\([^-]?\\)") ; 2
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2541 ; (swidth "\\(\\*\\|normal\\|semicondensed\\|\\)") ; 3
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2542 (swidth "\\([^-]*\\)") ; 3
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2543 ; (adstyle "\\(\\*\\|sans\\|\\)") ; 4
12690
e2d3fa52d100 (x-font-regexp): Add \\(\\) for substring extraction.
Karl Heuer <kwzh@gnu.org>
parents: 12668
diff changeset
2544 (adstyle "\\([^-]*\\)") ; 4
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2545 (pixelsize "[0-9]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2546 (pointsize "[0-9][0-9]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2547 (resx "[0-9][0-9]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2548 (resy "[0-9][0-9]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2549 (spacing "[cmp?*]")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2550 (avgwidth "[0-9]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2551 (registry "[^-]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2552 (encoding "[^-]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2553 )
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2554 (setq x-font-regexp
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2555 (concat "\\`\\*?[-?*]"
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2556 foundry - family - weight\? - slant\? - swidth - adstyle -
12475
eb436b0c4ab3 (x-font-regexp): Include the avgwidth.
Richard M. Stallman <rms@gnu.org>
parents: 12460
diff changeset
2557 pixelsize - pointsize - resx - resy - spacing - avgwidth -
eb436b0c4ab3 (x-font-regexp): Include the avgwidth.
Richard M. Stallman <rms@gnu.org>
parents: 12460
diff changeset
2558 registry - encoding "\\*?\\'"
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2559 ))
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2560 (setq x-font-regexp-head
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2561 (concat "\\`[-?*]" foundry - family - weight\? - slant\?
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2562 "\\([-*?]\\|\\'\\)"))
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2563 (setq x-font-regexp-slant (concat - slant -))
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2564 (setq x-font-regexp-weight (concat - weight -))
28840
d0531e35d9f2 Some doc fixes.
Dave Love <fx@gnu.org>
parents: 28214
diff changeset
2565 nil)
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2566
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2567
3071
68de05fb5751 * faces.el (set-face-font): Call x-resolve-font-name on the font
Jim Blandy <jimb@redhat.com>
parents: 3049
diff changeset
2568 (defun x-resolve-font-name (pattern &optional face frame)
68de05fb5751 * faces.el (set-face-font): Call x-resolve-font-name on the font
Jim Blandy <jimb@redhat.com>
parents: 3049
diff changeset
2569 "Return a font name matching PATTERN.
28849
76e727bc0dfd Fix make-obsolete for internal-get-face.
Dave Love <fx@gnu.org>
parents: 28840
diff changeset
2570 All wildcards in PATTERN are instantiated.
3130
82c29bacb6b3 * faces.el (x-resolve-font-name): If PATTERN is nil, return the
Jim Blandy <jimb@redhat.com>
parents: 3071
diff changeset
2571 If PATTERN is nil, return the name of the frame's base font, which never
82c29bacb6b3 * faces.el (x-resolve-font-name): If PATTERN is nil, return the
Jim Blandy <jimb@redhat.com>
parents: 3071
diff changeset
2572 contains wildcards.
10170
5fc240a3e4a0 (face-initialize): Test for framep not t or nil.
Richard M. Stallman <rms@gnu.org>
parents: 10107
diff changeset
2573 Given optional arguments FACE and FRAME, return a font which is
5fc240a3e4a0 (face-initialize): Test for framep not t or nil.
Richard M. Stallman <rms@gnu.org>
parents: 10107
diff changeset
2574 also the same size as FACE on FRAME, or fail."
3233
28b2df35c33e (x-resolve-font-name): Allow symbol as FACE arg.
Richard M. Stallman <rms@gnu.org>
parents: 3182
diff changeset
2575 (or (symbolp face)
28b2df35c33e (x-resolve-font-name): Allow symbol as FACE arg.
Richard M. Stallman <rms@gnu.org>
parents: 3182
diff changeset
2576 (setq face (face-name face)))
28b2df35c33e (x-resolve-font-name): Allow symbol as FACE arg.
Richard M. Stallman <rms@gnu.org>
parents: 3182
diff changeset
2577 (and (eq frame t)
28b2df35c33e (x-resolve-font-name): Allow symbol as FACE arg.
Richard M. Stallman <rms@gnu.org>
parents: 3182
diff changeset
2578 (setq frame nil))
3130
82c29bacb6b3 * faces.el (x-resolve-font-name): If PATTERN is nil, return the
Jim Blandy <jimb@redhat.com>
parents: 3071
diff changeset
2579 (if pattern
5092
36508a7c0a3f (x-resolve-font-name): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 5081
diff changeset
2580 ;; Note that x-list-fonts has code to handle a face with nil as its font.
16002
c8cbde1d3f11 (internal-set-face-1): When calling x-list-fonts, ask for just one match.
Richard M. Stallman <rms@gnu.org>
parents: 15884
diff changeset
2581 (let ((fonts (x-list-fonts pattern face frame 1)))
3130
82c29bacb6b3 * faces.el (x-resolve-font-name): If PATTERN is nil, return the
Jim Blandy <jimb@redhat.com>
parents: 3071
diff changeset
2582 (or fonts
82c29bacb6b3 * faces.el (x-resolve-font-name): If PATTERN is nil, return the
Jim Blandy <jimb@redhat.com>
parents: 3071
diff changeset
2583 (if face
10584
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
2584 (if (string-match "\\*" pattern)
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
2585 (if (null (face-font face))
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
2586 (error "No matching fonts are the same height as the frame default font")
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
2587 (error "No matching fonts are the same height as face `%s'" face))
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
2588 (if (null (face-font face))
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
2589 (error "Height of font `%s' doesn't match the frame default font"
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
2590 pattern)
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
2591 (error "Height of font `%s' doesn't match face `%s'"
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
2592 pattern face)))
3353
8cbd38886eef (x-resolve-font-name): Clean up error messages.
Richard M. Stallman <rms@gnu.org>
parents: 3298
diff changeset
2593 (error "No fonts match `%s'" pattern)))
3130
82c29bacb6b3 * faces.el (x-resolve-font-name): If PATTERN is nil, return the
Jim Blandy <jimb@redhat.com>
parents: 3071
diff changeset
2594 (car fonts))
82c29bacb6b3 * faces.el (x-resolve-font-name): If PATTERN is nil, return the
Jim Blandy <jimb@redhat.com>
parents: 3071
diff changeset
2595 (cdr (assq 'font (frame-parameters (selected-frame))))))
3071
68de05fb5751 * faces.el (set-face-font): Call x-resolve-font-name on the font
Jim Blandy <jimb@redhat.com>
parents: 3049
diff changeset
2596
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2597
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2598 (defun x-frob-font-weight (font which)
13704
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
2599 (let ((case-fold-search t))
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
2600 (cond ((string-match x-font-regexp font)
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
2601 (concat (substring font 0
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
2602 (match-beginning x-font-regexp-weight-subnum))
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
2603 which
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
2604 (substring font (match-end x-font-regexp-weight-subnum)
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
2605 (match-beginning x-font-regexp-adstyle-subnum))
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
2606 ;; Replace the ADD_STYLE_NAME field with *
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
2607 ;; because the info in it may not be the same
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
2608 ;; for related fonts.
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
2609 "*"
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
2610 (substring font (match-end x-font-regexp-adstyle-subnum))))
14880
b405f39b5493 (x-frob-font-slant): Properly handle a match against
Richard M. Stallman <rms@gnu.org>
parents: 14409
diff changeset
2611 ((string-match x-font-regexp-head font)
b405f39b5493 (x-frob-font-slant): Properly handle a match against
Richard M. Stallman <rms@gnu.org>
parents: 14409
diff changeset
2612 (concat (substring font 0 (match-beginning 1)) which
b405f39b5493 (x-frob-font-slant): Properly handle a match against
Richard M. Stallman <rms@gnu.org>
parents: 14409
diff changeset
2613 (substring font (match-end 1))))
b405f39b5493 (x-frob-font-slant): Properly handle a match against
Richard M. Stallman <rms@gnu.org>
parents: 14409
diff changeset
2614 ((string-match x-font-regexp-weight font)
13704
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
2615 (concat (substring font 0 (match-beginning 1)) which
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
2616 (substring font (match-end 1)))))))
29354
4ed4a700358b Update calls to make-obsolete with a WHEN argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28907
diff changeset
2617 (make-obsolete 'x-frob-font-weight 'make-face-... "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2618
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2619 (defun x-frob-font-slant (font which)
13704
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
2620 (let ((case-fold-search t))
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
2621 (cond ((string-match x-font-regexp font)
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
2622 (concat (substring font 0
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
2623 (match-beginning x-font-regexp-slant-subnum))
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
2624 which
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
2625 (substring font (match-end x-font-regexp-slant-subnum)
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
2626 (match-beginning x-font-regexp-adstyle-subnum))
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
2627 ;; Replace the ADD_STYLE_NAME field with *
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
2628 ;; because the info in it may not be the same
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
2629 ;; for related fonts.
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
2630 "*"
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
2631 (substring font (match-end x-font-regexp-adstyle-subnum))))
14880
b405f39b5493 (x-frob-font-slant): Properly handle a match against
Richard M. Stallman <rms@gnu.org>
parents: 14409
diff changeset
2632 ((string-match x-font-regexp-head font)
b405f39b5493 (x-frob-font-slant): Properly handle a match against
Richard M. Stallman <rms@gnu.org>
parents: 14409
diff changeset
2633 (concat (substring font 0 (match-beginning 2)) which
b405f39b5493 (x-frob-font-slant): Properly handle a match against
Richard M. Stallman <rms@gnu.org>
parents: 14409
diff changeset
2634 (substring font (match-end 2))))
b405f39b5493 (x-frob-font-slant): Properly handle a match against
Richard M. Stallman <rms@gnu.org>
parents: 14409
diff changeset
2635 ((string-match x-font-regexp-slant font)
13704
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
2636 (concat (substring font 0 (match-beginning 1)) which
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
2637 (substring font (match-end 1)))))))
29354
4ed4a700358b Update calls to make-obsolete with a WHEN argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28907
diff changeset
2638 (make-obsolete 'x-frob-font-slant 'make-face-... "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2639
40351
a44d4a7dd8de (internal-get-face): Use facep instead of the obsolete
Eli Zaretskii <eliz@gnu.org>
parents: 39830
diff changeset
2640 ;; These aliases are here so that we don't get warnings about obsolete
a44d4a7dd8de (internal-get-face): Use facep instead of the obsolete
Eli Zaretskii <eliz@gnu.org>
parents: 39830
diff changeset
2641 ;; functions from the byte compiler.
a44d4a7dd8de (internal-get-face): Use facep instead of the obsolete
Eli Zaretskii <eliz@gnu.org>
parents: 39830
diff changeset
2642 (defalias 'internal-frob-font-weight 'x-frob-font-weight)
a44d4a7dd8de (internal-get-face): Use facep instead of the obsolete
Eli Zaretskii <eliz@gnu.org>
parents: 39830
diff changeset
2643 (defalias 'internal-frob-font-slant 'x-frob-font-slant)
a44d4a7dd8de (internal-get-face): Use facep instead of the obsolete
Eli Zaretskii <eliz@gnu.org>
parents: 39830
diff changeset
2644
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2645 (defun x-make-font-bold (font)
4439
e7ab04f23df5 Make boldness and italicness affect subsequently created frames.
Richard M. Stallman <rms@gnu.org>
parents: 4122
diff changeset
2646 "Given an X font specification, make a bold version of it.
e7ab04f23df5 Make boldness and italicness affect subsequently created frames.
Richard M. Stallman <rms@gnu.org>
parents: 4122
diff changeset
2647 If that can't be done, return nil."
40351
a44d4a7dd8de (internal-get-face): Use facep instead of the obsolete
Eli Zaretskii <eliz@gnu.org>
parents: 39830
diff changeset
2648 (internal-frob-font-weight font "bold"))
29354
4ed4a700358b Update calls to make-obsolete with a WHEN argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28907
diff changeset
2649 (make-obsolete 'x-make-font-bold 'make-face-bold "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2650
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2651 (defun x-make-font-demibold (font)
4439
e7ab04f23df5 Make boldness and italicness affect subsequently created frames.
Richard M. Stallman <rms@gnu.org>
parents: 4122
diff changeset
2652 "Given an X font specification, make a demibold version of it.
e7ab04f23df5 Make boldness and italicness affect subsequently created frames.
Richard M. Stallman <rms@gnu.org>
parents: 4122
diff changeset
2653 If that can't be done, return nil."
40351
a44d4a7dd8de (internal-get-face): Use facep instead of the obsolete
Eli Zaretskii <eliz@gnu.org>
parents: 39830
diff changeset
2654 (internal-frob-font-weight font "demibold"))
29354
4ed4a700358b Update calls to make-obsolete with a WHEN argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28907
diff changeset
2655 (make-obsolete 'x-make-font-demibold 'make-face-bold "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2656
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2657 (defun x-make-font-unbold (font)
4439
e7ab04f23df5 Make boldness and italicness affect subsequently created frames.
Richard M. Stallman <rms@gnu.org>
parents: 4122
diff changeset
2658 "Given an X font specification, make a non-bold version of it.
e7ab04f23df5 Make boldness and italicness affect subsequently created frames.
Richard M. Stallman <rms@gnu.org>
parents: 4122
diff changeset
2659 If that can't be done, return nil."
40351
a44d4a7dd8de (internal-get-face): Use facep instead of the obsolete
Eli Zaretskii <eliz@gnu.org>
parents: 39830
diff changeset
2660 (internal-frob-font-weight font "medium"))
29354
4ed4a700358b Update calls to make-obsolete with a WHEN argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28907
diff changeset
2661 (make-obsolete 'x-make-font-unbold 'make-face-unbold "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2662
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2663 (defun x-make-font-italic (font)
4439
e7ab04f23df5 Make boldness and italicness affect subsequently created frames.
Richard M. Stallman <rms@gnu.org>
parents: 4122
diff changeset
2664 "Given an X font specification, make an italic version of it.
e7ab04f23df5 Make boldness and italicness affect subsequently created frames.
Richard M. Stallman <rms@gnu.org>
parents: 4122
diff changeset
2665 If that can't be done, return nil."
40351
a44d4a7dd8de (internal-get-face): Use facep instead of the obsolete
Eli Zaretskii <eliz@gnu.org>
parents: 39830
diff changeset
2666 (internal-frob-font-slant font "i"))
29354
4ed4a700358b Update calls to make-obsolete with a WHEN argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28907
diff changeset
2667 (make-obsolete 'x-make-font-italic 'make-face-italic "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2668
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2669 (defun x-make-font-oblique (font) ; you say tomayto...
4439
e7ab04f23df5 Make boldness and italicness affect subsequently created frames.
Richard M. Stallman <rms@gnu.org>
parents: 4122
diff changeset
2670 "Given an X font specification, make an oblique version of it.
e7ab04f23df5 Make boldness and italicness affect subsequently created frames.
Richard M. Stallman <rms@gnu.org>
parents: 4122
diff changeset
2671 If that can't be done, return nil."
40351
a44d4a7dd8de (internal-get-face): Use facep instead of the obsolete
Eli Zaretskii <eliz@gnu.org>
parents: 39830
diff changeset
2672 (internal-frob-font-slant font "o"))
29354
4ed4a700358b Update calls to make-obsolete with a WHEN argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28907
diff changeset
2673 (make-obsolete 'x-make-font-oblique 'make-face-italic "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2674
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2675 (defun x-make-font-unitalic (font)
4439
e7ab04f23df5 Make boldness and italicness affect subsequently created frames.
Richard M. Stallman <rms@gnu.org>
parents: 4122
diff changeset
2676 "Given an X font specification, make a non-italic version of it.
e7ab04f23df5 Make boldness and italicness affect subsequently created frames.
Richard M. Stallman <rms@gnu.org>
parents: 4122
diff changeset
2677 If that can't be done, return nil."
40351
a44d4a7dd8de (internal-get-face): Use facep instead of the obsolete
Eli Zaretskii <eliz@gnu.org>
parents: 39830
diff changeset
2678 (internal-frob-font-slant font "r"))
29354
4ed4a700358b Update calls to make-obsolete with a WHEN argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28907
diff changeset
2679 (make-obsolete 'x-make-font-unitalic 'make-face-unitalic "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2680
17752
2687f3d7c191 (x-make-font-bold-italic): New function.
Kenichi Handa <handa@m17n.org>
parents: 17560
diff changeset
2681 (defun x-make-font-bold-italic (font)
2687f3d7c191 (x-make-font-bold-italic): New function.
Kenichi Handa <handa@m17n.org>
parents: 17560
diff changeset
2682 "Given an X font specification, make a bold and italic version of it.
2687f3d7c191 (x-make-font-bold-italic): New function.
Kenichi Handa <handa@m17n.org>
parents: 17560
diff changeset
2683 If that can't be done, return nil."
40351
a44d4a7dd8de (internal-get-face): Use facep instead of the obsolete
Eli Zaretskii <eliz@gnu.org>
parents: 39830
diff changeset
2684 (and (setq font (internal-frob-font-weight font "bold"))
a44d4a7dd8de (internal-get-face): Use facep instead of the obsolete
Eli Zaretskii <eliz@gnu.org>
parents: 39830
diff changeset
2685 (internal-frob-font-slant font "i")))
29354
4ed4a700358b Update calls to make-obsolete with a WHEN argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28907
diff changeset
2686 (make-obsolete 'x-make-font-bold-italic 'make-face-bold-italic "21.1")
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2687
2715
9caee9338229 * faces.el: Call internal-set-face-1, not internat-set-face-1.
Jim Blandy <jimb@redhat.com>
parents: 2714
diff changeset
2688 (provide 'faces)
9caee9338229 * faces.el: Call internal-set-face-1, not internat-set-face-1.
Jim Blandy <jimb@redhat.com>
parents: 2714
diff changeset
2689
63382
9cbfa983c1cf (read-face-name): Use complete-in-turn complete non-aliases
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 63311
diff changeset
2690 ;; arch-tag: 19a4759f-2963-445f-b004-425b9aadd7d6
28840
d0531e35d9f2 Some doc fixes.
Dave Love <fx@gnu.org>
parents: 28214
diff changeset
2691 ;;; faces.el ends here