annotate lisp/faces.el @ 99400:b0dc8618a597

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