annotate lisp/faces.el @ 98688:19eaf7a7f803

*** empty log message ***
author Eli Zaretskii <eliz@gnu.org>
date Mon, 13 Oct 2008 11:24:22 +0000
parents f19f5a4863df
children a962df9a86fb
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,
79721
73661ddc7ac7 Add 2008 to copyright years.
Glenn Morris <rgm@gnu.org>
parents: 79651
diff changeset
4 ;; 2002, 2003, 2004, 2005, 2006, 2007, 2008 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)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
52 "*A list specifying how face font selection chooses fonts.
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")
abc9f7184a8c (fixed-pitch): Use "Monospace" family.
Chong Yidong <cyd@stupidchicken.com>
parents: 96079
diff changeset
73 ("courier" "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"))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
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")))
33371
8259eb8d96c2 (face-font-registry-alternatives): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents: 33008
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")))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
306 "*List of X resources and classes for face attributes.
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."
31439
d7a98f35b441 (set-face-attribute): Simplify by calling
Gerd Moellmann <gerd@gnu.org>
parents: 31401
diff changeset
708 (let ((where (if (null frame) 0 frame)))
d7a98f35b441 (set-face-attribute): Simplify by calling
Gerd Moellmann <gerd@gnu.org>
parents: 31401
diff changeset
709 (setq args (purecopy args))
51280
c2efaecb5d8f (set-face-attribute): Set face-modified prop to t
Richard M. Stallman <rms@gnu.org>
parents: 51248
diff changeset
710 ;; 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
711 (if (memq where '(0 t))
63660
47c90f7c23df (face-documentation, set-face-attribute)
Glenn Morris <rgm@gnu.org>
parents: 63650
diff changeset
712 (put (or (get face 'face-alias) face) 'face-modified t))
31439
d7a98f35b441 (set-face-attribute): Simplify by calling
Gerd Moellmann <gerd@gnu.org>
parents: 31401
diff changeset
713 (while args
66360
fcb2ec449238 (inhibit-face-set-after-frame-default): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 66351
diff changeset
714 ;; Don't recursively set the attributes from the frame's font param
96079
efbaf6995245 * w32fns.c, xfns.c (Qfont_param): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 96074
diff changeset
715 ;; when we update the frame's font param from the attributes.
96398
36c91bfee166 (inhibit-face-set-after-frame-default): Var deleted.
Chong Yidong <cyd@stupidchicken.com>
parents: 96292
diff changeset
716 (if (and (eq (car args) :family)
36c91bfee166 (inhibit-face-set-after-frame-default): Var deleted.
Chong Yidong <cyd@stupidchicken.com>
parents: 96292
diff changeset
717 (stringp (cadr args))
36c91bfee166 (inhibit-face-set-after-frame-default): Var deleted.
Chong Yidong <cyd@stupidchicken.com>
parents: 96292
diff changeset
718 (string-match "\\([^-]*\\)-\\([^-]*\\)" (cadr args)))
36c91bfee166 (inhibit-face-set-after-frame-default): Var deleted.
Chong Yidong <cyd@stupidchicken.com>
parents: 96292
diff changeset
719 (let ((foundry (match-string 1 (cadr args)))
36c91bfee166 (inhibit-face-set-after-frame-default): Var deleted.
Chong Yidong <cyd@stupidchicken.com>
parents: 96292
diff changeset
720 (family (match-string 2 (cadr args))))
36c91bfee166 (inhibit-face-set-after-frame-default): Var deleted.
Chong Yidong <cyd@stupidchicken.com>
parents: 96292
diff changeset
721 (internal-set-lisp-face-attribute face :foundry
36c91bfee166 (inhibit-face-set-after-frame-default): Var deleted.
Chong Yidong <cyd@stupidchicken.com>
parents: 96292
diff changeset
722 (purecopy foundry)
36c91bfee166 (inhibit-face-set-after-frame-default): Var deleted.
Chong Yidong <cyd@stupidchicken.com>
parents: 96292
diff changeset
723 where)
36c91bfee166 (inhibit-face-set-after-frame-default): Var deleted.
Chong Yidong <cyd@stupidchicken.com>
parents: 96292
diff changeset
724 (internal-set-lisp-face-attribute face :family
36c91bfee166 (inhibit-face-set-after-frame-default): Var deleted.
Chong Yidong <cyd@stupidchicken.com>
parents: 96292
diff changeset
725 (purecopy family)
36c91bfee166 (inhibit-face-set-after-frame-default): Var deleted.
Chong Yidong <cyd@stupidchicken.com>
parents: 96292
diff changeset
726 where))
36c91bfee166 (inhibit-face-set-after-frame-default): Var deleted.
Chong Yidong <cyd@stupidchicken.com>
parents: 96292
diff changeset
727 (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
728 (purecopy (cadr args))
36c91bfee166 (inhibit-face-set-after-frame-default): Var deleted.
Chong Yidong <cyd@stupidchicken.com>
parents: 96292
diff changeset
729 where))
31439
d7a98f35b441 (set-face-attribute): Simplify by calling
Gerd Moellmann <gerd@gnu.org>
parents: 31401
diff changeset
730 (setq args (cdr (cdr args))))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
731
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
732
26337
6bf33b333eb2 (make-face-bold, make-face-unbold, make-face-italic)
Gerd Moellmann <gerd@gnu.org>
parents: 25947
diff changeset
733 (defun make-face-bold (face &optional frame noerror)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
734 "Make the font of FACE be bold, if possible.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
735 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
736 Argument NOERROR is ignored and retained for compatibility.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
737 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
738 (interactive (list (read-face-name "Make which face bold")))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
739 (set-face-attribute face frame :weight 'bold))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
740
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
741
26337
6bf33b333eb2 (make-face-bold, make-face-unbold, make-face-italic)
Gerd Moellmann <gerd@gnu.org>
parents: 25947
diff changeset
742 (defun make-face-unbold (face &optional frame noerror)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
743 "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
744 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
745 Argument NOERROR is ignored and retained for compatibility."
40456
1f5aee41efe9 (read-face-name): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents: 40454
diff changeset
746 (interactive (list (read-face-name "Make which face non-bold")))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
747 (set-face-attribute face frame :weight 'normal))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
748
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
749
26337
6bf33b333eb2 (make-face-bold, make-face-unbold, make-face-italic)
Gerd Moellmann <gerd@gnu.org>
parents: 25947
diff changeset
750 (defun make-face-italic (face &optional frame noerror)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
751 "Make the font of FACE be italic, if possible.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
752 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
753 Argument NOERROR is ignored and retained for compatibility.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
754 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
755 (interactive (list (read-face-name "Make which face italic")))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
756 (set-face-attribute face frame :slant 'italic))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
757
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
758
26337
6bf33b333eb2 (make-face-bold, make-face-unbold, make-face-italic)
Gerd Moellmann <gerd@gnu.org>
parents: 25947
diff changeset
759 (defun make-face-unitalic (face &optional frame noerror)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
760 "Make the font of FACE be non-italic, if possible.
28840
d0531e35d9f2 Some doc fixes.
Dave Love <fx@gnu.org>
parents: 28214
diff changeset
761 FRAME nil or not specified means change face on all frames.
d0531e35d9f2 Some doc fixes.
Dave Love <fx@gnu.org>
parents: 28214
diff changeset
762 Argument NOERROR is ignored and retained for compatibility."
40456
1f5aee41efe9 (read-face-name): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents: 40454
diff changeset
763 (interactive (list (read-face-name "Make which face non-italic")))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
764 (set-face-attribute face frame :slant 'normal))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
765
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
766
26337
6bf33b333eb2 (make-face-bold, make-face-unbold, make-face-italic)
Gerd Moellmann <gerd@gnu.org>
parents: 25947
diff changeset
767 (defun make-face-bold-italic (face &optional frame noerror)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
768 "Make the font of FACE be bold and italic, if possible.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
769 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
770 Argument NOERROR is ignored and retained for compatibility.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
771 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
772 (interactive (list (read-face-name "Make which face bold-italic")))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
773 (set-face-attribute face frame :weight 'bold :slant 'italic))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
774
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
775
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
776 (defun set-face-font (face font &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
777 "Change font-related attributes of FACE to those of FONT (a string).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
778 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
779 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
780 `: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
781 prompt for the face and font."
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
782 (interactive (read-face-and-attribute :font))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
783 (set-face-attribute face frame :font font))
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 ;; Implementation note: Emulating gray background colors with a
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
787 ;; stipple pattern is now part of the face realization process, and is
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
788 ;; 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
789
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
790 (defun set-face-background (face color &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
791 "Change the background color of face FACE to COLOR (a string).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
792 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
793 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
794 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
795 When called interactively, prompts for the face and color."
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
796 (interactive (read-face-and-attribute :background))
36060
d9b4d1370073 (set-face-background, set-face-foreground)
Miles Bader <miles@gnu.org>
parents: 36035
diff changeset
797 (set-face-attribute face frame :background (or color 'unspecified)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
798
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-foreground (face color &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
801 "Change the foreground 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 :foreground))
36060
d9b4d1370073 (set-face-background, set-face-foreground)
Miles Bader <miles@gnu.org>
parents: 36035
diff changeset
807 (set-face-attribute face frame :foreground (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-stipple (face stipple &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
811 "Change the stipple pixmap of face FACE to STIPPLE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
812 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
813 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
814 The directories listed in the `x-bitmap-file-path' variable are searched.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
815
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
816 Alternatively, STIPPLE may be a list of the form (WIDTH HEIGHT DATA)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
817 where WIDTH and HEIGHT are the size in pixels,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
818 and DATA is a string, containing the raw bits of the bitmap."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
819 (interactive (read-face-and-attribute :stipple))
36060
d9b4d1370073 (set-face-background, set-face-foreground)
Miles Bader <miles@gnu.org>
parents: 36035
diff changeset
820 (set-face-attribute face frame :stipple (or stipple 'unspecified)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
821
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
822
75591
a0f90fb2d33d (set-face-underline-p, modify-face): Rename arg UNDERLINE-P
Juanma Barranquero <lekktu@gmail.com>
parents: 75579
diff changeset
823 (defun set-face-underline-p (face underline &optional frame)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
824 "Specify whether face FACE is underlined.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
825 UNDERLINE nil means FACE explicitly doesn't underline.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
826 UNDERLINE non-nil means FACE explicitly does underlining
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
827 with the same of the foreground color.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
828 If UNDERLINE is a string, underline with the color named UNDERLINE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
829 FRAME nil or not specified means change face on all frames.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
830 Use `set-face-attribute' to ``unspecify'' underlining."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
831 (interactive
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
832 (let ((list (read-face-and-attribute :underline)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
833 (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
834 (set-face-attribute face frame :underline underline))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
835
65068
6606e83775f0 (set-face-underline): Delete this duplicate function
Juri Linkov <juri@jurta.org>
parents: 64762
diff changeset
836 (define-obsolete-function-alias 'set-face-underline
6606e83775f0 (set-face-underline): Delete this duplicate function
Juri Linkov <juri@jurta.org>
parents: 64762
diff changeset
837 'set-face-underline-p "22.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
838
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
839
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
840 (defun set-face-inverse-video-p (face inverse-video-p &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
841 "Specify whether face FACE is in inverse video.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
842 INVERSE-VIDEO-P non-nil means FACE displays explicitly in inverse video.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
843 INVERSE-VIDEO-P nil means FACE explicitly is not in inverse video.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
844 FRAME nil or not specified means change face on all frames.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
845 Use `set-face-attribute' to ``unspecify'' the inverse video attribute."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
846 (interactive
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
847 (let ((list (read-face-and-attribute :inverse-video)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
848 (list (car list) (eq (car (cdr list)) t))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
849 (set-face-attribute face frame :inverse-video inverse-video-p))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
850
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
851
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
852 (defun set-face-bold-p (face bold-p &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
853 "Specify whether face FACE is bold.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
854 BOLD-P non-nil means FACE should explicitly display bold.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
855 BOLD-P nil means FACE should explicitly display non-bold.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
856 FRAME nil or not specified means change face on all frames.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
857 Use `set-face-attribute' or `modify-face' for finer control."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
858 (if (null bold-p)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
859 (make-face-unbold face frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
860 (make-face-bold face frame)))
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
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
863 (defun set-face-italic-p (face italic-p &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
864 "Specify whether face FACE is italic.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
865 ITALIC-P non-nil means FACE should explicitly display italic.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
866 ITALIC-P nil means FACE should explicitly display non-italic.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
867 FRAME nil or not specified means change face on all frames.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
868 Use `set-face-attribute' or `modify-face' for finer control."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
869 (if (null italic-p)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
870 (make-face-unitalic face frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
871 (make-face-italic face frame)))
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
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
874 (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
875
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
876
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
877 (defun invert-face (face &optional frame)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
878 "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
879 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
880 If FACE specifies neither foreground nor background color,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
881 set its foreground and background to the background and foreground
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
882 of the default face. Value is FACE."
40456
1f5aee41efe9 (read-face-name): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents: 40454
diff changeset
883 (interactive (list (read-face-name "Invert face")))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
884 (let ((fg (face-attribute face :foreground frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
885 (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
886 (if (not (and (eq fg 'unspecified) (eq bg 'unspecified)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
887 (set-face-attribute face frame :foreground bg :background fg)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
888 (set-face-attribute face frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
889 :foreground
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
890 (face-attribute 'default :background frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
891 :background
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
892 (face-attribute 'default :foreground frame))))
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
893 face)
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
894
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
895
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
896 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
897 ;;; Interactively modifying faces.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
898 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
899
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
900 (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
901 "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
902 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
903 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
904 it should not end in a space.
defa6bf31164 (read-face-name): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 71521
diff changeset
905 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
906 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
907 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
908 Otherwise, return a single face."
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
909 (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
910 (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
911 (aliasfaces nil)
9cbfa983c1cf (read-face-name): Use complete-in-turn complete non-aliases
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 63311
diff changeset
912 (nonaliasfaces nil)
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
913 faces)
63984
37ff9b4c3659 (read-face-name): Put the code for getting a face name
Juri Linkov <juri@jurta.org>
parents: 63881
diff changeset
914 ;; 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
915 (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
916 (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
917 ;; 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
918 (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
919 ;; 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
920 (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
921 (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
922 (dolist (f faceprop)
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
923 (if (symbolp f)
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
924 (push f faces)))
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
925 (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
926 (push faceprop faces)))
64724
719375653e09 (read-face-name): Delete duplicate faces.
Juri Linkov <juri@jurta.org>
parents: 64539
diff changeset
927 (delete-dups faces)
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
928
63382
9cbfa983c1cf (read-face-name): Use complete-in-turn complete non-aliases
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 63311
diff changeset
929 ;; 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
930 (mapatoms (lambda (s)
9cbfa983c1cf (read-face-name): Use complete-in-turn complete non-aliases
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 63311
diff changeset
931 (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
932 (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
933 (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
934 (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
935
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
936 ;; 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
937 ;; discard the unwanted ones now.
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
938 (unless multiple
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
939 (if faces
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
940 (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
941 (require 'crm)
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
942 (let* ((input
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
943 ;; 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
944 (completing-read-multiple
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
945 (if (or faces string-describing-default)
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
946 (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
947 (if faces (mapconcat 'symbol-name faces ",")
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
948 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
949 (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
950 (completion-table-in-turn nonaliasfaces aliasfaces)
96435
414b3d1e76df (face-name-history): New variable.
Juri Linkov <juri@jurta.org>
parents: 96398
diff changeset
951 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
952 (if faces (mapconcat 'symbol-name faces ","))))
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
953 ;; Canonicalize the output.
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
954 (output
63984
37ff9b4c3659 (read-face-name): Put the code for getting a face name
Juri Linkov <juri@jurta.org>
parents: 63881
diff changeset
955 (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
956 faces)
37ff9b4c3659 (read-face-name): Put the code for getting a face name
Juri Linkov <juri@jurta.org>
parents: 63881
diff changeset
957 ((stringp input)
37ff9b4c3659 (read-face-name): Put the code for getting a face name
Juri Linkov <juri@jurta.org>
parents: 63881
diff changeset
958 (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
959 ((listp input)
37ff9b4c3659 (read-face-name): Put the code for getting a face name
Juri Linkov <juri@jurta.org>
parents: 63881
diff changeset
960 (mapcar 'intern input))
37ff9b4c3659 (read-face-name): Put the code for getting a face name
Juri Linkov <juri@jurta.org>
parents: 63881
diff changeset
961 (input))))
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
962 ;; 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
963 (if multiple
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
964 output
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
965 (car output)))))
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
966
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
967 ;; 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
968 (defvar x-bitmap-file-path)
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
969
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
970 (defun face-valid-attribute-values (attribute &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
971 "Return valid values for face attribute ATTRIBUTE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
972 The optional argument FRAME is used to determine available fonts
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
973 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
974 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
975 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
976 an integer value."
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
977 (let ((valid
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
978 (case attribute
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
979 (:family
83004
7900111db01c Converted display hooks to be display-local. Plus many bugfixes.
Karoly Lorentey <lorentey@elte.hu>
parents: 52401
diff changeset
980 (if (window-system frame)
97325
85f30f831ede (face-valid-attribute-values): Fix handling the value
Kenichi Handa <handa@m17n.org>
parents: 97048
diff changeset
981 (mapcar #'(lambda (x) (cons (symbol-name x) x))
94956
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
982 (font-family-list))
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
983 ;; Only one font on TTYs.
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
984 (list (cons "default" "default"))))
95862
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
985 (:foundry
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
986 (list nil))
94956
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
987 (:width
97325
85f30f831ede (face-valid-attribute-values): Fix handling the value
Kenichi Handa <handa@m17n.org>
parents: 97048
diff changeset
988 (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
989 font-width-table))
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
990 (:weight
97325
85f30f831ede (face-valid-attribute-values): Fix handling the value
Kenichi Handa <handa@m17n.org>
parents: 97048
diff changeset
991 (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
992 font-weight-table))
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
993 (:slant
97325
85f30f831ede (face-valid-attribute-values): Fix handling the value
Kenichi Handa <handa@m17n.org>
parents: 97048
diff changeset
994 (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
995 font-slant-table))
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
996 (:inverse-video
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
997 (mapcar #'(lambda (x) (cons (symbol-name x) x))
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
998 (internal-lisp-face-attribute-values attribute)))
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
999 ((: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
1000 (if (window-system frame)
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1001 (nconc (mapcar #'(lambda (x) (cons (symbol-name x) x))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1002 (internal-lisp-face-attribute-values attribute))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1003 (mapcar #'(lambda (c) (cons c c))
75703
374c5b932d28 (face-valid-attribute-values): Use `defined-colors',
Juanma Barranquero <lekktu@gmail.com>
parents: 75696
diff changeset
1004 (defined-colors frame)))
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1005 (mapcar #'(lambda (x) (cons (symbol-name x) x))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1006 (internal-lisp-face-attribute-values attribute))))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1007 ((:foreground :background)
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1008 (mapcar #'(lambda (c) (cons c c))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1009 (defined-colors frame)))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1010 ((:height)
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1011 'integerp)
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1012 (:stipple
97043
9592c50233ab Remove support for Mac Carbon.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 96675
diff changeset
1013 (and (memq (window-system frame) '(x w32 ns))
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1014 (mapcar #'list
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1015 (apply #'nconc
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1016 (mapcar (lambda (dir)
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1017 (and (file-readable-p dir)
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1018 (file-directory-p dir)
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1019 (directory-files dir)))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1020 x-bitmap-file-path)))))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1021 (:inherit
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1022 (cons '("none" . nil)
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1023 (mapcar #'(lambda (c) (cons (symbol-name c) c))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1024 (face-list))))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1025 (t
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1026 (error "Internal error")))))
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1027 (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
1028 (nconc (list (cons "unspecified" 'unspecified)) valid)
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
1029 valid)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1030
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1031
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1032 (defvar face-attribute-name-alist
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1033 '((:family . "font family")
95862
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
1034 (:foundry . "font foundry")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1035 (:width . "character set width")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1036 (:height . "height in 1/10 pt")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1037 (:weight . "weight")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1038 (:slant . "slant")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1039 (:underline . "underline")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1040 (:overline . "overline")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1041 (:strike-through . "strike-through")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1042 (:box . "box")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1043 (:inverse-video . "inverse-video display")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1044 (:foreground . "foreground color")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1045 (:background . "background color")
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1046 (:stipple . "background stipple")
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1047 (:inherit . "inheritance"))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1048 "An alist of descriptive names for face attributes.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1049 Each element has the form (ATTRIBUTE-NAME . DESCRIPTION) where
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1050 ATTRIBUTE-NAME is a face attribute name (a keyword symbol), and
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1051 DESCRIPTION is a descriptive name for ATTRIBUTE-NAME.")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1052
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1053
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1054 (defun face-descriptive-attribute-name (attribute)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1055 "Return a descriptive name for ATTRIBUTE."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1056 (cdr (assq attribute face-attribute-name-alist)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1057
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1058
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1059 (defun face-read-string (face default name &optional completion-alist)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1060 "Interactively read a face attribute string value.
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1061 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
1062 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
1063 descriptive name of the attribute for prompting. COMPLETION-ALIST is an
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1064 alist of valid values, if non-nil.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1065
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1066 Entering nothing accepts the default string DEFAULT.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1067 Value is the new attribute value."
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1068 ;; Capitalize NAME (we don't use `capitalize' because that capitalizes
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1069 ;; each word in a string separately).
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1070 (setq name (concat (upcase (substring name 0 1)) (substring name 1)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1071 (let* ((completion-ignore-case t)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1072 (value (completing-read
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1073 (if default
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1074 (format "%s for face `%s' (default %s): "
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1075 name face default)
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1076 (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
1077 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
1078 (if (equal value "") default value)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1079
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1080
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1081 (defun face-read-integer (face default name)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1082 "Interactively read an integer face attribute value.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1083 FACE is the face whose attribute is read. DEFAULT is the default
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1084 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
1085 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
1086 (let ((new-value
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
1087 (face-read-string face
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1088 (format "%s" default)
25245
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
1089 name
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
1090 (list (cons "unspecified" 'unspecified)))))
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1091 (cond ((equal new-value "unspecified")
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1092 'unspecified)
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1093 ((member new-value '("unspecified-fg" "unspecified-bg"))
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1094 new-value)
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1095 (t
62402
a7e02ef1e3d6 Replace `string-to-int' by `string-to-number'.
Juanma Barranquero <lekktu@gmail.com>
parents: 62386
diff changeset
1096 (string-to-number new-value)))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1097
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1098
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1099 (defun read-face-attribute (face attribute &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1100 "Interactively read a new value for FACE's ATTRIBUTE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1101 Optional argument FRAME nil or unspecified means read an attribute value
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1102 of a global face. Value is the new attribute value."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1103 (let* ((old-value (face-attribute face attribute frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1104 (attribute-name (face-descriptive-attribute-name attribute))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1105 (valid (face-valid-attribute-values attribute frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1106 new-value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1107 ;; Represent complex attribute values as strings by printing them
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1108 ;; out. Stipple can be a vector; (WIDTH HEIGHT DATA). Box can be
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1109 ;; a list `(:width WIDTH :color COLOR)' or `(:width WIDTH :shadow
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1110 ;; SHADOW)'.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1111 (when (and (or (eq attribute :stipple)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1112 (eq attribute :box))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1113 (or (consp old-value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1114 (vectorp old-value)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1115 (setq old-value (prin1-to-string old-value)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1116 (cond ((listp valid)
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1117 (let ((default
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1118 (or (car (rassoc old-value valid))
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1119 (format "%s" old-value))))
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1120 (setq new-value
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1121 (face-read-string face default attribute-name valid))
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1122 (if (equal new-value default)
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1123 ;; Nothing changed, so don't bother with all the stuff
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1124 ;; below. In particular, this avoids a non-tty color
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1125 ;; from being canonicalized for a tty when the user
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1126 ;; just uses the default.
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1127 (setq new-value old-value)
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1128 ;; Terminal frames can support colors that don't appear
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1129 ;; explicitly in VALID, using color approximation code
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1130 ;; 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
1131 (when (and (memq attribute '(:foreground :background))
97043
9592c50233ab Remove support for Mac Carbon.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 96675
diff changeset
1132 (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
1133 (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
1134 '("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
1135 "unspecified-fg" "unspecified-bg"))))
34587
Miles Bader <miles@gnu.org>
parents: 34585
diff changeset
1136 (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
1137 (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
1138 (setq new-value (cdr (assoc new-value valid)))))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1139 ((eq valid 'integerp)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1140 (setq new-value (face-read-integer face old-value attribute-name)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1141 (t (error "Internal error")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1142 ;; 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
1143 ;; vector if it looks like one. This makes the assumption that a
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1144 ;; pixmap file name won't start with an open-paren.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1145 (when (and (or (eq attribute :stipple)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1146 (eq attribute :box))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1147 (stringp new-value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1148 (string-match "^[[(]" new-value))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1149 (setq new-value (read new-value)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1150 new-value))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1151
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1152 (declare-function fontset-list "fontset.c" ())
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1153 (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
1154 (pattern &optional face frame maximum width))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1155
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1156 (defun read-face-font (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1157 "Read the name of a font for FACE on FRAME.
64539
c94d5f576885 (describe-face): "?\ " -> "?\s".
Juanma Barranquero <lekktu@gmail.com>
parents: 64497
diff changeset
1158 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
1159 (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
1160 (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
1161 (append (fontset-list) (x-list-fonts "*" nil frame)))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1162
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1163
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1164 (defun read-all-face-attributes (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1165 "Interactively read all attributes for FACE.
64539
c94d5f576885 (describe-face): "?\ " -> "?\s".
Juanma Barranquero <lekktu@gmail.com>
parents: 64497
diff changeset
1166 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
1167 Value is a property list of attribute names and new values."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1168 (let (result)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1169 (dolist (attribute face-attribute-name-alist result)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1170 (setq result (cons (car attribute)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1171 (cons (read-face-attribute face (car attribute) frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1172 result))))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1173
37467
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1174 (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
1175 bold-p italic-p underline inverse-p frame)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1176 "Modify attributes of faces interactively.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1177 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
1178 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
1179 For non-interactive use, `set-face-attribute' is preferred.
64539
c94d5f576885 (describe-face): "?\ " -> "?\s".
Juanma Barranquero <lekktu@gmail.com>
parents: 64497
diff changeset
1180 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
1181 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
1182 (interactive)
37467
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1183 (if face
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1184 (set-face-attribute face frame
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1185 :foreground (or foreground 'unspecified)
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1186 :background (or background 'unspecified)
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1187 :stipple stipple
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1188 :bold bold-p
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1189 :italic italic-p
75591
a0f90fb2d33d (set-face-underline-p, modify-face): Rename arg UNDERLINE-P
Juanma Barranquero <lekktu@gmail.com>
parents: 75579
diff changeset
1190 :underline underline
37467
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1191 :inverse-video inverse-p)
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1192 (setq face (read-face-name "Modify face"))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1193 (apply #'set-face-attribute face frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1194 (read-all-face-attributes face frame))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1195
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1196 (defun read-face-and-attribute (attribute &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1197 "Read face name and face attribute value.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1198 ATTRIBUTE is the attribute whose new value is read.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1199 FRAME nil or unspecified means read attribute value of global face.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1200 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
1201 \(a symbol), and NEW-VALUE is value read."
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1202 (cond ((eq attribute :font)
31197
39d437913f44 (read-face-font, read-face-and-attribute): Tweak prompts.
Miles Bader <miles@gnu.org>
parents: 31193
diff changeset
1203 (let* ((prompt "Set font-related attributes of face")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1204 (face (read-face-name prompt))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1205 (font (read-face-font face frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1206 (list face font)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1207 (t
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1208 (let* ((attribute-name (face-descriptive-attribute-name attribute))
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1209 (prompt (format "Set %s of face" attribute-name))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1210 (face (read-face-name prompt))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1211 (new-value (read-face-attribute face attribute frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1212 (list face new-value)))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1213
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1214
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1215
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1216 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1217 ;;; Listing faces.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1218 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1219
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1220 (defvar list-faces-sample-text
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1221 "abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ"
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1222 "*Text string to display as the sample text for `list-faces-display'.")
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 ;; 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
1226 ;; conflict with Lucid, which uses that name differently.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1227
48914
bb52f186fa1e (help-xref-stack): Add defvar to avoid warning.
Richard M. Stallman <rms@gnu.org>
parents: 48713
diff changeset
1228 (defvar help-xref-stack)
59872
d7da3e10bfef (list-faces-display): Add optional argument.
Richard M. Stallman <rms@gnu.org>
parents: 59281
diff changeset
1229 (defun list-faces-display (&optional regexp)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1230 "List all faces, using the same sample text in each.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1231 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
1232 `list-faces-sample-text'.
d7da3e10bfef (list-faces-display): Add optional argument.
Richard M. Stallman <rms@gnu.org>
parents: 59281
diff changeset
1233
d7da3e10bfef (list-faces-display): Add optional argument.
Richard M. Stallman <rms@gnu.org>
parents: 59281
diff changeset
1234 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
1235 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
1236 arg, prompt for a regular expression."
d7da3e10bfef (list-faces-display): Add optional argument.
Richard M. Stallman <rms@gnu.org>
parents: 59281
diff changeset
1237 (interactive (list (and current-prefix-arg
96435
414b3d1e76df (face-name-history): New variable.
Juri Linkov <juri@jurta.org>
parents: 96398
diff changeset
1238 (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
1239 (let ((all-faces (zerop (length regexp)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1240 (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
1241 (max-length 0)
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1242 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
1243 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
1244 ;; 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
1245 (setq faces
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1246 (delq nil
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1247 (mapcar (lambda (f)
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1248 (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
1249 (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
1250 (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
1251 f)))
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1252 (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
1253 (unless faces
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1254 (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
1255 (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
1256 line-format (format "%%-%ds" max-length))
86010
d42c1cd75af4 (list-faces-display, describe-face):
Martin Rudalics <rudalics@gmx.at>
parents: 85996
diff changeset
1257 (with-help-window "*Faces*"
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1258 (save-excursion
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1259 (set-buffer standard-output)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1260 (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
1261 (insert
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1262 (substitute-command-keys
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1263 (concat
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1264 "Use "
27736
b4d0a1247b35 (list-faces-display): Use display-mouse-p, not window-system.
Eli Zaretskii <eliz@gnu.org>
parents: 27716
diff changeset
1265 (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
1266 "\\[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
1267 "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
1268 (setq help-xref-stack nil)
59872
d7da3e10bfef (list-faces-display): Add optional argument.
Richard M. Stallman <rms@gnu.org>
parents: 59281
diff changeset
1269 (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
1270 (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
1271 (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
1272 ;; 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
1273 ;; 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
1274 (save-excursion
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1275 (save-match-data
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1276 (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
1277 (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
1278 (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
1279 (let ((beg (point))
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1280 (line-beg (line-beginning-position)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1281 (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
1282 ;; 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
1283 (save-excursion
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1284 (save-match-data
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1285 (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
1286 (help-xref-button 0 'help-face face)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1287 (insert "\n")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1288 (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
1289 ;; 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
1290 ;; anywhere in the line.
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1291 (put-text-property line-beg (1- (point)) 'read-face-name face)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1292 ;; If the sample text has multiple lines, line up all of them.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1293 (goto-char beg)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1294 (forward-line 1)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1295 (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
1296 (insert-char ?\s max-length)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1297 (forward-line 1))))
86010
d42c1cd75af4 (list-faces-display, describe-face):
Martin Rudalics <rudalics@gmx.at>
parents: 85996
diff changeset
1298 (goto-char (point-min))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1299 ;; If the *Faces* buffer appears in a different frame,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1300 ;; copy all the face definitions from FRAME,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1301 ;; so that the display will reflect the frame that was selected.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1302 (setq window (get-buffer-window (get-buffer "*Faces*") t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1303 (setq disp-frame (if window (window-frame window)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1304 (car (frame-list))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1305 (or (eq frame disp-frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1306 (let ((faces (face-list)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1307 (while faces
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1308 (copy-face (car faces) (car faces) frame disp-frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1309 (setq faces (cdr faces)))))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1310
59872
d7da3e10bfef (list-faces-display): Add optional argument.
Richard M. Stallman <rms@gnu.org>
parents: 59281
diff changeset
1311
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1312 (defun describe-face (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1313 "Display the properties of face FACE on FRAME.
45314
d752ae89321a (describe-face): Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents: 45255
diff changeset
1314 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
1315 and FRAME defaults to the selected frame.
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1316
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1317 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
1318 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
1319 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
1320 (interactive (list (read-face-name "Describe face" "= `default' face" t)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1321 (let* ((attrs '((:family . "Family")
95862
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
1322 (:foundry . "Foundry")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1323 (:width . "Width")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1324 (:height . "Height")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1325 (:weight . "Weight")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1326 (:slant . "Slant")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1327 (:foreground . "Foreground")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1328 (:background . "Background")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1329 (:underline . "Underline")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1330 (:overline . "Overline")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1331 (:strike-through . "Strike-through")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1332 (:box . "Box")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1333 (:inverse-video . "Inverse")
28214
73c16c6e401e (read-face-font): Fix TABLE arg to completing-read.
Kenichi Handa <handa@m17n.org>
parents: 27928
diff changeset
1334 (:stipple . "Stipple")
89129
ed1d9d1cfc71 (describe-face): Describe :fontset property too.
Kenichi Handa <handa@m17n.org>
parents: 43550
diff changeset
1335 (:font . "Font")
ed1d9d1cfc71 (describe-face): Describe :fontset property too.
Kenichi Handa <handa@m17n.org>
parents: 43550
diff changeset
1336 (:fontset . "Fontset")
31179
354c781f2864 (describe-face): Add support for :inherit attribute.
Miles Bader <miles@gnu.org>
parents: 30971
diff changeset
1337 (:inherit . "Inherit")))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1338 (max-width (apply #'max (mapcar #'(lambda (x) (length (cdr x)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1339 attrs))))
39830
aed9c3afb7ed (describe-face): Call help-setup-xref earlier.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39799
diff changeset
1340 (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
1341 (unless face
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1342 (setq face 'default))
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1343 (if (not (listp face))
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1344 (setq face (list face)))
86010
d42c1cd75af4 (list-faces-display, describe-face):
Martin Rudalics <rudalics@gmx.at>
parents: 85996
diff changeset
1345 (with-help-window (help-buffer)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1346 (save-excursion
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1347 (set-buffer standard-output)
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1348 (dolist (f face)
85297
01f68ac2fb98 (describe-face): Allow handling a string as the face name.
Juri Linkov <juri@jurta.org>
parents: 85272
diff changeset
1349 (if (stringp f) (setq f (intern f)))
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1350 (insert "Face: " (symbol-name f))
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1351 (if (not (facep f))
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1352 (insert " undefined face.\n")
62386
3eeae124dcab (describe-face): Output a definition link button.
Richard M. Stallman <rms@gnu.org>
parents: 61481
diff changeset
1353 (let ((customize-label "customize this face")
3eeae124dcab (describe-face): Output a definition link button.
Richard M. Stallman <rms@gnu.org>
parents: 61481
diff changeset
1354 file-name)
73668
1d779fbeeaef (faces-sample-overlay, describe-face): Revert last changes.
Eli Zaretskii <eliz@gnu.org>
parents: 73580
diff changeset
1355 (insert (concat " (" (propertize "sample" 'font-lock-face f) ")"))
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1356 (princ (concat " (" customize-label ")\n"))
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1357 (insert "Documentation: "
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1358 (or (face-documentation f)
46041
53b3233b2574 (describe-face): Capitalize "not documented" message.
Juanma Barranquero <lekktu@gmail.com>
parents: 45722
diff changeset
1359 "Not documented as a face.")
62386
3eeae124dcab (describe-face): Output a definition link button.
Richard M. Stallman <rms@gnu.org>
parents: 61481
diff changeset
1360 "\n")
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1361 (with-current-buffer standard-output
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1362 (save-excursion
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1363 (re-search-backward
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1364 (concat "\\(" customize-label "\\)") nil t)
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1365 (help-xref-button 1 'help-customize-face f)))
97917
9632e46fbdc6 (describe-face): Use find-lisp-object-file-name instead
Martin Rudalics <rudalics@gmx.at>
parents: 97325
diff changeset
1366 (setq file-name (find-lisp-object-file-name f 'defface))
62386
3eeae124dcab (describe-face): Output a definition link button.
Richard M. Stallman <rms@gnu.org>
parents: 61481
diff changeset
1367 (when file-name
3eeae124dcab (describe-face): Output a definition link button.
Richard M. Stallman <rms@gnu.org>
parents: 61481
diff changeset
1368 (princ "Defined in `")
98320
738bf2e7b7f5 (describe-face): Print relative file name in help buffer.
Martin Rudalics <rudalics@gmx.at>
parents: 97917
diff changeset
1369 (princ (file-name-nondirectory file-name))
62386
3eeae124dcab (describe-face): Output a definition link button.
Richard M. Stallman <rms@gnu.org>
parents: 61481
diff changeset
1370 (princ "'")
3eeae124dcab (describe-face): Output a definition link button.
Richard M. Stallman <rms@gnu.org>
parents: 61481
diff changeset
1371 ;; Make a hyperlink to the library.
3eeae124dcab (describe-face): Output a definition link button.
Richard M. Stallman <rms@gnu.org>
parents: 61481
diff changeset
1372 (save-excursion
3eeae124dcab (describe-face): Output a definition link button.
Richard M. Stallman <rms@gnu.org>
parents: 61481
diff changeset
1373 (re-search-backward "`\\([^`']+\\)'" nil t)
3eeae124dcab (describe-face): Output a definition link button.
Richard M. Stallman <rms@gnu.org>
parents: 61481
diff changeset
1374 (help-xref-button 1 'help-face-def f file-name))
3eeae124dcab (describe-face): Output a definition link button.
Richard M. Stallman <rms@gnu.org>
parents: 61481
diff changeset
1375 (princ ".")
3eeae124dcab (describe-face): Output a definition link button.
Richard M. Stallman <rms@gnu.org>
parents: 61481
diff changeset
1376 (terpri)
3eeae124dcab (describe-face): Output a definition link button.
Richard M. Stallman <rms@gnu.org>
parents: 61481
diff changeset
1377 (terpri))
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1378 (dolist (a attrs)
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1379 (let ((attr (face-attribute f (car a) frame)))
64539
c94d5f576885 (describe-face): "?\ " -> "?\s".
Juanma Barranquero <lekktu@gmail.com>
parents: 64497
diff changeset
1380 (insert (make-string (- max-width (length (cdr a))) ?\s)
65068
6606e83775f0 (set-face-underline): Delete this duplicate function
Juri Linkov <juri@jurta.org>
parents: 64762
diff changeset
1381 (cdr a) ": " (format "%s" attr))
6606e83775f0 (set-face-underline): Delete this duplicate function
Juri Linkov <juri@jurta.org>
parents: 64762
diff changeset
1382 (if (and (eq (car a) :inherit)
6606e83775f0 (set-face-underline): Delete this duplicate function
Juri Linkov <juri@jurta.org>
parents: 64762
diff changeset
1383 (not (eq attr 'unspecified)))
6606e83775f0 (set-face-underline): Delete this duplicate function
Juri Linkov <juri@jurta.org>
parents: 64762
diff changeset
1384 ;; Make a hyperlink to the parent face.
6606e83775f0 (set-face-underline): Delete this duplicate function
Juri Linkov <juri@jurta.org>
parents: 64762
diff changeset
1385 (save-excursion
6606e83775f0 (set-face-underline): Delete this duplicate function
Juri Linkov <juri@jurta.org>
parents: 64762
diff changeset
1386 (re-search-backward ": \\([^:]+\\)" nil t)
6606e83775f0 (set-face-underline): Delete this duplicate function
Juri Linkov <juri@jurta.org>
parents: 64762
diff changeset
1387 (help-xref-button 1 'help-face attr)))
6606e83775f0 (set-face-underline): Delete this duplicate function
Juri Linkov <juri@jurta.org>
parents: 64762
diff changeset
1388 (insert "\n")))))
86010
d42c1cd75af4 (list-faces-display, describe-face):
Martin Rudalics <rudalics@gmx.at>
parents: 85996
diff changeset
1389 (terpri))))))
39799
99f30ac48ec0 (list-faces-display, describe-face): Fix args to `help-xref-button'.
Miles Bader <miles@gnu.org>
parents: 39549
diff changeset
1390
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1391
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1392 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1393 ;;; Face specifications (defface).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1394 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1395
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1396 ;; Parameter FRAME Is kept for call compatibility to with previous
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1397 ;; face implementation.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1398
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1399 (defun face-attr-construct (face &optional frame)
64539
c94d5f576885 (describe-face): "?\ " -> "?\s".
Juanma Barranquero <lekktu@gmail.com>
parents: 64497
diff changeset
1400 "Return a `defface'-style attribute list for FACE on FRAME.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1401 Value is a property list of pairs ATTRIBUTE VALUE for all specified
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1402 face attributes of FACE where ATTRIBUTE is the attribute name and
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1403 VALUE is the specified value of that attribute."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1404 (let (result)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1405 (dolist (entry face-attribute-name-alist result)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1406 (let* ((attribute (car entry))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1407 (value (face-attribute face attribute)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1408 (unless (eq value 'unspecified)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1409 (setq result (nconc (list attribute value) result)))))))
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1410
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1411
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1412 (defun face-spec-set-match-display (display frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1413 "Non-nil if DISPLAY matches FRAME.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1414 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
1415 If FRAME is nil, the current FRAME is used."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1416 (let* ((conjuncts display)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1417 conjunct req options
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1418 ;; t means we have succeeded against all the conjuncts in
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1419 ;; DISPLAY that have been tested so far.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1420 (match t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1421 (if (eq conjuncts t)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1422 (setq conjuncts nil))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1423 (while (and conjuncts match)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1424 (setq conjunct (car conjuncts)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1425 conjuncts (cdr conjuncts)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1426 req (car conjunct)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1427 options (cdr conjunct)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1428 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
1429 (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
1430 ;; 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
1431 ;; 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
1432 ;; 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
1433 ;; 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
1434 ;; 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
1435 ;; 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
1436 (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
1437 (memq 'tty options))
25887
099a3776ff00 (face-spec-set-match-display): Recognize `type' of
Gerd Moellmann <gerd@gnu.org>
parents: 25814
diff changeset
1438 (and (memq 'motif options)
099a3776ff00 (face-spec-set-match-display): Recognize `type' of
Gerd Moellmann <gerd@gnu.org>
parents: 25814
diff changeset
1439 (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
1440 (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
1441 (featurep 'gtk))
25887
099a3776ff00 (face-spec-set-match-display): Recognize `type' of
Gerd Moellmann <gerd@gnu.org>
parents: 25814
diff changeset
1442 (and (memq 'lucid options)
099a3776ff00 (face-spec-set-match-display): Recognize `type' of
Gerd Moellmann <gerd@gnu.org>
parents: 25814
diff changeset
1443 (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
1444 (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
1445 (not (featurep 'gtk)))
25887
099a3776ff00 (face-spec-set-match-display): Recognize `type' of
Gerd Moellmann <gerd@gnu.org>
parents: 25814
diff changeset
1446 (and (memq 'x-toolkit options)
099a3776ff00 (face-spec-set-match-display): Recognize `type' of
Gerd Moellmann <gerd@gnu.org>
parents: 25814
diff changeset
1447 (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
1448 ((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
1449 (>= (display-color-cells frame) (car options)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1450 ((eq req 'class)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1451 (memq (frame-parameter frame 'display-type) options))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1452 ((eq req 'background)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1453 (memq (frame-parameter frame 'background-mode)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1454 options))
45722
c553d91619aa (display-supports-face-attributes-p): Work correctly if DISPLAY is a frame.
Miles Bader <miles@gnu.org>
parents: 45717
diff changeset
1455 ((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
1456 (display-supports-face-attributes-p options frame))
28840
d0531e35d9f2 Some doc fixes.
Dave Love <fx@gnu.org>
parents: 28214
diff changeset
1457 (t (error "Unknown req `%S' with options `%S'"
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1458 req options)))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1459 match))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1460
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1461
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1462 (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
1463 "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
1464 If SPEC is nil, return nil."
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1465 (unless frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1466 (setq frame (selected-frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1467 (let ((tail spec)
58935
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1468 result defaults)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1469 (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
1470 (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
1471 (display (car entry))
58935
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1472 (attrs (cdr entry))
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1473 thisval)
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1474 ;; 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
1475 (setq thisval
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1476 (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
1477 ;; 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
1478 ;; first element.
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1479 (car attrs)
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1480 attrs))
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1481
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1482 ;; 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
1483 ;; for following conditions.
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1484 (if (eq display 'default)
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1485 (setq defaults thisval)
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1486 ;; Otherwise, if it matches, use it.
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1487 (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
1488 (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
1489 (setq tail nil)))))
58935
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1490 (if defaults (append result defaults) result)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1491
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1492
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1493 (defun face-spec-reset-face (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1494 "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
1495 (let ((attrs face-attribute-name-alist))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1496 (while attrs
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1497 (let ((attr-and-name (car attrs)))
31401
0b8165a82e34 (set-face-attribute, face-spec-reset-face)
Gerd Moellmann <gerd@gnu.org>
parents: 31197
diff changeset
1498 (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
1499 (setq attrs (cdr attrs)))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1500
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1501
87483
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1502 (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
1503 "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
1504 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
1505 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
1506 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
1507 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
1508 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
1509
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1510 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
1511 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
1512 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
1513
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1514 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
1515 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
1516 That usage is deprecated.
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1517
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1518 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
1519 (if (framep for-defface)
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1520 ;; 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
1521 (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
1522 (if for-defface
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1523 ;; 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
1524 ;; 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
1525 (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
1526 ;; 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
1527 ;; 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
1528 (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
1529 ;;; RMS 29 dec 2007: Perhaps this code should be reinstated.
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1530 ;;; That depends on whether the overriding spec
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1531 ;;; or the default face attributes
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1532 ;;; should take priority.
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1533 ;;; ;; Clear all the new-frame default attributes for this face.
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1534 ;;; ;; face-spec-reset-face won't do it right.
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1535 ;;; (let ((facevec (cdr (assq face face-new-frame-defaults))))
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1536 ;;; (dotimes (i (length facevec))
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1537 ;;; (unless (= i 0)
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1538 ;;; (aset facevec i 'unspecified))))
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1539 ;; 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
1540 (dolist (frame (frame-list))
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1541 (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
1542
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1543 (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
1544 "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
1545 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
1546 then the override spec."
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1547 (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
1548 (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
1549 (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
1550 (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
1551 (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
1552 (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
1553 (dolist (spec theme-faces)
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1554 (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
1555 (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
1556
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1557 (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
1558 "Set the face attributes of FACE on FRAME according to SPEC."
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1559 (let* ((attrs (face-spec-choose spec frame)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1560 (while attrs
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1561 (let ((attribute (car attrs))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1562 (value (car (cdr attrs))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1563 ;; Support some old-style attribute names and values.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1564 (case attribute
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1565 (:bold (setq attribute :weight value (if value 'bold 'normal)))
30010
281fa98f5c87 (face-spec-set): Ignore invalid attributes like 20.x.
Gerd Moellmann <gerd@gnu.org>
parents: 29976
diff changeset
1566 (:italic (setq attribute :slant value (if value 'italic 'normal)))
34682
4130c0ad0a5e (face-spec-set): Interpret a nil in specs for
Gerd Moellmann <gerd@gnu.org>
parents: 34587
diff changeset
1567 ((:foreground :background)
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1568 ;; Compatibility with 20.x. Some bogus face specs seem to
34682
4130c0ad0a5e (face-spec-set): Interpret a nil in specs for
Gerd Moellmann <gerd@gnu.org>
parents: 34587
diff changeset
1569 ;; exist containing things like `:foreground nil'.
4130c0ad0a5e (face-spec-set): Interpret a nil in specs for
Gerd Moellmann <gerd@gnu.org>
parents: 34587
diff changeset
1570 (if (null value) (setq value 'unspecified)))
30010
281fa98f5c87 (face-spec-set): Ignore invalid attributes like 20.x.
Gerd Moellmann <gerd@gnu.org>
parents: 29976
diff changeset
1571 (t (unless (assq attribute face-x-resources)
281fa98f5c87 (face-spec-set): Ignore invalid attributes like 20.x.
Gerd Moellmann <gerd@gnu.org>
parents: 29976
diff changeset
1572 (setq attribute nil))))
281fa98f5c87 (face-spec-set): Ignore invalid attributes like 20.x.
Gerd Moellmann <gerd@gnu.org>
parents: 29976
diff changeset
1573 (when attribute
31401
0b8165a82e34 (set-face-attribute, face-spec-reset-face)
Gerd Moellmann <gerd@gnu.org>
parents: 31197
diff changeset
1574 (set-face-attribute face frame attribute value)))
87483
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1575 (setq attrs (cdr (cdr attrs))))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1576
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1577 (defun face-attr-match-p (face attrs &optional frame)
30971
9a23751378f3 (face-attr-match-p):
Miles Bader <miles@gnu.org>
parents: 30306
diff changeset
1578 "Return t if attributes of FACE match values in plist ATTRS.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1579 Optional parameter FRAME is the frame whose definition of FACE
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1580 is used. If nil or omitted, use the selected frame."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1581 (unless frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1582 (setq frame (selected-frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1583 (let ((list face-attribute-name-alist)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1584 (match t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1585 (while (and match (not (null list)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1586 (let* ((attr (car (car list)))
30971
9a23751378f3 (face-attr-match-p):
Miles Bader <miles@gnu.org>
parents: 30306
diff changeset
1587 (specified-value
9a23751378f3 (face-attr-match-p):
Miles Bader <miles@gnu.org>
parents: 30306
diff changeset
1588 (if (plist-member attrs attr)
9a23751378f3 (face-attr-match-p):
Miles Bader <miles@gnu.org>
parents: 30306
diff changeset
1589 (plist-get attrs attr)
9a23751378f3 (face-attr-match-p):
Miles Bader <miles@gnu.org>
parents: 30306
diff changeset
1590 'unspecified))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1591 (value-now (face-attribute face attr frame)))
30971
9a23751378f3 (face-attr-match-p):
Miles Bader <miles@gnu.org>
parents: 30306
diff changeset
1592 (setq match (equal specified-value value-now))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1593 (setq list (cdr list))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1594 match))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1595
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1596 (defun face-spec-match-p (face spec &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1597 "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
1598 (face-attr-match-p face (face-spec-choose spec frame) frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1599
32795
975cc2648ee4 (face-default-spec, face-user-default-spec): Make defsubsts.
Miles Bader <miles@gnu.org>
parents: 32758
diff changeset
1600 (defsubst face-default-spec (face)
975cc2648ee4 (face-default-spec, face-user-default-spec): Make defsubsts.
Miles Bader <miles@gnu.org>
parents: 32758
diff changeset
1601 "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
1602 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
1603 (get face 'face-defface-spec))
975cc2648ee4 (face-default-spec, face-user-default-spec): Make defsubsts.
Miles Bader <miles@gnu.org>
parents: 32758
diff changeset
1604
975cc2648ee4 (face-default-spec, face-user-default-spec): Make defsubsts.
Miles Bader <miles@gnu.org>
parents: 32758
diff changeset
1605 (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
1606 "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
1607 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
1608 (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
1609 (get face 'saved-face)
32795
975cc2648ee4 (face-default-spec, face-user-default-spec): Make defsubsts.
Miles Bader <miles@gnu.org>
parents: 32758
diff changeset
1610 (face-default-spec face)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1611
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1612
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1613 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26736
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1614 ;;; 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
1615 ;;; 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
1616 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1617
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1618 (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
1619 "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
1620 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
1621 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
1622 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
1623 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
1624 (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
1625 (xw-defined-colors frame)
27090
52e469fb402a (read-face-attribute, defined-colors, color-defined-p):
Eli Zaretskii <eliz@gnu.org>
parents: 26927
diff changeset
1626 (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
1627 (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
1628
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1629 (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
1630
26736
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1631 (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
1632 "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
1633 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
1634 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
1635 \"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
1636 (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
1637 nil
97043
9592c50233ab Remove support for Mac Carbon.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 96675
diff changeset
1638 (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
1639 (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
1640 (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
1641 (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
1642
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1643 (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
1644
26736
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1645 (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
1646 "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
1647 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
1648 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
1649 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
1650 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
1651 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
1652 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
1653 \"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
1654 (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
1655 nil
97043
9592c50233ab Remove support for Mac Carbon.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 96675
diff changeset
1656 (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
1657 (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
1658 (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
1659 (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
1660
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1661 (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
1662
26736
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1663 (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
1664 "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
1665 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
1666 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
1667 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
1668 (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
1669 (xw-display-color-p display)
4a4f7f602836 (display-color-p): Use framep-on-display.
Eli Zaretskii <eliz@gnu.org>
parents: 27117
diff changeset
1670 (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
1671 (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
1672
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1673 (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
1674
27571
4a4f7f602836 (display-color-p): Use framep-on-display.
Eli Zaretskii <eliz@gnu.org>
parents: 27117
diff changeset
1675 (defun display-grayscale-p (&optional display)
4a4f7f602836 (display-color-p): Use framep-on-display.
Eli Zaretskii <eliz@gnu.org>
parents: 27117
diff changeset
1676 "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
1677 (let ((frame-type (framep-on-display display)))
4a4f7f602836 (display-color-p): Use framep-on-display.
Eli Zaretskii <eliz@gnu.org>
parents: 27117
diff changeset
1678 (cond
97043
9592c50233ab Remove support for Mac Carbon.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 96675
diff changeset
1679 ((memq frame-type '(x w32 ns))
27571
4a4f7f602836 (display-color-p): Use framep-on-display.
Eli Zaretskii <eliz@gnu.org>
parents: 27117
diff changeset
1680 (x-display-grayscale-p display))
4a4f7f602836 (display-color-p): Use framep-on-display.
Eli Zaretskii <eliz@gnu.org>
parents: 27117
diff changeset
1681 (t
4a4f7f602836 (display-color-p): Use framep-on-display.
Eli Zaretskii <eliz@gnu.org>
parents: 27117
diff changeset
1682 (> (tty-color-gray-shades display) 2)))))
4a4f7f602836 (display-color-p): Use framep-on-display.
Eli Zaretskii <eliz@gnu.org>
parents: 27117
diff changeset
1683
85758
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1684 (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
1685 "Read a color name or RGB hex value: #RRRRGGGGBBBB.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1686 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
1687 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
1688 #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
1689 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
1690 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
1691
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1692 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
1693 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
1694 color is used.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1695
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1696 * `foreground at point' - foreground under the cursor
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1697 * `background at point' - background under the cursor
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1698
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1699 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
1700 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
1701 ALLOW-EMPTY-NAME-P).
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 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
1704
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1705 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
1706 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
1707
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1708 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
1709 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
1710 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
1711 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
1712 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
1713
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1714 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
1715 a message."
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1716 (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
1717 (let* ((completion-ignore-case t)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1718 (colors (append '("foreground at point" "background at point")
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1719 (defined-colors)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1720 (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
1721 colors))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1722 hex-string)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1723 (cond ((string= "foreground at point" color)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1724 (setq color (foreground-color-at-point)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1725 ((string= "background at point" color)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1726 (setq color (background-color-at-point))))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1727 (unless color
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1728 (setq color ""))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1729 (setq hex-string
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1730 (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
1731 (if (and allow-empty-name-p (string= "" color))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1732 ""
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1733 (when (and hex-string (not (eq (aref color 0) ?#)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1734 (setq color (concat "#" color))) ; No #; add it.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1735 (unless hex-string
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1736 (when (or (string= "" color) (not (test-completion color colors)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1737 (error "No such color: %S" color))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1738 (when convert-to-RGB-p
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1739 (let ((components (x-color-values color)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1740 (unless components (error "No such color: %S" color))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1741 (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
1742 (setq color (format "#%04X%04X%04X"
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1743 (logand 65535 (nth 0 components))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1744 (logand 65535 (nth 1 components))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1745 (logand 65535 (nth 2 components))))))))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1746 (when msg-p (message "Color: `%s'" color))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1747 color)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1748
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1749 ;; 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
1750 ;; duplicates in read-color's completion list.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1751
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1752 ;; (defun defined-colors-without-duplicates ()
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1753 ;; "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
1754 ;; 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
1755 ;; (let ((result (copy-sequence (defined-colors)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1756 ;; to-be-rejected)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1757 ;; (save-match-data
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1758 ;; (dolist (this result)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1759 ;; (if (string-match " " this)
92115
b4b2ac0c80f8 (font-weight-table): Fix value of `semi-light'.
Juanma Barranquero <lekktu@gmail.com>
parents: 92112
diff changeset
1760 ;; (push (replace-regexp-in-string " " ""
85758
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1761 ;; this)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1762 ;; to-be-rejected)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1763 ;; (dolist (elt to-be-rejected)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1764 ;; (let ((as-found (car (member-ignore-case elt result))))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1765 ;; (setq result (delete as-found result)))))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1766 ;; result))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1767
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1768 (defun face-at-point ()
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1769 "Return the face of the character after point.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1770 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
1771 Return nil if it has no specified face."
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1772 (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
1773 (get-char-property (point) 'face)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1774 'default))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1775 (face (cond ((symbolp faceprop) faceprop)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1776 ;; List of faces (don't treat an attribute spec).
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1777 ;; Just use the first face.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1778 ((and (consp faceprop) (not (keywordp (car faceprop)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1779 (not (memq (car faceprop)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1780 '(foreground-color background-color))))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1781 (car faceprop))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1782 (t nil)))) ; Invalid face value.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1783 (if (facep face) face nil)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1784
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1785 (defun foreground-color-at-point ()
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1786 "Return the foreground color of the character after point."
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1787 ;; `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
1788 ;; 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
1789 (let ((face (or (face-at-point)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1790 (get-char-property (point) 'read-face-name)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1791 (get-char-property (point) 'face))))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1792 (cond ((and face (symbolp face))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1793 (let ((value (face-foreground face nil 'default)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1794 (if (member value '("unspecified-fg" "unspecified-bg"))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1795 nil
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1796 value)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1797 ((consp face)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1798 (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
1799 ((memq ':foreground face) (cadr (memq ':foreground face)))))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1800 (t nil)))) ; Invalid face value.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1801
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1802 (defun background-color-at-point ()
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1803 "Return the background color of the character after point."
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1804 ;; `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
1805 ;; 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
1806 (let ((face (or (face-at-point)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1807 (get-char-property (point) 'read-face-name)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1808 (get-char-property (point) 'face))))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1809 (cond ((and face (symbolp face))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1810 (let ((value (face-background face nil 'default)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1811 (if (member value '("unspecified-fg" "unspecified-bg"))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1812 nil
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1813 value)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1814 ((consp face)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1815 (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
1816 ((memq ':background face) (cadr (memq ':background face)))))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1817 (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
1818
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1819 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1820 ;;; Background mode.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1821 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1822
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1823 (defcustom frame-background-mode nil
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1824 "*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
1825 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
1826 `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
1827 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
1828 variable with `setq'; this won't have the expected effect."
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1829 :group 'faces
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1830 :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
1831 (set-default var value)
31528
a461cad7a942 (face-x-resources): Make custom type more specific.
Dave Love <fx@gnu.org>
parents: 31500
diff changeset
1832 (mapc 'frame-set-background-mode (frame-list)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1833 :initialize 'custom-initialize-changed
67503
71e68cea180c (frame-background-mode): Replace `choice-item' keywords
Juri Linkov <juri@jurta.org>
parents: 67049
diff changeset
1834 :type '(choice (const dark)
71e68cea180c (frame-background-mode): Replace `choice-item' keywords
Juri Linkov <juri@jurta.org>
parents: 67049
diff changeset
1835 (const light)
71e68cea180c (frame-background-mode): Replace `choice-item' keywords
Juri Linkov <juri@jurta.org>
parents: 67049
diff changeset
1836 (const :tag "automatic" nil)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1837
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1838
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1839 (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
1840 (attribute class &optional component subclass))
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1841
98469
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1842 (defvar inhibit-frame-set-background-mode nil)
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1843
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1844 (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
1845 "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
1846 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
1847 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
1848 (unless inhibit-frame-set-background-mode
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1849 (let* ((bg-resource
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1850 (and (window-system frame)
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1851 (x-get-resource "backgroundMode" "BackgroundMode")))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1852 (bg-color (frame-parameter frame 'background-color))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1853 (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
1854 (tty-type (tty-type frame))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1855 (bg-mode
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1856 (cond (frame-background-mode)
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1857 (bg-resource (intern (downcase bg-resource)))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1858 (terminal-bg-mode)
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1859 ((and (null (window-system frame))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1860 ;; Unspecified frame background color can only
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1861 ;; happen on tty's.
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1862 (member bg-color '(nil unspecified "unspecified-bg")))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1863 ;; 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
1864 ;; 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
1865 ;; terminal type.
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1866 (if (and tty-type
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1867 (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)"
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1868 tty-type))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1869 'light
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 ((equal bg-color "unspecified-fg") ; inverted colors
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1872 (if (and tty-type
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1873 (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)"
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1874 tty-type))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1875 'dark
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1876 'light))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1877 ((>= (apply '+ (color-values bg-color frame))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1878 ;; Just looking at the screen, colors whose
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1879 ;; 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
1880 ;; still look dark to me.
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1881 (* (apply '+ (color-values "white" frame)) .6))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1882 'light)
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1883 (t 'dark)))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1884 (display-type
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1885 (cond ((null (window-system frame))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1886 (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
1887 ((display-color-p frame)
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1888 'color)
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1889 ((x-display-grayscale-p frame)
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1890 'grayscale)
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1891 (t 'mono)))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1892 (old-bg-mode
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1893 (frame-parameter frame 'background-mode))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1894 (old-display-type
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1895 (frame-parameter frame 'display-type)))
32376
267a06bd1387 (frame-set-background-mode):
Miles Bader <miles@gnu.org>
parents: 32373
diff changeset
1896
98469
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1897 (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
1898 (let ((locally-modified-faces nil)
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1899 ;; 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
1900 ;; again, resulting in a loop (bug#911).
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1901 (inhibit-frame-set-background-mode t))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1902 ;; 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
1903 ;; 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
1904 ;; 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
1905 ;; 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
1906 ;; 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
1907 ;; 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
1908 ;; avoid consing in the common case.
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1909 (dolist (face (face-list))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1910 (and (not (get face 'face-override-spec))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1911 (not (face-spec-match-p face
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1912 (face-user-default-spec face)
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1913 (selected-frame)))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1914 (push face locally-modified-faces)))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1915 ;; Now change to the new frame parameters
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1916 (modify-frame-parameters frame
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1917 (list (cons 'background-mode bg-mode)
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1918 (cons 'display-type display-type)))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1919 ;; 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
1920 ;; parameters, unless they have been locally modified.
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1921 (dolist (face (face-list))
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1922 (unless (memq face locally-modified-faces)
b47418363c13 (inhibit-frame-set-background-mode): New var.
Chong Yidong <cyd@stupidchicken.com>
parents: 98320
diff changeset
1923 (face-spec-recalc face frame))))))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1924
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1925
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1926 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1927 ;;; Frame creation.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1928 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1929
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1930 (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
1931
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1932 (defun x-handle-named-frame-geometry (parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1933 "Add geometry parameters for a named frame to parameter list PARAMETERS.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1934 Value is the new parameter list."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1935 (let* ((name (or (cdr (assq 'name parameters))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1936 (cdr (assq 'name default-frame-alist))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1937 (x-resource-name name)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1938 (res-geometry (if name (x-get-resource "geometry" "Geometry"))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1939 (when res-geometry
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1940 (let ((parsed (x-parse-geometry res-geometry)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1941 ;; If the resource specifies a position, call the position
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1942 ;; and size "user-specified".
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1943 (when (or (assq 'top parsed)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1944 (assq 'left parsed))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1945 (setq parsed (append '((user-position . t) (user-size . t)) parsed)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1946 ;; Put the geometry parameters at the end. Copy
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1947 ;; default-frame-alist so that they go after it.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1948 (setq parameters (append parameters default-frame-alist parsed))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1949 parameters))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1950
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1951
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1952 (defun x-handle-reverse-video (frame parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1953 "Handle the reverse-video frame parameter and X resource.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1954 `x-create-frame' does not handle this one."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1955 (when (cdr (or (assq 'reverse parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1956 (assq 'reverse default-frame-alist)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1957 (let ((resource (x-get-resource "reverseVideo"
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1958 "ReverseVideo")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1959 (if resource
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1960 (cons nil (member (downcase resource)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1961 '("on" "true")))))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1962 (let* ((params (frame-parameters frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1963 (bg (cdr (assq 'foreground-color params)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1964 (fg (cdr (assq 'background-color params))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1965 (modify-frame-parameters frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1966 (list (cons 'foreground-color fg)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1967 (cons 'background-color bg)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1968 (if (equal bg (cdr (assq 'border-color params)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1969 (modify-frame-parameters frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1970 (list (cons 'border-color fg))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1971 (if (equal bg (cdr (assq 'mouse-color params)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1972 (modify-frame-parameters frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1973 (list (cons 'mouse-color fg))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1974 (if (equal bg (cdr (assq 'cursor-color params)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1975 (modify-frame-parameters frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1976 (list (cons 'cursor-color fg)))))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1977
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1978 (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
1979 (declare-function x-setup-function-keys "term/x-win" (frame))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1980
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1981 (defun x-create-frame-with-faces (&optional parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1982 "Create a frame from optional frame parameters PARAMETERS.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1983 Parameters not specified by PARAMETERS are taken from
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1984 `default-frame-alist'. If PARAMETERS specify a frame name,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1985 handle X geometry resources for that name. If either PARAMETERS
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1986 or `default-frame-alist' contains a `reverse' parameter, or
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1987 the X resource ``reverseVideo'' is present, handle that.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1988 Value is the new frame created."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1989 (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
1990 (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
1991 (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
1992 (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
1993 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
1994 visibility scroll-bar-foreground
32d47016e1c4 (x-create-frame-with-faces): Don't pass parameters that
Chong Yidong <cyd@stupidchicken.com>
parents: 96549
diff changeset
1995 scroll-bar-background))
32d47016e1c4 (x-create-frame-with-faces): Don't pass parameters that
Chong Yidong <cyd@stupidchicken.com>
parents: 96549
diff changeset
1996 frame success)
32d47016e1c4 (x-create-frame-with-faces): Don't pass parameters that
Chong Yidong <cyd@stupidchicken.com>
parents: 96549
diff changeset
1997 (dolist (param delayed-params)
32d47016e1c4 (x-create-frame-with-faces): Don't pass parameters that
Chong Yidong <cyd@stupidchicken.com>
parents: 96549
diff changeset
1998 (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
1999 (setq frame (x-create-frame `((visibility . nil) . ,params)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2000 (unwind-protect
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2001 (progn
83316
102194c6d773 Update Lisp code for a terminal-local `function-key-map'.
Karoly Lorentey <lorentey@elte.hu>
parents: 83314
diff changeset
2002 (x-setup-function-keys frame)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2003 (x-handle-reverse-video frame parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2004 (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
2005 (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
2006 (if (null visibility-spec)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2007 (make-frame-visible frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2008 (modify-frame-parameters frame (list visibility-spec)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2009 (setq success t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2010 (unless success
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2011 (delete-frame frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2012 frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2013
96549
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2014 (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
2015 "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
2016 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
2017 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
2018 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
2019 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
2020 (dolist (face (nreverse (face-list)))
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2021 (condition-case ()
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2022 (progn
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2023 ;; 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
2024 (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
2025 ;; 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
2026 ;; x-create-frame.
32d47016e1c4 (x-create-frame-with-faces): Don't pass parameters that
Chong Yidong <cyd@stupidchicken.com>
parents: 96549
diff changeset
2027 (and (not (eq face 'default))
97048
07311809a1f0 faces.el:face-set-after-frame-default: treat ns as other window systems
Adrian Robert <Adrian.B.Robert@gmail.com>
parents: 97043
diff changeset
2028 (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
2029 (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
2030 ;; 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
2031 (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
2032 ;; 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
2033 (error nil)))
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2034 ;; 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
2035 (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
2036 (background-color default :background)
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2037 (font default :font)
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2038 (border-color border :background)
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2039 (cursor-color cursor :background)
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2040 (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
2041 (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
2042 (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
2043 (dolist (param face-params)
96549
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2044 (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
2045 (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
2046 (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
2047 (if value
5a9a5f15f0e5 (face-set-after-frame-default): Simplify. Don't apply
Chong Yidong <cyd@stupidchicken.com>
parents: 96435
diff changeset
2048 (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
2049 (nth 2 param) value))))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2050
33008
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2051 (defun tty-handle-reverse-video (frame parameters)
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2052 "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
2053 (when (cdr (or (assq 'reverse parameters)
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2054 (assq 'reverse default-frame-alist)))
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2055 (let* ((params (frame-parameters frame))
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2056 (bg (cdr (assq 'foreground-color params)))
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2057 (fg (cdr (assq 'background-color params))))
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2058 (modify-frame-parameters frame
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2059 (list (cons 'foreground-color fg)
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2060 (cons 'background-color bg)))
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2061 (if (equal bg (cdr (assq 'mouse-color params)))
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2062 (modify-frame-parameters frame
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2063 (list (cons 'mouse-color fg))))
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2064 (if (equal bg (cdr (assq 'cursor-color params)))
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2065 (modify-frame-parameters frame
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2066 (list (cons 'cursor-color fg)))))))
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2067
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2068
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2069 (defun tty-create-frame-with-faces (&optional parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2070 "Create a frame from optional frame parameters PARAMETERS.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2071 Parameters not specified by PARAMETERS are taken from
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2072 `default-frame-alist'. If either PARAMETERS or `default-frame-alist'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2073 contains a `reverse' parameter, handle that. Value is the new frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2074 created."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2075 (let ((frame (make-terminal-frame parameters))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2076 success)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2077 (unwind-protect
83129
b1ded6fb31d1 Use with-selected-frame.
Karoly Lorentey <lorentey@elte.hu>
parents: 83123
diff changeset
2078 (with-selected-frame frame
33008
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2079 (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
2080
85415
b1e285a2d293 (tty-create-frame-with-faces): Make sure not only
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85311
diff changeset
2081 (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
2082 (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
2083 (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
2084 (tty-run-terminal-initialization frame))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2085 (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
2086 (face-set-after-frame-default frame parameters)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2087 (setq success t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2088 (unless success
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2089 (delete-frame frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2090 frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2091
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
2092 (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
2093 "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
2094 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
2095
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 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
2097 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
2098 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
2099 (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
2100 (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
2101 (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
2102 ;; 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
2103 (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
2104 (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
2105 (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
2106 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
2107 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
2108
83524
673d62ad74b5 Fix and/or simplify terminal initialization files.
Karoly Lorentey <lorentey@elte.hu>
parents: 83523
diff changeset
2109 (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
2110 "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
2111 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
2112 terminal type to a different value."
673d62ad74b5 Fix and/or simplify terminal initialization files.
Karoly Lorentey <lorentey@elte.hu>
parents: 83523
diff changeset
2113 (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
2114 ;; Load library for our terminal type.
8f0c7632f259 Slightly refactor the terminal initialization code for simplicity.
Karoly Lorentey <lorentey@elte.hu>
parents: 83358
diff changeset
2115 ;; 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
2116 (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
2117 (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
2118 (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
2119 ;; 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
2120 ;; 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
2121 (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
2122 (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
2123 (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
2124 (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
2125 (load file t t)))))
83524
673d62ad74b5 Fix and/or simplify terminal initialization files.
Karoly Lorentey <lorentey@elte.hu>
parents: 83523
diff changeset
2126 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
2127 ;; 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
2128 (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
2129 (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
2130 (intern (concat "terminal-init-" type)))))
83524
673d62ad74b5 Fix and/or simplify terminal initialization files.
Karoly Lorentey <lorentey@elte.hu>
parents: 83523
diff changeset
2131 type)
83380
94f174e5569d Merged from miles@gnu.org--gnu-2005 (patch 543)
Karoly Lorentey <lorentey@elte.hu>
parents: 83359
diff changeset
2132 (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
2133 (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
2134 (set-terminal-parameter frame 'terminal-initted term-init-func)))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2135
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2136 ;; Called from C function init_display to initialize faces of the
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2137 ;; dumped terminal frame on startup.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2138
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2139 (defun tty-set-up-initial-frame-faces ()
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2140 (let ((frame (selected-frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2141 (frame-set-background-mode frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2142 (face-set-after-frame-default frame)))
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
2143
25012
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
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2147 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2148 ;;; Compatiblity with 20.2
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2149 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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 a frame's faces when we change its default font.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2152
55883
cde9d1fff89c (frame-update-faces): Add empty docstring so the one for `ignore' doesn't
Juanma Barranquero <lekktu@gmail.com>
parents: 55545
diff changeset
2153 (defalias 'frame-update-faces 'ignore "")
46053
ef0684c3e07b (frame-update-faces): Fix obsolescence declaration.
Juanma Barranquero <lekktu@gmail.com>
parents: 46041
diff changeset
2154 (make-obsolete 'frame-update-faces "no longer necessary." "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2155
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2156 ;; Update the colors of FACE, after FRAME's own colors have been
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2157 ;; changed.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2158
64539
c94d5f576885 (describe-face): "?\ " -> "?\s".
Juanma Barranquero <lekktu@gmail.com>
parents: 64497
diff changeset
2159 (define-obsolete-function-alias 'frame-update-face-colors
c94d5f576885 (describe-face): "?\ " -> "?\s".
Juanma Barranquero <lekktu@gmail.com>
parents: 64497
diff changeset
2160 'frame-set-background-mode "21.1")
25012
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
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2163 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2164 ;;; Standard faces.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2165 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2166
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2167 (defgroup basic-faces nil
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2168 "The standard faces of Emacs."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2169 :group 'faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2170
93694
a60642ce1ede (default): Ensure the face-defface-spec property is set.
Chong Yidong <cyd@stupidchicken.com>
parents: 92948
diff changeset
2171 (defface default
a60642ce1ede (default): Ensure the face-defface-spec property is set.
Chong Yidong <cyd@stupidchicken.com>
parents: 92948
diff changeset
2172 '((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
2173 "Basic default face."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2174 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2175
65730
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2176 (defface bold
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2177 '((t :weight bold))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2178 "Basic bold face."
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2179 :group 'basic-faces)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2180
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2181 (defface italic
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2182 '((((supports :slant italic))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2183 :slant italic)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2184 (((supports :underline t))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2185 :underline t)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2186 (t
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2187 ;; 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
2188 ;; 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
2189 ;; 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
2190 :slant italic))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2191 "Basic 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 bold-italic
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2195 '((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
2196 "Basic bold-italic face."
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2197 :group 'basic-faces)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2198
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2199 (defface underline
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2200 '((((supports :underline t))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2201 :underline t)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2202 (((supports :weight bold))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2203 :weight bold)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2204 (t :underline t))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2205 "Basic underlined 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 fixed-pitch
96169
abc9f7184a8c (fixed-pitch): Use "Monospace" family.
Chong Yidong <cyd@stupidchicken.com>
parents: 96079
diff changeset
2209 '((t :family "Monospace"))
65730
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2210 "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
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 variable-pitch
96247
002173686f70 (face-font-family-alternatives, variable-pitch): Use
Andreas Schwab <schwab@suse.de>
parents: 96241
diff changeset
2214 '((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
2215 "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
2216 :group 'basic-faces)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2217
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2218 (defface shadow
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2219 '((((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
2220 :foreground "grey50")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2221 (((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
2222 :foreground "grey70")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2223 (((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
2224 :foreground "green")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2225 (((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
2226 :foreground "yellow"))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2227 "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
2228 :group 'basic-faces
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2229 :version "22.1")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2230
68341
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2231 (defface link
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2232 '((((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
2233 :foreground "blue1" :underline t)
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2234 (((class color) (background light))
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2235 :foreground "blue" :underline t)
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2236 (((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
2237 :foreground "cyan1" :underline t)
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2238 (((class color) (background dark))
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2239 :foreground "cyan" :underline t)
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2240 (t :inherit underline))
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2241 "Basic face for unvisited links."
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2242 :group 'basic-faces
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2243 :version "22.1")
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2244
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2245 (defface link-visited
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2246 '((default :inherit link)
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2247 (((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
2248 (((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
2249 "Basic face for visited links."
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2250 :group 'basic-faces
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2251 :version "22.1")
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2252
65730
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2253 (defface highlight
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2254 '((((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
2255 :background "darkseagreen2")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2256 (((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
2257 :background "darkolivegreen")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2258 (((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
2259 :background "darkseagreen2")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2260 (((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
2261 :background "darkolivegreen")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2262 (((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
2263 :background "green" :foreground "black")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2264 (t :inverse-video t))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2265 "Basic face for highlighting."
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2266 :group 'basic-faces)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2267
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2268 (defface region
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2269 '((((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
2270 :background "blue3")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2271 (((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
2272 :background "lightgoldenrod2")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2273 (((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
2274 :background "blue3")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2275 (((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
2276 :background "lightgoldenrod2")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2277 (((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
2278 :background "blue" :foreground "white")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2279 (((type tty) (class mono))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2280 :inverse-video t)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2281 (t :background "gray"))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2282 "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
2283 :version "21.1"
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2284 :group 'basic-faces)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2285
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2286 (defface secondary-selection
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2287 '((((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
2288 :background "yellow1")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2289 (((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
2290 :background "SkyBlue4")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2291 (((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
2292 :background "yellow")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2293 (((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
2294 :background "SkyBlue4")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2295 (((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
2296 :background "cyan" :foreground "black")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2297 (t :inverse-video t))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2298 "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
2299 :group 'basic-faces)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2300
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2301 (defface trailing-whitespace
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2302 '((((class color) (background light))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2303 :background "red1")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2304 (((class color) (background dark))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2305 :background "red1")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2306 (t :inverse-video t))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2307 "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
2308 :version "21.1"
67503
71e68cea180c (frame-background-mode): Replace `choice-item' keywords
Juri Linkov <juri@jurta.org>
parents: 67049
diff changeset
2309 :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
2310 :group 'basic-faces)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2311
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2312 (defface escape-glyph
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2313 '((((background dark)) :foreground "cyan")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2314 ;; 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
2315 ;; 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
2316 (((type pc)) :foreground "magenta")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2317 ;; 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
2318 ;; 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
2319 (t :foreground "brown"))
72280
67323a6ea60e (escape-glyph): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 71591
diff changeset
2320 "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
2321 :group 'basic-faces
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2322 :version "22.1")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2323
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2324 (defface nobreak-space
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2325 '((((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
2326 (((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
2327 (t :inverse-video t))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2328 "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
2329 :group 'basic-faces
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2330 :version "22.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2331
68214
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2332 (defgroup mode-line-faces nil
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2333 "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
2334 :group 'mode-line
68214
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2335 :group 'faces
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2336 :version "22.1")
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2337
25650
8b06b47a1fea (mode-line): Replaces `modeline'.
Gerd Moellmann <gerd@gnu.org>
parents: 25616
diff changeset
2338 (defface mode-line
59077
294a7f7e3daf (mode-line, mode-line-inactive): Use min-colors.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 59054
diff changeset
2339 '((((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
2340 :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
2341 :background "grey75" :foreground "black")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2342 (t
43711
d15360503e4e (face-spec-choose): Allow `t' to appear before the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43550
diff changeset
2343 :inverse-video t))
43204
1b0f33edf842 (mode-line-inactive): New face for mode-line for
Kim F. Storm <storm@cua.dk>
parents: 42969
diff changeset
2344 "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
2345 :version "21.1"
68214
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2346 :group 'mode-line-faces
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2347 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2348
43204
1b0f33edf842 (mode-line-inactive): New face for mode-line for
Kim F. Storm <storm@cua.dk>
parents: 42969
diff changeset
2349 (defface mode-line-inactive
58935
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
2350 '((default
43711
d15360503e4e (face-spec-choose): Allow `t' to appear before the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43550
diff changeset
2351 :inherit mode-line)
59077
294a7f7e3daf (mode-line, mode-line-inactive): Use min-colors.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 59054
diff changeset
2352 (((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
2353 :weight light
1b0f33edf842 (mode-line-inactive): New face for mode-line for
Kim F. Storm <storm@cua.dk>
parents: 42969
diff changeset
2354 :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
2355 :foreground "grey20" :background "grey90")
59077
294a7f7e3daf (mode-line, mode-line-inactive): Use min-colors.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 59054
diff changeset
2356 (((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
2357 :weight light
4c5a2e2ddf43 (mode-line-inactive): Add dark-background variant.
Miles Bader <miles@gnu.org>
parents: 43204
diff changeset
2358 :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
2359 :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
2360 "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
2361 :version "22.1"
68214
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2362 :group 'mode-line-faces
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2363 :group 'basic-faces)
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2364
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2365 (defface mode-line-highlight
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2366 '((((class color) (min-colors 88))
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2367 :box (:line-width 2 :color "grey40" :style released-button))
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2368 (t
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2369 :inherit highlight))
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2370 "Basic mode line face for highlighting."
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2371 :version "22.1"
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2372 :group 'mode-line-faces
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2373 :group 'basic-faces)
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2374
92717
fec088bf4a02 (mode-line-emphasis): New face.
Glenn Morris <rgm@gnu.org>
parents: 92446
diff changeset
2375 (defface mode-line-emphasis
fec088bf4a02 (mode-line-emphasis): New face.
Glenn Morris <rgm@gnu.org>
parents: 92446
diff changeset
2376 '((t (:weight bold)))
fec088bf4a02 (mode-line-emphasis): New face.
Glenn Morris <rgm@gnu.org>
parents: 92446
diff changeset
2377 "Face used to emphasize certain mode line features.
fec088bf4a02 (mode-line-emphasis): New face.
Glenn Morris <rgm@gnu.org>
parents: 92446
diff changeset
2378 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
2379 :version "23.1"
fec088bf4a02 (mode-line-emphasis): New face.
Glenn Morris <rgm@gnu.org>
parents: 92446
diff changeset
2380 :group 'mode-line-faces
fec088bf4a02 (mode-line-emphasis): New face.
Glenn Morris <rgm@gnu.org>
parents: 92446
diff changeset
2381 :group 'basic-faces)
fec088bf4a02 (mode-line-emphasis): New face.
Glenn Morris <rgm@gnu.org>
parents: 92446
diff changeset
2382
68214
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2383 (defface mode-line-buffer-id
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2384 '((t (:weight bold)))
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2385 "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
2386 :version "22.1"
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2387 :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
2388 :group 'basic-faces)
1b0f33edf842 (mode-line-inactive): New face for mode-line for
Kim F. Storm <storm@cua.dk>
parents: 42969
diff changeset
2389
25650
8b06b47a1fea (mode-line): Replaces `modeline'.
Gerd Moellmann <gerd@gnu.org>
parents: 25616
diff changeset
2390 ;; Make `modeline' an alias for `mode-line', for compatibility.
8b06b47a1fea (mode-line): Replaces `modeline'.
Gerd Moellmann <gerd@gnu.org>
parents: 25616
diff changeset
2391 (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
2392 (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
2393 (put 'modeline-highlight 'face-alias 'mode-line-highlight)
68214
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2394 (put 'modeline-buffer-id 'face-alias 'mode-line-buffer-id)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2395
25545
b0a117037bde (header-line): Renamed from `top-line'.
Gerd Moellmann <gerd@gnu.org>
parents: 25542
diff changeset
2396 (defface header-line
58935
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
2397 '((default
54574
76b831799f4d (read-face-font): Don't cons up unnecessarily.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54161
diff changeset
2398 :inherit mode-line)
76b831799f4d (read-face-font): Don't cons up unnecessarily.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54161
diff changeset
2399 (((type tty))
32404
d355f52b4497 (header-line): Change tty-variant to use underlining.
Miles Bader <miles@gnu.org>
parents: 32378
diff changeset
2400 ;; 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
2401 ;; 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
2402 ;; 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
2403 ;; 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
2404 ;; 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
2405 ;; 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
2406 ;; 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
2407 ;; 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
2408 ;; the info browser. XXX
54574
76b831799f4d (read-face-font): Don't cons up unnecessarily.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54161
diff changeset
2409 :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
2410 :underline t)
32756
ccfb1ed059ca (header-line): Make more reasonable on mono/grayscale displays.
Miles Bader <miles@gnu.org>
parents: 32752
diff changeset
2411 (((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
2412 :background "grey90" :foreground "grey20"
54574
76b831799f4d (read-face-font): Don't cons up unnecessarily.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54161
diff changeset
2413 :box nil)
32756
ccfb1ed059ca (header-line): Make more reasonable on mono/grayscale displays.
Miles Bader <miles@gnu.org>
parents: 32752
diff changeset
2414 (((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
2415 :background "grey20" :foreground "grey90"
54574
76b831799f4d (read-face-font): Don't cons up unnecessarily.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54161
diff changeset
2416 :box nil)
32756
ccfb1ed059ca (header-line): Make more reasonable on mono/grayscale displays.
Miles Bader <miles@gnu.org>
parents: 32752
diff changeset
2417 (((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
2418 :background "white" :foreground "black"
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)
32756
ccfb1ed059ca (header-line): Make more reasonable on mono/grayscale displays.
Miles Bader <miles@gnu.org>
parents: 32752
diff changeset
2422 (((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
2423 :background "black" :foreground "white"
900ca3da6e01 (header-line): Use `:box nil' for color/gs displays too.
Miles Bader <miles@gnu.org>
parents: 33447
diff changeset
2424 :inverse-video nil
900ca3da6e01 (header-line): Use `:box nil' for color/gs displays too.
Miles Bader <miles@gnu.org>
parents: 33447
diff changeset
2425 :box nil
54574
76b831799f4d (read-face-font): Don't cons up unnecessarily.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54161
diff changeset
2426 :underline t))
25545
b0a117037bde (header-line): Renamed from `top-line'.
Gerd Moellmann <gerd@gnu.org>
parents: 25542
diff changeset
2427 "Basic header-line face."
25687
afad62240679 (mode-line, header-line, tool-bar, ): Add :version.
Dave Love <fx@gnu.org>
parents: 25650
diff changeset
2428 :version "21.1"
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2429 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2430
75166
d9e4f75aee3d (momentary): Change :group to basic-faces where all
Juri Linkov <juri@jurta.org>
parents: 75109
diff changeset
2431 (defface vertical-border
d9e4f75aee3d (momentary): Change :group to basic-faces where all
Juri Linkov <juri@jurta.org>
parents: 75109
diff changeset
2432 '((((type tty)) :inherit mode-line-inactive))
d9e4f75aee3d (momentary): Change :group to basic-faces where all
Juri Linkov <juri@jurta.org>
parents: 75109
diff changeset
2433 "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
2434 :version "22.1"
d9e4f75aee3d (momentary): Change :group to basic-faces where all
Juri Linkov <juri@jurta.org>
parents: 75109
diff changeset
2435 :group 'basic-faces)
d9e4f75aee3d (momentary): Change :group to basic-faces where all
Juri Linkov <juri@jurta.org>
parents: 75109
diff changeset
2436
65084
87a66a9a9328 (minibuffer-prompt): Doc fix.
Juri Linkov <juri@jurta.org>
parents: 65068
diff changeset
2437 (defface minibuffer-prompt
87a66a9a9328 (minibuffer-prompt): Doc fix.
Juri Linkov <juri@jurta.org>
parents: 65068
diff changeset
2438 '((((background dark)) :foreground "cyan")
87a66a9a9328 (minibuffer-prompt): Doc fix.
Juri Linkov <juri@jurta.org>
parents: 65068
diff changeset
2439 ;; 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
2440 ;; their foreground color to be blue.
87a66a9a9328 (minibuffer-prompt): Doc fix.
Juri Linkov <juri@jurta.org>
parents: 65068
diff changeset
2441 (((type pc)) :foreground "magenta")
76292
81d50597174e (minibuffer-prompt): Use medium blue by default.
Richard M. Stallman <rms@gnu.org>
parents: 75884
diff changeset
2442 (t :foreground "medium blue"))
65084
87a66a9a9328 (minibuffer-prompt): Doc fix.
Juri Linkov <juri@jurta.org>
parents: 65068
diff changeset
2443 "Face for minibuffer prompts.
87a66a9a9328 (minibuffer-prompt): Doc fix.
Juri Linkov <juri@jurta.org>
parents: 65068
diff changeset
2444 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
2445 `minibuffer-prompt-properties', which is a list of text properties
87a66a9a9328 (minibuffer-prompt): Doc fix.
Juri Linkov <juri@jurta.org>
parents: 65068
diff changeset
2446 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
2447 :version "22.1"
42298
d020b569f212 (minibuffer-prompt): New face.
Richard M. Stallman <rms@gnu.org>
parents: 40456
diff changeset
2448 :group 'basic-faces)
d020b569f212 (minibuffer-prompt): New face.
Richard M. Stallman <rms@gnu.org>
parents: 40456
diff changeset
2449
d020b569f212 (minibuffer-prompt): New face.
Richard M. Stallman <rms@gnu.org>
parents: 40456
diff changeset
2450 (setq minibuffer-prompt-properties
d020b569f212 (minibuffer-prompt): New face.
Richard M. Stallman <rms@gnu.org>
parents: 40456
diff changeset
2451 (append minibuffer-prompt-properties (list 'face 'minibuffer-prompt)))
d020b569f212 (minibuffer-prompt): New face.
Richard M. Stallman <rms@gnu.org>
parents: 40456
diff changeset
2452
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2453 (defface fringe
29943
b8314fd10792 (fringe): Change face for different backgrounds.
Gerd Moellmann <gerd@gnu.org>
parents: 29880
diff changeset
2454 '((((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
2455 :background "grey95")
d15360503e4e (face-spec-choose): Allow `t' to appear before the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43550
diff changeset
2456 (((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
2457 :background "grey10")
d15360503e4e (face-spec-choose): Allow `t' to appear before the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43550
diff changeset
2458 (t
d15360503e4e (face-spec-choose): Allow `t' to appear before the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43550
diff changeset
2459 :background "gray"))
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2460 "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
2461 :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
2462 :group 'frames
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2463 :group 'basic-faces)
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2464
70178
667cd756c089 (scroll-bar, border, cursor, mouse): Avoid nil spec in defface.
Luc Teirlinck <teirllm@auburn.edu>
parents: 68651
diff changeset
2465 (defface scroll-bar '((t nil))
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2466 "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
2467 :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
2468 :group 'frames
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2469 :group 'basic-faces)
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2470
70178
667cd756c089 (scroll-bar, border, cursor, mouse): Avoid nil spec in defface.
Luc Teirlinck <teirllm@auburn.edu>
parents: 68651
diff changeset
2471 (defface border '((t nil))
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2472 "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
2473 :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
2474 :group 'frames
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2475 :group 'basic-faces)
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2476
70178
667cd756c089 (scroll-bar, border, cursor, mouse): Avoid nil spec in defface.
Luc Teirlinck <teirllm@auburn.edu>
parents: 68651
diff changeset
2477 (defface cursor '((t nil))
57105
8f14c8ea51a1 (cursor): Add face-no-inherit property. Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 55902
diff changeset
2478 "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
2479 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
2480 :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
2481 :group 'cursor
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2482 :group 'basic-faces)
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2483
57105
8f14c8ea51a1 (cursor): Add face-no-inherit property. Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 55902
diff changeset
2484 (put 'cursor 'face-no-inherit t)
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2485
70178
667cd756c089 (scroll-bar, border, cursor, mouse): Avoid nil spec in defface.
Luc Teirlinck <teirllm@auburn.edu>
parents: 68651
diff changeset
2486 (defface mouse '((t nil))
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2487 "Basic face for the mouse color under X."
25137
1bee9402f747 (bitmap-area): Add :version.
Dave Love <fx@gnu.org>
parents: 25090
diff changeset
2488 :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
2489 :group 'mouse
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2490 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2491
65730
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2492 (defface tool-bar
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2493 '((default
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2494 :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
2495 :foreground "black")
97043
9592c50233ab Remove support for Mac Carbon.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 96675
diff changeset
2496 (((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
2497 :background "grey75")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2498 (((type x) (class mono))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2499 :background "grey"))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2500 "Basic tool-bar face."
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2501 :version "21.1"
25687
afad62240679 (mode-line, header-line, tool-bar, ): Add :version.
Dave Love <fx@gnu.org>
parents: 25650
diff changeset
2502 :group 'basic-faces)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2503
65730
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2504 (defface menu
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2505 '((((type tty))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2506 :inverse-video t)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2507 (((type x-toolkit))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2508 )
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2509 (t
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2510 :inverse-video t))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2511 "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
2512 :version "21.1"
65730
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2513 :group 'menu
25687
afad62240679 (mode-line, header-line, tool-bar, ): Add :version.
Dave Love <fx@gnu.org>
parents: 25650
diff changeset
2514 :group 'basic-faces)
25012
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
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2517 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2518 ;;; Manipulating font names.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2519 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2520
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2521 ;; 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
2522 ;; international/fontset.el uses x-resolve-font-name. The following
6d7ba0ba3bc3 Declare more functions obsolete.
Dave Love <fx@gnu.org>
parents: 28849
diff changeset
2523 ;; functions are not used in the face implementation itself.
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2524
16687
049c87a96dca Change defconsts to defvars.
Richard M. Stallman <rms@gnu.org>
parents: 16590
diff changeset
2525 (defvar x-font-regexp nil)
049c87a96dca Change defconsts to defvars.
Richard M. Stallman <rms@gnu.org>
parents: 16590
diff changeset
2526 (defvar x-font-regexp-head nil)
049c87a96dca Change defconsts to defvars.
Richard M. Stallman <rms@gnu.org>
parents: 16590
diff changeset
2527 (defvar x-font-regexp-weight nil)
049c87a96dca Change defconsts to defvars.
Richard M. Stallman <rms@gnu.org>
parents: 16590
diff changeset
2528 (defvar x-font-regexp-slant nil)
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2529
12668
7660e82d0346 (x-font-regexp-weight-subnum, x-font-regexp-slant-subnum)
Karl Heuer <kwzh@gnu.org>
parents: 12651
diff changeset
2530 (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
2531 (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
2532 (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
2533 (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
2534
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2535 ;;; Regexps matching font names in "Host Portable Character Representation."
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2536 ;;;
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2537 (let ((- "[-?]")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2538 (foundry "[^-]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2539 (family "[^-]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2540 (weight "\\(bold\\|demibold\\|medium\\)") ; 1
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2541 ; (weight\? "\\(\\*\\|bold\\|demibold\\|medium\\|\\)") ; 1
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2542 (weight\? "\\([^-]*\\)") ; 1
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2543 (slant "\\([ior]\\)") ; 2
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2544 ; (slant\? "\\([ior?*]?\\)") ; 2
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2545 (slant\? "\\([^-]?\\)") ; 2
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2546 ; (swidth "\\(\\*\\|normal\\|semicondensed\\|\\)") ; 3
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2547 (swidth "\\([^-]*\\)") ; 3
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2548 ; (adstyle "\\(\\*\\|sans\\|\\)") ; 4
12690
e2d3fa52d100 (x-font-regexp): Add \\(\\) for substring extraction.
Karl Heuer <kwzh@gnu.org>
parents: 12668
diff changeset
2549 (adstyle "\\([^-]*\\)") ; 4
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2550 (pixelsize "[0-9]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2551 (pointsize "[0-9][0-9]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2552 (resx "[0-9][0-9]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2553 (resy "[0-9][0-9]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2554 (spacing "[cmp?*]")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2555 (avgwidth "[0-9]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2556 (registry "[^-]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2557 (encoding "[^-]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2558 )
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2559 (setq x-font-regexp
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2560 (concat "\\`\\*?[-?*]"
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2561 foundry - family - weight\? - slant\? - swidth - adstyle -
12475
eb436b0c4ab3 (x-font-regexp): Include the avgwidth.
Richard M. Stallman <rms@gnu.org>
parents: 12460
diff changeset
2562 pixelsize - pointsize - resx - resy - spacing - avgwidth -
eb436b0c4ab3 (x-font-regexp): Include the avgwidth.
Richard M. Stallman <rms@gnu.org>
parents: 12460
diff changeset
2563 registry - encoding "\\*?\\'"
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2564 ))
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2565 (setq x-font-regexp-head
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2566 (concat "\\`[-?*]" foundry - family - weight\? - slant\?
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2567 "\\([-*?]\\|\\'\\)"))
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2568 (setq x-font-regexp-slant (concat - slant -))
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2569 (setq x-font-regexp-weight (concat - weight -))
28840
d0531e35d9f2 Some doc fixes.
Dave Love <fx@gnu.org>
parents: 28214
diff changeset
2570 nil)
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2571
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2572
3071
68de05fb5751 * faces.el (set-face-font): Call x-resolve-font-name on the font
Jim Blandy <jimb@redhat.com>
parents: 3049
diff changeset
2573 (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
2574 "Return a font name matching PATTERN.
28849
76e727bc0dfd Fix make-obsolete for internal-get-face.
Dave Love <fx@gnu.org>
parents: 28840
diff changeset
2575 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
2576 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
2577 contains wildcards.
10170
5fc240a3e4a0 (face-initialize): Test for framep not t or nil.
Richard M. Stallman <rms@gnu.org>
parents: 10107
diff changeset
2578 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
2579 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
2580 (or (symbolp face)
28b2df35c33e (x-resolve-font-name): Allow symbol as FACE arg.
Richard M. Stallman <rms@gnu.org>
parents: 3182
diff changeset
2581 (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
2582 (and (eq frame t)
28b2df35c33e (x-resolve-font-name): Allow symbol as FACE arg.
Richard M. Stallman <rms@gnu.org>
parents: 3182
diff changeset
2583 (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
2584 (if pattern
5092
36508a7c0a3f (x-resolve-font-name): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 5081
diff changeset
2585 ;; 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
2586 (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
2587 (or fonts
82c29bacb6b3 * faces.el (x-resolve-font-name): If PATTERN is nil, return the
Jim Blandy <jimb@redhat.com>
parents: 3071
diff changeset
2588 (if face
10584
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
2589 (if (string-match "\\*" pattern)
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
2590 (if (null (face-font face))
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
2591 (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
2592 (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
2593 (if (null (face-font face))
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
2594 (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
2595 pattern)
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
2596 (error "Height of font `%s' doesn't match face `%s'"
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
2597 pattern face)))
3353
8cbd38886eef (x-resolve-font-name): Clean up error messages.
Richard M. Stallman <rms@gnu.org>
parents: 3298
diff changeset
2598 (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
2599 (car fonts))
82c29bacb6b3 * faces.el (x-resolve-font-name): If PATTERN is nil, return the
Jim Blandy <jimb@redhat.com>
parents: 3071
diff changeset
2600 (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
2601
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2602
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2603 (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
2604 (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
2605 (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
2606 (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
2607 (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
2608 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
2609 (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
2610 (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
2611 ;; 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
2612 ;; 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
2613 ;; 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
2614 "*"
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 (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
2616 ((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
2617 (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
2618 (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
2619 ((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
2620 (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
2621 (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
2622 (make-obsolete 'x-frob-font-weight 'make-face-... "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2623
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2624 (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
2625 (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
2626 (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
2627 (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
2628 (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
2629 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
2630 (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
2631 (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
2632 ;; 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
2633 ;; 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
2634 ;; 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
2635 "*"
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 (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
2637 ((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
2638 (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
2639 (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
2640 ((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
2641 (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
2642 (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
2643 (make-obsolete 'x-frob-font-slant 'make-face-... "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2644
40351
a44d4a7dd8de (internal-get-face): Use facep instead of the obsolete
Eli Zaretskii <eliz@gnu.org>
parents: 39830
diff changeset
2645 ;; 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
2646 ;; functions from the byte compiler.
a44d4a7dd8de (internal-get-face): Use facep instead of the obsolete
Eli Zaretskii <eliz@gnu.org>
parents: 39830
diff changeset
2647 (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
2648 (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
2649
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2650 (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
2651 "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
2652 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
2653 (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
2654 (make-obsolete 'x-make-font-bold 'make-face-bold "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2655
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2656 (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
2657 "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
2658 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
2659 (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
2660 (make-obsolete 'x-make-font-demibold 'make-face-bold "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2661
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2662 (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
2663 "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
2664 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
2665 (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
2666 (make-obsolete 'x-make-font-unbold 'make-face-unbold "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2667
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2668 (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
2669 "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
2670 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
2671 (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
2672 (make-obsolete 'x-make-font-italic 'make-face-italic "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2673
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2674 (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
2675 "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
2676 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
2677 (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
2678 (make-obsolete 'x-make-font-oblique 'make-face-italic "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2679
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2680 (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
2681 "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
2682 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
2683 (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
2684 (make-obsolete 'x-make-font-unitalic 'make-face-unitalic "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2685
17752
2687f3d7c191 (x-make-font-bold-italic): New function.
Kenichi Handa <handa@m17n.org>
parents: 17560
diff changeset
2686 (defun x-make-font-bold-italic (font)
2687f3d7c191 (x-make-font-bold-italic): New function.
Kenichi Handa <handa@m17n.org>
parents: 17560
diff changeset
2687 "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
2688 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
2689 (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
2690 (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
2691 (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
2692
2715
9caee9338229 * faces.el: Call internal-set-face-1, not internat-set-face-1.
Jim Blandy <jimb@redhat.com>
parents: 2714
diff changeset
2693 (provide 'faces)
9caee9338229 * faces.el: Call internal-set-face-1, not internat-set-face-1.
Jim Blandy <jimb@redhat.com>
parents: 2714
diff changeset
2694
63382
9cbfa983c1cf (read-face-name): Use complete-in-turn complete non-aliases
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 63311
diff changeset
2695 ;; arch-tag: 19a4759f-2963-445f-b004-425b9aadd7d6
28840
d0531e35d9f2 Some doc fixes.
Dave Love <fx@gnu.org>
parents: 28214
diff changeset
2696 ;;; faces.el ends here