annotate lisp/faces.el @ 96368:3b1e90875bee

American English spelling fix.
author Glenn Morris <rgm@gnu.org>
date Fri, 27 Jun 2008 02:31:03 +0000
parents fcffe32b9669
children 36c91bfee166
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)
2744
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
34
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
35 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
36 ;;; Font selection.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
37 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
38
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
39 (defgroup font-selection nil
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
40 "Influencing face font selection."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
41 :group 'faces)
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
42
12562
a9b08e50d6ec (x-create-frame-with-faces): Set background-mode
Karl Heuer <kwzh@gnu.org>
parents: 12475
diff changeset
43
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
44 (defcustom face-font-selection-order
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
45 '(:width :height :weight :slant)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
46 "*A list specifying how face font selection chooses fonts.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
47 Each of the four symbols `:width', `:height', `:weight', and `:slant'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
48 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
49 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
50 for those face attributes that appear before in the list. For
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
51 example, if `:slant' appears before `:height', font selection first
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
52 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
53 a font height that isn't optimal."
48713
a91fa6973510 (face-font-selection-order)
Andreas Schwab <schwab@suse.de>
parents: 48522
diff changeset
54 :tag "Font selection order"
30306
7a694e8efd12 (face-font-selection-order)
Gerd Moellmann <gerd@gnu.org>
parents: 30188
diff changeset
55 :type '(list symbol symbol symbol symbol)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
56 :group 'font-selection
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
57 :set #'(lambda (symbol value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
58 (set-default symbol value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
59 (internal-set-font-selection-order value)))
17522
209c61e51bd0 (frame-set-background-mode): New function.
Richard M. Stallman <rms@gnu.org>
parents: 17386
diff changeset
60
33371
8259eb8d96c2 (face-font-registry-alternatives): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents: 33008
diff changeset
61
96247
002173686f70 (face-font-family-alternatives, variable-pitch): Use
Andreas Schwab <schwab@suse.de>
parents: 96241
diff changeset
62 ;; 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
63 ;; 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
64 ;; which are generally available.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
65 (defcustom face-font-family-alternatives
96169
abc9f7184a8c (fixed-pitch): Use "Monospace" family.
Chong Yidong <cyd@stupidchicken.com>
parents: 96079
diff changeset
66 '(("Monospace" "courier" "fixed")
abc9f7184a8c (fixed-pitch): Use "Monospace" family.
Chong Yidong <cyd@stupidchicken.com>
parents: 96079
diff changeset
67 ("courier" "fixed")
96247
002173686f70 (face-font-family-alternatives, variable-pitch): Use
Andreas Schwab <schwab@suse.de>
parents: 96241
diff changeset
68 ("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
69 ("helv" "helvetica" "arial" "fixed"))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
70 "*Alist of alternative font family names.
42705
963ac6b8fb83 Fix typos.
Pavel Janík <Pavel@Janik.cz>
parents: 42670
diff changeset
71 Each element has the form (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...).
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
72 If fonts of family FAMILY can't be loaded, try ALTERNATIVE1, then
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
73 ALTERNATIVE2 etc."
48713
a91fa6973510 (face-font-selection-order)
Andreas Schwab <schwab@suse.de>
parents: 48522
diff changeset
74 :tag "Alternative font families to try"
30306
7a694e8efd12 (face-font-selection-order)
Gerd Moellmann <gerd@gnu.org>
parents: 30188
diff changeset
75 :type '(repeat (repeat string))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
76 :group 'font-selection
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
77 :set #'(lambda (symbol value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
78 (set-default symbol value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
79 (internal-set-alternative-font-family-alist value)))
13725
9729af46fe60 Take optional arg FRAME.
Simon Marshall <simon@gnu.org>
parents: 13704
diff changeset
80
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
81
33371
8259eb8d96c2 (face-font-registry-alternatives): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents: 33008
diff changeset
82 ;; This is defined originally in xfaces.c.
8259eb8d96c2 (face-font-registry-alternatives): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents: 33008
diff changeset
83 (defcustom face-font-registry-alternatives
39549
044b46ec5fff (face-font-registry-alternatives) [windows-nt]: Make
Andrew Innes <andrewi@gnu.org>
parents: 38697
diff changeset
84 (if (eq system-type 'windows-nt)
42969
bdcf2b5f4ae2 (face-font-registry-alternatives) [windows-nt]: Add
Jason Rumney <jasonr@gnu.org>
parents: 42705
diff changeset
85 '(("iso8859-1" "ms-oemlatin")
90682
df64e21eebd0 (face-font-registry-alternatives): Add gb18030.
Kenichi Handa <handa@m17n.org>
parents: 90650
diff changeset
86 ("gb2312.1980" "gb2312" "gbk" "gb18030")
39549
044b46ec5fff (face-font-registry-alternatives) [windows-nt]: Make
Andrew Innes <andrewi@gnu.org>
parents: 38697
diff changeset
87 ("jisx0208.1990" "jisx0208.1983" "jisx0208.1978")
044b46ec5fff (face-font-registry-alternatives) [windows-nt]: Make
Andrew Innes <andrewi@gnu.org>
parents: 38697
diff changeset
88 ("ksc5601.1989" "ksx1001.1992" "ksc5601.1987")
044b46ec5fff (face-font-registry-alternatives) [windows-nt]: Make
Andrew Innes <andrewi@gnu.org>
parents: 38697
diff changeset
89 ("muletibetan-2" "muletibetan-0"))
90682
df64e21eebd0 (face-font-registry-alternatives): Add gb18030.
Kenichi Handa <handa@m17n.org>
parents: 90650
diff changeset
90 '(("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
91 ("jisx0208.1990" "jisx0208.1983" "jisx0208.1978")
044b46ec5fff (face-font-registry-alternatives) [windows-nt]: Make
Andrew Innes <andrewi@gnu.org>
parents: 38697
diff changeset
92 ("ksc5601.1989" "ksx1001.1992" "ksc5601.1987")
044b46ec5fff (face-font-registry-alternatives) [windows-nt]: Make
Andrew Innes <andrewi@gnu.org>
parents: 38697
diff changeset
93 ("muletibetan-2" "muletibetan-0")))
33371
8259eb8d96c2 (face-font-registry-alternatives): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents: 33008
diff changeset
94 "*Alist of alternative font registry names.
42705
963ac6b8fb83 Fix typos.
Pavel Janík <Pavel@Janik.cz>
parents: 42670
diff changeset
95 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
96 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
97 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
98 REGISTRY, ALTERNATIVE1, ALTERNATIVE2, and etc."
48713
a91fa6973510 (face-font-selection-order)
Andreas Schwab <schwab@suse.de>
parents: 48522
diff changeset
99 :tag "Alternative font registries to try"
33371
8259eb8d96c2 (face-font-registry-alternatives): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents: 33008
diff changeset
100 :type '(repeat (repeat string))
33419
21ac2c51ac59 (face-font-registry-alternatives): Add :version.
Dave Love <fx@gnu.org>
parents: 33371
diff changeset
101 :version "21.1"
33371
8259eb8d96c2 (face-font-registry-alternatives): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents: 33008
diff changeset
102 :group 'font-selection
8259eb8d96c2 (face-font-registry-alternatives): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents: 33008
diff changeset
103 :set #'(lambda (symbol value)
8259eb8d96c2 (face-font-registry-alternatives): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents: 33008
diff changeset
104 (set-default symbol value)
8259eb8d96c2 (face-font-registry-alternatives): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents: 33008
diff changeset
105 (internal-set-alternative-font-registry-alist value)))
8259eb8d96c2 (face-font-registry-alternatives): New user-option.
Gerd Moellmann <gerd@gnu.org>
parents: 33008
diff changeset
106
2744
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
107
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
108 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
109 ;;; Creation, copying.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
110 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2744
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
111
3925
f286657c098e * faces.el (global-face-data): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 3911
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 (defun face-list ()
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
114 "Return a list of all defined face names."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
115 (mapcar #'car face-new-frame-defaults))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
116
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
117
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
118 ;;; ### If not frame-local initialize by what X resources?
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
119
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
120 (defun make-face (face &optional no-init-from-resources)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
121 "Define a new face with name FACE, a symbol.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
122 NO-INIT-FROM-RESOURCES non-nil means don't initialize frame-local
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
123 variants of FACE from X resources. (X resources recognized are found
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
124 in the global variable `face-x-resources'.) If FACE is already known
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
125 as a face, leave it unmodified. Value is FACE."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
126 (interactive "SMake face: ")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
127 (unless (facep face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
128 ;; Make frame-local faces (this also makes the global one).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
129 (dolist (frame (frame-list))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
130 (internal-make-lisp-face face frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
131 ;; Add the face to the face menu.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
132 (when (fboundp 'facemenu-add-new-face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
133 (facemenu-add-new-face face))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
134 ;; Define frame-local faces for all frames from X resources.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
135 (unless no-init-from-resources
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
136 (make-face-x-resource-internal face)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
137 face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
138
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
139
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
140 (defun make-empty-face (face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
141 "Define a new, empty face with name FACE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
142 If the face already exists, it is left unmodified. Value is FACE."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
143 (interactive "SMake empty face: ")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
144 (make-face face 'no-init-from-resources))
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 copy-face (old-face new-face &optional frame new-frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
148 "Define a face just like OLD-FACE, with name NEW-FACE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
149
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
150 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
151 OLD-FACE. If it doesn't already exist, it is created.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
152
47258
86c1fc3c48f5 (copy-face): Fix spacing.
Juanma Barranquero <lekktu@gmail.com>
parents: 46267
diff changeset
153 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
154 changed on FRAME only.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
155 If FRAME is t, the frame-independent default specification for OLD-FACE
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
156 is copied to NEW-FACE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
157 If FRAME is nil, copying is done for the frame-independent defaults
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
158 and for each existing frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
159
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
160 If the optional fourth argument NEW-FRAME is given,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
161 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
162 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
163 (let ((inhibit-quit t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
164 (if (null frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
165 (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
166 (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
167 (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
168 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
169 (make-empty-face new-face)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
170 (dolist (frame (frame-list))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
171 (copy-face old-face new-face frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
172 (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
173 (make-empty-face new-face)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
174 (internal-copy-lisp-face old-face new-face frame new-frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
175 new-face))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
176
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
177
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
178
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
179 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
180 ;;; Obsolete functions
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
181 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
182
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
183 ;; The functions in this section are defined because Lisp packages use
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
184 ;; them, despite the prefix `internal-' suggesting that they are
28840
d0531e35d9f2 Some doc fixes.
Dave Love <fx@gnu.org>
parents: 28214
diff changeset
185 ;; 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
186
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
187 (defun internal-find-face (name &optional frame)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
188 "Retrieve the face named NAME.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
189 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
190 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
191 The optional argument FRAME is ignored."
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
192 (facep name))
29354
4ed4a700358b Update calls to make-obsolete with a WHEN argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28907
diff changeset
193 (make-obsolete 'internal-find-face 'facep "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
194
2744
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
195
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
196 (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
197 "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
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."
40351
a44d4a7dd8de (internal-get-face): Use facep instead of the obsolete
Eli Zaretskii <eliz@gnu.org>
parents: 39830
diff changeset
200 (or (facep name)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
201 (check-face name)))
46053
ef0684c3e07b (frame-update-faces): Fix obsolescence declaration.
Juanma Barranquero <lekktu@gmail.com>
parents: 46041
diff changeset
202 (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
203
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
204
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
205 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
206 ;;; Predicates, type checks.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
207 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
208
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
209 (defun facep (face)
79651
a926997ba2da (facep): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 79615
diff changeset
210 "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
211 A face name can be a string or a symbol."
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
212 (internal-lisp-face-p face))
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
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
215 (defun check-face (face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
216 "Signal an error if FACE doesn't name a face.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
217 Value is FACE."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
218 (unless (facep face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
219 (error "Not a face: %s" face))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
220 face)
2744
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
221
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
222
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
223 ;; 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
224 ;; of realized faces. The ID assigned to Lisp faces is used to
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
225 ;; support faces in display table entries.
17386
b251c8820860 (make-face): New arg no-resources.
Richard M. Stallman <rms@gnu.org>
parents: 17173
diff changeset
226
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
227 (defun face-id (face &optional frame)
46267
cd9282aa1d8a (face-id): Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents: 46146
diff changeset
228 "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
229 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
230 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
231 of a face name is the same for all frames."
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
232 (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
233 (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
234 (face-id (get face 'face-alias))))
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
235
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
236 (defun face-equal (face1 face2 &optional frame)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
237 "Non-nil if faces FACE1 and FACE2 are equal.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
238 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
239 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
240 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
241 If FRAME is omitted or nil, use the selected frame."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
242 (internal-lisp-face-equal-p face1 face2 frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
243
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
244
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
245 (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
246 "Return non-nil if FACE displays differently from the default face.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
247 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
248 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
249 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
250 (let ((attrs
87494
26eb0118cbc6 (face-all-attributes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 87483
diff changeset
251 (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
252 (differs nil))
084530cb1b2f Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-372
Miles Bader <miles@gnu.org>
parents: 55901
diff changeset
253 (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
254 (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
255 (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
256 (when (and
084530cb1b2f Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-372
Miles Bader <miles@gnu.org>
parents: 55901
diff changeset
257 (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
258 (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
259 frame))
084530cb1b2f Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-372
Miles Bader <miles@gnu.org>
parents: 55901
diff changeset
260 (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
261 differs))
10379
f9d713e8c77c (face-nontrivial-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10375
diff changeset
262
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
263
10379
f9d713e8c77c (face-nontrivial-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10375
diff changeset
264 (defun face-nontrivial-p (face &optional frame)
f9d713e8c77c (face-nontrivial-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10375
diff changeset
265 "True if face FACE has some non-nil attribute.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
266 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
267 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
268 If FRAME is omitted or nil, use the selected frame."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
269 (not (internal-lisp-face-empty-p face frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
270
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
271
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
272
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
273 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
274 ;;; Setting face attributes from X resources.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
275 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
276
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
277 (defcustom face-x-resources
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
278 '((:family (".attributeFamily" . "Face.AttributeFamily"))
95862
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
279 (:foundry (".attributeFoundry" . "Face.AttributeFoundry"))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
280 (:width (".attributeWidth" . "Face.AttributeWidth"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
281 (:height (".attributeHeight" . "Face.AttributeHeight"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
282 (:weight (".attributeWeight" . "Face.AttributeWeight"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
283 (:slant (".attributeSlant" . "Face.AttributeSlant"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
284 (:foreground (".attributeForeground" . "Face.AttributeForeground"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
285 (:background (".attributeBackground" . "Face.AttributeBackground"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
286 (:overline (".attributeOverline" . "Face.AttributeOverline"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
287 (:strike-through (".attributeStrikeThrough" . "Face.AttributeStrikeThrough"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
288 (:box (".attributeBox" . "Face.AttributeBox"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
289 (:underline (".attributeUnderline" . "Face.AttributeUnderline"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
290 (:inverse-video (".attributeInverse" . "Face.AttributeInverse"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
291 (:stipple
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
292 (".attributeStipple" . "Face.AttributeStipple")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
293 (".attributeBackgroundPixmap" . "Face.AttributeBackgroundPixmap"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
294 (:bold (".attributeBold" . "Face.AttributeBold"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
295 (:italic (".attributeItalic" . "Face.AttributeItalic"))
31193
a15c5cb8ec71 (face-x-resources): Add entry for :inherit.
Miles Bader <miles@gnu.org>
parents: 31190
diff changeset
296 (:font (".attributeFont" . "Face.AttributeFont"))
a15c5cb8ec71 (face-x-resources): Add entry for :inherit.
Miles Bader <miles@gnu.org>
parents: 31190
diff changeset
297 (:inherit (".attributeInherit" . "Face.AttributeInherit")))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
298 "*List of X resources and classes for face attributes.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
299 Each element has the form (ATTRIBUTE ENTRY1 ENTRY2...) where ATTRIBUTE is
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
300 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
301 \(RESOURCE . CLASS) with RESOURCE being the resource and CLASS being the
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
302 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
303 :type '(repeat (cons symbol (repeat (cons string string))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
304 :group 'faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
305
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
306
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
307 (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
308 (resource class frame))
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
309
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
310 (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
311 (face attr value &optional frame))
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
312
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
313 (defun set-face-attribute-from-resource (face attribute resource class frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
314 "Set FACE's ATTRIBUTE from X resource RESOURCE, class CLASS on FRAME.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
315 Value is the attribute value specified by the resource, or nil
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
316 if not present. This function displays a message if the resource
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
317 specifies an invalid attribute."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
318 (let* ((face-name (face-name face))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
319 (value (internal-face-x-get-resource (concat face-name resource)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
320 class frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
321 (when value
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
322 (condition-case ()
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
323 (internal-set-lisp-face-attribute-from-resource
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
324 face attribute (downcase value) frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
325 (error
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
326 (message "Face %s, frame %s: invalid attribute %s %s from X resource"
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
327 face-name frame attribute value))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
328 value))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
329
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
330
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
331 (defun set-face-attributes-from-resources (face frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
332 "Set attributes of FACE from X resources for FRAME."
32752
923b8d6d8277 Initial check-in: changes for building Emacs under Mac OS.
Andrew Choi <akochoi@shaw.ca>
parents: 32734
diff changeset
333 (when (memq (framep frame) '(x w32 mac))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
334 (dolist (definition face-x-resources)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
335 (let ((attribute (car definition)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
336 (dolist (entry (cdr definition))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
337 (set-face-attribute-from-resource face attribute (car entry)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
338 (cdr entry) frame))))))
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
339
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
340
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
341 (defun make-face-x-resource-internal (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
342 "Fill frame-local FACE on FRAME from X resources.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
343 FRAME nil or not specified means do it for all frames."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
344 (if (null frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
345 (dolist (frame (frame-list))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
346 (set-face-attributes-from-resources face frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
347 (set-face-attributes-from-resources face frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
348
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
349
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
350
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
351 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
352 ;;; Retrieving face attributes.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
353 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
354
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
355 (defun face-name (face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
356 "Return the name of face FACE."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
357 (symbol-name (check-face face)))
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
87494
26eb0118cbc6 (face-all-attributes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 87483
diff changeset
360 (defun face-all-attributes (face &optional frame)
26eb0118cbc6 (face-all-attributes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 87483
diff changeset
361 "Return an alist stating the attributes of FACE.
26eb0118cbc6 (face-all-attributes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 87483
diff changeset
362 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
363 Normally the value describes the default attributes,
26eb0118cbc6 (face-all-attributes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 87483
diff changeset
364 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
365 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
366 (mapcar (lambda (pair)
a6788888f377 (face-all-attributes): If FRAME is nil, return defaults.
Richard M. Stallman <rms@gnu.org>
parents: 87494
diff changeset
367 (let ((attr (car pair)))
a6788888f377 (face-all-attributes): If FRAME is nil, return defaults.
Richard M. Stallman <rms@gnu.org>
parents: 87494
diff changeset
368 (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
369 face-attribute-name-alist))
26eb0118cbc6 (face-all-attributes): New function.
Richard M. Stallman <rms@gnu.org>
parents: 87483
diff changeset
370
40399
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
371 (defun face-attribute (face attribute &optional frame inherit)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
372 "Return the value of FACE's ATTRIBUTE on FRAME.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
373 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
374 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
375 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
376
67049
580816de789f * faces.el: Revert 2005-11-17 change. :ignore-defface is now
Chong Yidong <cyd@stupidchicken.com>
parents: 66975
diff changeset
377 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
378 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
379 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
380 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
381 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
382 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
383 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
384
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
385 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
386 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
387 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
388 completely specified)."
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
389 (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
390 (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
391 ;; 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
392 (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
393 (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
394 (condition-case nil
56a63119fa20 (face-attribute): Handle the case where a face inherits from
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 66360
diff changeset
395 (setq value
56a63119fa20 (face-attribute): Handle the case where a face inherits from
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 66360
diff changeset
396 (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
397 ;; 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
398 (error nil)))))
40399
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
399 (when (and inherit
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
400 (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
401 (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
402 ;; 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
403 (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
404 value))
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
405
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
406 (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
407 "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
408 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
409 \[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
410 (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
411 value)
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
412 ((null faces)
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
413 value)
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
414 ((consp faces)
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
415 (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
416 attribute
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
417 (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
418 (cdr faces)
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
419 frame))
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
420 (t
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
421 (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
422 value
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
423 (face-attribute faces attribute frame t)))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
424
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
425
40399
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
426 (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
427 "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
428 (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
429 `(let ((,temp ,value))
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
430 (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
431 ,temp
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
432 ,@body))))
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
433
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
434 (defun face-foreground (face &optional frame inherit)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
435 "Return the foreground color name of FACE, or nil if unspecified.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
436 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
437 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
438 If FRAME is omitted or nil, use the selected frame.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
439
40399
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
440 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
441 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
442 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
443 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
444 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
445 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
446 resolve an unspecified foreground color.
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 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
449 `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
450 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
451 (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
452 nil))
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
453
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
454 (defun face-background (face &optional frame inherit)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
455 "Return the background color name of FACE, or nil if unspecified.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
456 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
457 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
458 If FRAME is omitted or nil, use the selected frame.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
459
40399
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
460 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
461 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
462 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
463 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
464 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
465 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
466 resolve an unspecified background color.
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 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
469 `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
470 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
471 (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
472 nil))
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
473
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
474 (defun face-stipple (face &optional frame inherit)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
475 "Return the stipple pixmap name of FACE, or nil if unspecified.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
476 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
477 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
478 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
479
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
480 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
481 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
482 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
483 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
484 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
485 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
486 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
487
3e67855bb4bf (face-attribute): Add INHERIT argument, consider face inheritance if non-nil.
Miles Bader <miles@gnu.org>
parents: 40351
diff changeset
488 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
489 `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
490 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
491 (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
492 nil))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
493
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
494
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
495 (defalias 'face-background-pixmap 'face-stipple)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
496
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
497
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
498 (defun face-underline-p (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
499 "Return non-nil if FACE is underlined.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
500 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
501 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
502 If FRAME is omitted or nil, use the selected frame."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
503 (eq (face-attribute face :underline frame) t))
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-inverse-video-p (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
507 "Return non-nil if FACE is in inverse video on FRAME.
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 :inverse-video 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-bold-p (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
515 "Return non-nil if the font of FACE is bold 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 Use `face-attribute' for finer control."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
520 (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
521 (memq bold '(semi-bold bold extra-bold ultra-bold))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
522
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
523
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
524 (defun face-italic-p (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
525 "Return non-nil if the font of FACE is italic on FRAME.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
526 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
527 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
528 If FRAME is omitted or nil, use the selected frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
529 Use `face-attribute' for finer control."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
530 (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
531 (memq italic '(italic oblique))))
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
532
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
533
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
534
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
535 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
536 ;;; Face documentation.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
537 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
538
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
539 (defun face-documentation (face)
63660
47c90f7c23df (face-documentation, set-face-attribute)
Glenn Morris <rgm@gnu.org>
parents: 63650
diff changeset
540 "Get the documentation string for FACE.
47c90f7c23df (face-documentation, set-face-attribute)
Glenn Morris <rgm@gnu.org>
parents: 63650
diff changeset
541 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
542 (let ((alias (get face 'face-alias))
47c90f7c23df (face-documentation, set-face-attribute)
Glenn Morris <rgm@gnu.org>
parents: 63650
diff changeset
543 doc)
47c90f7c23df (face-documentation, set-face-attribute)
Glenn Morris <rgm@gnu.org>
parents: 63650
diff changeset
544 (if alias
47c90f7c23df (face-documentation, set-face-attribute)
Glenn Morris <rgm@gnu.org>
parents: 63650
diff changeset
545 (progn
47c90f7c23df (face-documentation, set-face-attribute)
Glenn Morris <rgm@gnu.org>
parents: 63650
diff changeset
546 (setq doc (get alias 'face-documentation))
47c90f7c23df (face-documentation, set-face-attribute)
Glenn Morris <rgm@gnu.org>
parents: 63650
diff changeset
547 (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
548 (if doc (format "\n%s" doc)
47c90f7c23df (face-documentation, set-face-attribute)
Glenn Morris <rgm@gnu.org>
parents: 63650
diff changeset
549 "")))
47c90f7c23df (face-documentation, set-face-attribute)
Glenn Morris <rgm@gnu.org>
parents: 63650
diff changeset
550 (get face 'face-documentation))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
551
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
552
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
553 (defun set-face-documentation (face string)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
554 "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
555 ;; Perhaps the text should go in DOC.
26657
b5c0d55411ad (set-face-documentation): Purecopy STRING.
Dave Love <fx@gnu.org>
parents: 26353
diff changeset
556 (put face 'face-documentation (purecopy string)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
557
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
558
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
559 (defalias 'face-doc-string 'face-documentation)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
560 (defalias 'set-face-doc-string 'set-face-documentation)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
561
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
562
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
563
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
564 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
565 ;; Setting face attributes.
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
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
568
66360
fcb2ec449238 (inhibit-face-set-after-frame-default): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 66351
diff changeset
569 (defvar inhibit-face-set-after-frame-default nil
fcb2ec449238 (inhibit-face-set-after-frame-default): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 66351
diff changeset
570 "If non-nil, that tells `face-set-after-frame-default' to do nothing.")
fcb2ec449238 (inhibit-face-set-after-frame-default): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 66351
diff changeset
571
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
572 (defun set-face-attribute (face frame &rest args)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
573 "Set attributes of FACE on FRAME from ARGS.
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 FRAME nil means change attributes on all frames. FRAME t means change
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
576 the default for new frames (this is done automatically each time an
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
577 attribute is changed on all frames).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
578
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
579 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
580 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
581 this fact is not further mentioned below.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
582
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
583 The following attributes are recognized:
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
584
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
585 `:family'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
586
96292
fcffe32b9669 (set-face-attribute): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents: 96247
diff changeset
587 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
588 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
589 and `?' are allowed.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
590
95862
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
591 `:foundry'
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
592
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
593 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
594 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
595 and `?' are allowed.
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
596
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
597 `:width'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
598
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
599 VALUE specifies the relative proportionate width of the font to use.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
600 It must be one of the symbols `ultra-condensed', `extra-condensed',
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
601 `condensed', `semi-condensed', `normal', `semi-expanded', `expanded',
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
602 `extra-expanded', or `ultra-expanded'.
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 `:height'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
605
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
606 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
607 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
608 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
609 height (from the underlying face), and should return the new height.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
610
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
611 `:weight'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
612
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
613 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
614 symbols `ultra-bold', `extra-bold', `bold', `semi-bold', `normal',
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
615 `semi-light', `light', `extra-light', `ultra-light'.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
616
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
617 `:slant'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
618
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
619 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
620 symbols `italic', `oblique', `normal', `reverse-italic', or
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
621 `reverse-oblique'.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
622
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
623 `:foreground', `:background'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
624
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
625 VALUE must be a color name, a string.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
626
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
627 `:underline'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
628
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
629 VALUE specifies whether characters in FACE should be underlined. If
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
630 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
631 a string, underline with that color. If VALUE is nil, explicitly
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
632 don't 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 `:overline'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
635
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
636 VALUE specifies whether characters in FACE should be overlined. If
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
637 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
638 string, overline with that color. If VALUE is nil, explicitly don't
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 `:strike-through'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
642
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
643 VALUE specifies whether characters in FACE should be drawn with a line
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
644 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
645 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
646 is nil, explicitly don't 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 `:box'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
649
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
650 VALUE specifies whether characters in FACE should have a box drawn
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
651 around them. If VALUE is nil, explicitly don't draw boxes. If
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
652 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
653 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
654 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
655 VALUE must be a property list of the form `(:line-width WIDTH
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
656 :color COLOR :style STYLE)'. If a keyword/value pair is missing from
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
657 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
658 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
659 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
660 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
661 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
662 the foreground color of the face for simple boxes, and the background
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
663 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
664 should be draw. If STYLE is `released-button', draw a box looking
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
665 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
666 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
667 the property list doesn't contain a style specification, draw a 2D
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
668 box.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
669
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
670 `:inverse-video'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
671
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
672 VALUE specifies whether characters in FACE should be displayed in
28840
d0531e35d9f2 Some doc fixes.
Dave Love <fx@gnu.org>
parents: 28214
diff changeset
673 inverse video. VALUE must be one of t or nil.
25012
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 `:stipple'
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 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
678 The directories listed in the `x-bitmap-file-path' variable are
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
679 searched. Alternatively, VALUE may be a list of the form (WIDTH
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
680 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
681 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
682 explicitly don't use a stipple pattern.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
683
95862
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
684 For convenience, attributes `:family', `:foundry', `:width',
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
685 `: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
686 from an X font name:
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
687
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
688 `:font'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
689
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
690 Set font-related face attributes from VALUE. VALUE must be a valid
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
691 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
692 will be used.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
693
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
694 For compatibility with Emacs 20, keywords `:bold' and `:italic' can
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
695 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
696 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
697
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
698 `:inherit'
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
699
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
700 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
701 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
702 like an underlying face would be, with higher priority than underlying faces."
31439
d7a98f35b441 (set-face-attribute): Simplify by calling
Gerd Moellmann <gerd@gnu.org>
parents: 31401
diff changeset
703 (let ((where (if (null frame) 0 frame)))
d7a98f35b441 (set-face-attribute): Simplify by calling
Gerd Moellmann <gerd@gnu.org>
parents: 31401
diff changeset
704 (setq args (purecopy args))
51280
c2efaecb5d8f (set-face-attribute): Set face-modified prop to t
Richard M. Stallman <rms@gnu.org>
parents: 51248
diff changeset
705 ;; 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
706 (if (memq where '(0 t))
63660
47c90f7c23df (face-documentation, set-face-attribute)
Glenn Morris <rgm@gnu.org>
parents: 63650
diff changeset
707 (put (or (get face 'face-alias) face) 'face-modified t))
31439
d7a98f35b441 (set-face-attribute): Simplify by calling
Gerd Moellmann <gerd@gnu.org>
parents: 31401
diff changeset
708 (while args
66360
fcb2ec449238 (inhibit-face-set-after-frame-default): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 66351
diff changeset
709 ;; Don't recursively set the attributes from the frame's font param
96079
efbaf6995245 * w32fns.c, xfns.c (Qfont_param): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 96074
diff changeset
710 ;; when we update the frame's font param from the attributes.
66360
fcb2ec449238 (inhibit-face-set-after-frame-default): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 66351
diff changeset
711 (let ((inhibit-face-set-after-frame-default t))
95862
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
712 (if (and (eq (car args) :family)
95864
1388820636da (set-face-attribute): Fix previous change.
Kenichi Handa <handa@m17n.org>
parents: 95863
diff changeset
713 (stringp (cadr args))
95862
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
714 (string-match "\\([^-]*\\)-\\([^-]*\\)" (cadr args)))
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
715 (let ((foundry (match-string 1 (cadr args)))
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
716 (family (match-string 2 (cadr args))))
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
717 (internal-set-lisp-face-attribute face :foundry
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
718 (purecopy foundry)
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
719 where)
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
720 (internal-set-lisp-face-attribute face :family
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
721 (purecopy family)
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
722 where))
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
723 (internal-set-lisp-face-attribute face (car args)
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
724 (purecopy (cadr args))
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
725 where)))
31439
d7a98f35b441 (set-face-attribute): Simplify by calling
Gerd Moellmann <gerd@gnu.org>
parents: 31401
diff changeset
726 (setq args (cdr (cdr args))))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
727
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
728
26337
6bf33b333eb2 (make-face-bold, make-face-unbold, make-face-italic)
Gerd Moellmann <gerd@gnu.org>
parents: 25947
diff changeset
729 (defun make-face-bold (face &optional frame noerror)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
730 "Make the font of FACE be bold, if possible.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
731 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
732 Argument NOERROR is ignored and retained for compatibility.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
733 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
734 (interactive (list (read-face-name "Make which face bold")))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
735 (set-face-attribute face frame :weight 'bold))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
736
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
737
26337
6bf33b333eb2 (make-face-bold, make-face-unbold, make-face-italic)
Gerd Moellmann <gerd@gnu.org>
parents: 25947
diff changeset
738 (defun make-face-unbold (face &optional frame noerror)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
739 "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
740 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
741 Argument NOERROR is ignored and retained for compatibility."
40456
1f5aee41efe9 (read-face-name): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents: 40454
diff changeset
742 (interactive (list (read-face-name "Make which face non-bold")))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
743 (set-face-attribute face frame :weight 'normal))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
744
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
745
26337
6bf33b333eb2 (make-face-bold, make-face-unbold, make-face-italic)
Gerd Moellmann <gerd@gnu.org>
parents: 25947
diff changeset
746 (defun make-face-italic (face &optional frame noerror)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
747 "Make the font of FACE be italic, if possible.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
748 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
749 Argument NOERROR is ignored and retained for compatibility.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
750 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
751 (interactive (list (read-face-name "Make which face italic")))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
752 (set-face-attribute face frame :slant 'italic))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
753
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
754
26337
6bf33b333eb2 (make-face-bold, make-face-unbold, make-face-italic)
Gerd Moellmann <gerd@gnu.org>
parents: 25947
diff changeset
755 (defun make-face-unitalic (face &optional frame noerror)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
756 "Make the font of FACE be non-italic, if possible.
28840
d0531e35d9f2 Some doc fixes.
Dave Love <fx@gnu.org>
parents: 28214
diff changeset
757 FRAME nil or not specified means change face on all frames.
d0531e35d9f2 Some doc fixes.
Dave Love <fx@gnu.org>
parents: 28214
diff changeset
758 Argument NOERROR is ignored and retained for compatibility."
40456
1f5aee41efe9 (read-face-name): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents: 40454
diff changeset
759 (interactive (list (read-face-name "Make which face non-italic")))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
760 (set-face-attribute face frame :slant 'normal))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
761
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
762
26337
6bf33b333eb2 (make-face-bold, make-face-unbold, make-face-italic)
Gerd Moellmann <gerd@gnu.org>
parents: 25947
diff changeset
763 (defun make-face-bold-italic (face &optional frame noerror)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
764 "Make the font of FACE be bold and italic, if possible.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
765 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
766 Argument NOERROR is ignored and retained for compatibility.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
767 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
768 (interactive (list (read-face-name "Make which face bold-italic")))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
769 (set-face-attribute face frame :weight 'bold :slant 'italic))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
770
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
771
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
772 (defun set-face-font (face font &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
773 "Change font-related attributes of FACE to those of FONT (a string).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
774 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
775 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
776 `: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
777 prompt for the face and font."
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
778 (interactive (read-face-and-attribute :font))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
779 (set-face-attribute face frame :font font))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
780
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
781
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
782 ;; Implementation note: Emulating gray background colors with a
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
783 ;; stipple pattern is now part of the face realization process, and is
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
784 ;; 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
785
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
786 (defun set-face-background (face color &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
787 "Change the background color of face FACE to COLOR (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.
59281
95516eef1d5b (set-face-background, set-face-foreground): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 59262
diff changeset
789 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
790 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
791 When called interactively, prompts for the face and color."
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
792 (interactive (read-face-and-attribute :background))
36060
d9b4d1370073 (set-face-background, set-face-foreground)
Miles Bader <miles@gnu.org>
parents: 36035
diff changeset
793 (set-face-attribute face frame :background (or color 'unspecified)))
25012
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 (defun set-face-foreground (face color &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
797 "Change the foreground color of face FACE to COLOR (a string).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
798 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
799 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
800 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
801 When called interactively, prompts for the face and color."
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
802 (interactive (read-face-and-attribute :foreground))
36060
d9b4d1370073 (set-face-background, set-face-foreground)
Miles Bader <miles@gnu.org>
parents: 36035
diff changeset
803 (set-face-attribute face frame :foreground (or color 'unspecified)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
804
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
805
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
806 (defun set-face-stipple (face stipple &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
807 "Change the stipple pixmap of face FACE to STIPPLE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
808 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
809 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
810 The directories listed in the `x-bitmap-file-path' variable are searched.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
811
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
812 Alternatively, STIPPLE may be a list of the form (WIDTH HEIGHT DATA)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
813 where WIDTH and HEIGHT are the size in pixels,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
814 and DATA is a string, containing the raw bits of the bitmap."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
815 (interactive (read-face-and-attribute :stipple))
36060
d9b4d1370073 (set-face-background, set-face-foreground)
Miles Bader <miles@gnu.org>
parents: 36035
diff changeset
816 (set-face-attribute face frame :stipple (or stipple 'unspecified)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
817
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
818
75591
a0f90fb2d33d (set-face-underline-p, modify-face): Rename arg UNDERLINE-P
Juanma Barranquero <lekktu@gmail.com>
parents: 75579
diff changeset
819 (defun set-face-underline-p (face underline &optional frame)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
820 "Specify whether face FACE is underlined.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
821 UNDERLINE nil means FACE explicitly doesn't underline.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
822 UNDERLINE non-nil means FACE explicitly does underlining
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
823 with the same of the foreground color.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
824 If UNDERLINE is a string, underline with the color named UNDERLINE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
825 FRAME nil or not specified means change face on all frames.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
826 Use `set-face-attribute' to ``unspecify'' underlining."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
827 (interactive
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
828 (let ((list (read-face-and-attribute :underline)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
829 (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
830 (set-face-attribute face frame :underline underline))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
831
65068
6606e83775f0 (set-face-underline): Delete this duplicate function
Juri Linkov <juri@jurta.org>
parents: 64762
diff changeset
832 (define-obsolete-function-alias 'set-face-underline
6606e83775f0 (set-face-underline): Delete this duplicate function
Juri Linkov <juri@jurta.org>
parents: 64762
diff changeset
833 'set-face-underline-p "22.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
834
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
835
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
836 (defun set-face-inverse-video-p (face inverse-video-p &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
837 "Specify whether face FACE is in inverse video.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
838 INVERSE-VIDEO-P non-nil means FACE displays explicitly in inverse video.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
839 INVERSE-VIDEO-P nil means FACE explicitly is not in inverse video.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
840 FRAME nil or not specified means change face on all frames.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
841 Use `set-face-attribute' to ``unspecify'' the inverse video attribute."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
842 (interactive
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
843 (let ((list (read-face-and-attribute :inverse-video)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
844 (list (car list) (eq (car (cdr list)) t))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
845 (set-face-attribute face frame :inverse-video inverse-video-p))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
846
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
847
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
848 (defun set-face-bold-p (face bold-p &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
849 "Specify whether face FACE is bold.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
850 BOLD-P non-nil means FACE should explicitly display bold.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
851 BOLD-P nil means FACE should explicitly display non-bold.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
852 FRAME nil or not specified means change face on all frames.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
853 Use `set-face-attribute' or `modify-face' for finer control."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
854 (if (null bold-p)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
855 (make-face-unbold face frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
856 (make-face-bold face frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
857
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
858
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
859 (defun set-face-italic-p (face italic-p &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
860 "Specify whether face FACE is italic.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
861 ITALIC-P non-nil means FACE should explicitly display italic.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
862 ITALIC-P nil means FACE should explicitly display non-italic.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
863 FRAME nil or not specified means change face on all frames.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
864 Use `set-face-attribute' or `modify-face' for finer control."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
865 (if (null italic-p)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
866 (make-face-unitalic face frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
867 (make-face-italic face frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
868
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
869
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
870 (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
871
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
872
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
873 (defun invert-face (face &optional frame)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
874 "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
875 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
876 If FACE specifies neither foreground nor background color,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
877 set its foreground and background to the background and foreground
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
878 of the default face. Value is FACE."
40456
1f5aee41efe9 (read-face-name): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents: 40454
diff changeset
879 (interactive (list (read-face-name "Invert face")))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
880 (let ((fg (face-attribute face :foreground frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
881 (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
882 (if (not (and (eq fg 'unspecified) (eq bg 'unspecified)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
883 (set-face-attribute face frame :foreground bg :background fg)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
884 (set-face-attribute face frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
885 :foreground
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
886 (face-attribute 'default :background frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
887 :background
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
888 (face-attribute 'default :foreground frame))))
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
889 face)
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
890
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
891
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
892 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
893 ;;; Interactively modifying faces.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
894 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
895
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
896 (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
897 "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
898 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
899 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
900 it should not end in a space.
defa6bf31164 (read-face-name): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 71521
diff changeset
901 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
902 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
903 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
904 Otherwise, return a single face."
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
905 (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
906 (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
907 (aliasfaces nil)
9cbfa983c1cf (read-face-name): Use complete-in-turn complete non-aliases
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 63311
diff changeset
908 (nonaliasfaces nil)
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
909 faces)
63984
37ff9b4c3659 (read-face-name): Put the code for getting a face name
Juri Linkov <juri@jurta.org>
parents: 63881
diff changeset
910 ;; 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
911 (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
912 (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
913 ;; 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
914 (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
915 ;; 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
916 (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
917 (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
918 (dolist (f faceprop)
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
919 (if (symbolp f)
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
920 (push f faces)))
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
921 (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
922 (push faceprop faces)))
64724
719375653e09 (read-face-name): Delete duplicate faces.
Juri Linkov <juri@jurta.org>
parents: 64539
diff changeset
923 (delete-dups faces)
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
924
63382
9cbfa983c1cf (read-face-name): Use complete-in-turn complete non-aliases
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 63311
diff changeset
925 ;; 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
926 (mapatoms (lambda (s)
9cbfa983c1cf (read-face-name): Use complete-in-turn complete non-aliases
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 63311
diff changeset
927 (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
928 (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
929 (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
930 (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
931
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
932 ;; 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
933 ;; discard the unwanted ones now.
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
934 (unless multiple
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
935 (if faces
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
936 (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
937 (require 'crm)
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
938 (let* ((input
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
939 ;; 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
940 (completing-read-multiple
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
941 (if (or faces string-describing-default)
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
942 (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
943 (if faces (mapconcat 'symbol-name faces ",")
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
944 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
945 (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
946 (completion-table-in-turn nonaliasfaces aliasfaces)
63984
37ff9b4c3659 (read-face-name): Put the code for getting a face name
Juri Linkov <juri@jurta.org>
parents: 63881
diff changeset
947 nil t nil nil
37ff9b4c3659 (read-face-name): Put the code for getting a face name
Juri Linkov <juri@jurta.org>
parents: 63881
diff changeset
948 (if faces (mapconcat 'symbol-name faces ","))))
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
949 ;; Canonicalize the output.
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
950 (output
63984
37ff9b4c3659 (read-face-name): Put the code for getting a face name
Juri Linkov <juri@jurta.org>
parents: 63881
diff changeset
951 (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
952 faces)
37ff9b4c3659 (read-face-name): Put the code for getting a face name
Juri Linkov <juri@jurta.org>
parents: 63881
diff changeset
953 ((stringp input)
37ff9b4c3659 (read-face-name): Put the code for getting a face name
Juri Linkov <juri@jurta.org>
parents: 63881
diff changeset
954 (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
955 ((listp input)
37ff9b4c3659 (read-face-name): Put the code for getting a face name
Juri Linkov <juri@jurta.org>
parents: 63881
diff changeset
956 (mapcar 'intern input))
37ff9b4c3659 (read-face-name): Put the code for getting a face name
Juri Linkov <juri@jurta.org>
parents: 63881
diff changeset
957 (input))))
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
958 ;; 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
959 (if multiple
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
960 output
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
961 (car output)))))
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
962
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
963 ;; 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
964 (defvar x-bitmap-file-path)
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
965
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
966 (defun face-valid-attribute-values (attribute &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
967 "Return valid values for face attribute ATTRIBUTE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
968 The optional argument FRAME is used to determine available fonts
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
969 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
970 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
971 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
972 an integer value."
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
973 (let ((valid
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
974 (case attribute
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
975 (:family
83004
7900111db01c Converted display hooks to be display-local. Plus many bugfixes.
Karoly Lorentey <lorentey@elte.hu>
parents: 52401
diff changeset
976 (if (window-system frame)
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
977 (mapcar #'(lambda (x) (cons (car x) (car x)))
94956
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
978 (font-family-list))
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
979 ;; Only one font on TTYs.
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
980 (list (cons "default" "default"))))
95862
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
981 (:foundry
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
982 (list nil))
94956
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
983 (:width
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
984 (mapcar #'(lambda (x) (cons (symbol-name (car x)) (car x)))
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
985 font-width-table))
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
986 (:weight
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
987 (mapcar #'(lambda (x) (cons (symbol-name (car x)) (car x)))
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
988 font-weight-table))
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
989 (:slant
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
990 (mapcar #'(lambda (x) (cons (symbol-name (car x)) (car x)))
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
991 font-slant-table))
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
992 (:inverse-video
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
993 (mapcar #'(lambda (x) (cons (symbol-name x) x))
442dd15b3a1d (font-weight-table, font-slant-table)
Kenichi Handa <handa@m17n.org>
parents: 94678
diff changeset
994 (internal-lisp-face-attribute-values attribute)))
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
995 ((: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
996 (if (window-system frame)
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
997 (nconc (mapcar #'(lambda (x) (cons (symbol-name x) x))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
998 (internal-lisp-face-attribute-values attribute))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
999 (mapcar #'(lambda (c) (cons c c))
75703
374c5b932d28 (face-valid-attribute-values): Use `defined-colors',
Juanma Barranquero <lekktu@gmail.com>
parents: 75696
diff changeset
1000 (defined-colors frame)))
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1001 (mapcar #'(lambda (x) (cons (symbol-name x) x))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1002 (internal-lisp-face-attribute-values attribute))))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1003 ((:foreground :background)
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1004 (mapcar #'(lambda (c) (cons c c))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1005 (defined-colors frame)))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1006 ((:height)
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1007 'integerp)
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1008 (:stipple
83004
7900111db01c Converted display hooks to be display-local. Plus many bugfixes.
Karoly Lorentey <lorentey@elte.hu>
parents: 52401
diff changeset
1009 (and (memq (window-system frame) '(x w32 mac))
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1010 (mapcar #'list
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1011 (apply #'nconc
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1012 (mapcar (lambda (dir)
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1013 (and (file-readable-p dir)
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1014 (file-directory-p dir)
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1015 (directory-files dir)))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1016 x-bitmap-file-path)))))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1017 (:inherit
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1018 (cons '("none" . nil)
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1019 (mapcar #'(lambda (c) (cons (symbol-name c) c))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1020 (face-list))))
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1021 (t
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1022 (error "Internal error")))))
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1023 (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
1024 (nconc (list (cons "unspecified" 'unspecified)) valid)
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
1025 valid)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1026
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1027
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1028 (defvar face-attribute-name-alist
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1029 '((:family . "font family")
95862
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
1030 (:foundry . "font foundry")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1031 (:width . "character set width")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1032 (:height . "height in 1/10 pt")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1033 (:weight . "weight")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1034 (:slant . "slant")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1035 (:underline . "underline")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1036 (:overline . "overline")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1037 (:strike-through . "strike-through")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1038 (:box . "box")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1039 (:inverse-video . "inverse-video display")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1040 (:foreground . "foreground color")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1041 (:background . "background color")
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1042 (:stipple . "background stipple")
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1043 (:inherit . "inheritance"))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1044 "An alist of descriptive names for face attributes.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1045 Each element has the form (ATTRIBUTE-NAME . DESCRIPTION) where
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1046 ATTRIBUTE-NAME is a face attribute name (a keyword symbol), and
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1047 DESCRIPTION is a descriptive name for ATTRIBUTE-NAME.")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1048
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1049
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1050 (defun face-descriptive-attribute-name (attribute)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1051 "Return a descriptive name for ATTRIBUTE."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1052 (cdr (assq attribute face-attribute-name-alist)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1053
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1054
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1055 (defun face-read-string (face default name &optional completion-alist)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1056 "Interactively read a face attribute string value.
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1057 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
1058 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
1059 descriptive name of the attribute for prompting. COMPLETION-ALIST is an
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1060 alist of valid values, if non-nil.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1061
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1062 Entering nothing accepts the default string DEFAULT.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1063 Value is the new attribute value."
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1064 ;; Capitalize NAME (we don't use `capitalize' because that capitalizes
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1065 ;; each word in a string separately).
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1066 (setq name (concat (upcase (substring name 0 1)) (substring name 1)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1067 (let* ((completion-ignore-case t)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1068 (value (completing-read
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1069 (if default
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1070 (format "%s for face `%s' (default %s): "
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1071 name face default)
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1072 (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
1073 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
1074 (if (equal value "") default value)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1075
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1076
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1077 (defun face-read-integer (face default name)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1078 "Interactively read an integer face attribute value.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1079 FACE is the face whose attribute is read. DEFAULT is the default
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1080 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
1081 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
1082 (let ((new-value
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
1083 (face-read-string face
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1084 (format "%s" default)
25245
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
1085 name
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
1086 (list (cons "unspecified" 'unspecified)))))
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1087 (cond ((equal new-value "unspecified")
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1088 'unspecified)
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1089 ((member new-value '("unspecified-fg" "unspecified-bg"))
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1090 new-value)
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1091 (t
62402
a7e02ef1e3d6 Replace `string-to-int' by `string-to-number'.
Juanma Barranquero <lekktu@gmail.com>
parents: 62386
diff changeset
1092 (string-to-number new-value)))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1093
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1094
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1095 (defun read-face-attribute (face attribute &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1096 "Interactively read a new value for FACE's ATTRIBUTE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1097 Optional argument FRAME nil or unspecified means read an attribute value
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1098 of a global face. Value is the new attribute value."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1099 (let* ((old-value (face-attribute face attribute frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1100 (attribute-name (face-descriptive-attribute-name attribute))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1101 (valid (face-valid-attribute-values attribute frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1102 new-value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1103 ;; Represent complex attribute values as strings by printing them
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1104 ;; out. Stipple can be a vector; (WIDTH HEIGHT DATA). Box can be
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1105 ;; a list `(:width WIDTH :color COLOR)' or `(:width WIDTH :shadow
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1106 ;; SHADOW)'.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1107 (when (and (or (eq attribute :stipple)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1108 (eq attribute :box))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1109 (or (consp old-value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1110 (vectorp old-value)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1111 (setq old-value (prin1-to-string old-value)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1112 (cond ((listp valid)
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1113 (let ((default
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1114 (or (car (rassoc old-value valid))
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1115 (format "%s" old-value))))
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1116 (setq new-value
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1117 (face-read-string face default attribute-name valid))
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1118 (if (equal new-value default)
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1119 ;; Nothing changed, so don't bother with all the stuff
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1120 ;; below. In particular, this avoids a non-tty color
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1121 ;; from being canonicalized for a tty when the user
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1122 ;; just uses the default.
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1123 (setq new-value old-value)
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1124 ;; Terminal frames can support colors that don't appear
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1125 ;; explicitly in VALID, using color approximation code
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1126 ;; 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
1127 (when (and (memq attribute '(:foreground :background))
83004
7900111db01c Converted display hooks to be display-local. Plus many bugfixes.
Karoly Lorentey <lorentey@elte.hu>
parents: 52401
diff changeset
1128 (not (memq (window-system frame) '(x w32 mac)))
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
1129 (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
1130 '("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
1131 "unspecified-fg" "unspecified-bg"))))
34587
Miles Bader <miles@gnu.org>
parents: 34585
diff changeset
1132 (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
1133 (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
1134 (setq new-value (cdr (assoc new-value valid)))))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1135 ((eq valid 'integerp)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1136 (setq new-value (face-read-integer face old-value attribute-name)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1137 (t (error "Internal error")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1138 ;; 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
1139 ;; vector if it looks like one. This makes the assumption that a
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1140 ;; pixmap file name won't start with an open-paren.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1141 (when (and (or (eq attribute :stipple)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1142 (eq attribute :box))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1143 (stringp new-value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1144 (string-match "^[[(]" new-value))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1145 (setq new-value (read new-value)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1146 new-value))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1147
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1148 (declare-function fontset-list "fontset.c" ())
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1149 (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
1150 (pattern &optional face frame maximum width))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1151
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1152 (defun read-face-font (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1153 "Read the name of a font for FACE on FRAME.
64539
c94d5f576885 (describe-face): "?\ " -> "?\s".
Juanma Barranquero <lekktu@gmail.com>
parents: 64497
diff changeset
1154 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
1155 (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
1156 (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
1157 (append (fontset-list) (x-list-fonts "*" nil frame)))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1158
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1159
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1160 (defun read-all-face-attributes (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1161 "Interactively read all attributes for FACE.
64539
c94d5f576885 (describe-face): "?\ " -> "?\s".
Juanma Barranquero <lekktu@gmail.com>
parents: 64497
diff changeset
1162 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
1163 Value is a property list of attribute names and new values."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1164 (let (result)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1165 (dolist (attribute face-attribute-name-alist result)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1166 (setq result (cons (car attribute)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1167 (cons (read-face-attribute face (car attribute) frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1168 result))))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1169
37467
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1170 (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
1171 bold-p italic-p underline inverse-p frame)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1172 "Modify attributes of faces interactively.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1173 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
1174 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
1175 For non-interactive use, `set-face-attribute' is preferred.
64539
c94d5f576885 (describe-face): "?\ " -> "?\s".
Juanma Barranquero <lekktu@gmail.com>
parents: 64497
diff changeset
1176 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
1177 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
1178 (interactive)
37467
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1179 (if face
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1180 (set-face-attribute face frame
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1181 :foreground (or foreground 'unspecified)
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1182 :background (or background 'unspecified)
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1183 :stipple stipple
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1184 :bold bold-p
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1185 :italic italic-p
75591
a0f90fb2d33d (set-face-underline-p, modify-face): Rename arg UNDERLINE-P
Juanma Barranquero <lekktu@gmail.com>
parents: 75579
diff changeset
1186 :underline underline
37467
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1187 :inverse-video inverse-p)
342409bb6b91 (modify-face): Add compatibility for non-interactive use.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 37294
diff changeset
1188 (setq face (read-face-name "Modify face"))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1189 (apply #'set-face-attribute face frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1190 (read-all-face-attributes face frame))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1191
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1192 (defun read-face-and-attribute (attribute &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1193 "Read face name and face attribute value.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1194 ATTRIBUTE is the attribute whose new value is read.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1195 FRAME nil or unspecified means read attribute value of global face.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1196 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
1197 \(a symbol), and NEW-VALUE is value read."
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1198 (cond ((eq attribute :font)
31197
39d437913f44 (read-face-font, read-face-and-attribute): Tweak prompts.
Miles Bader <miles@gnu.org>
parents: 31193
diff changeset
1199 (let* ((prompt "Set font-related attributes of face")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1200 (face (read-face-name prompt))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1201 (font (read-face-font face frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1202 (list face font)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1203 (t
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1204 (let* ((attribute-name (face-descriptive-attribute-name attribute))
31190
85a616c90339 (set-face-attribute):
Miles Bader <miles@gnu.org>
parents: 31179
diff changeset
1205 (prompt (format "Set %s of face" attribute-name))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1206 (face (read-face-name prompt))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1207 (new-value (read-face-attribute face attribute frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1208 (list face new-value)))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1209
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1210
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1211
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1212 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1213 ;;; Listing faces.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1214 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1215
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1216 (defvar list-faces-sample-text
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1217 "abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ"
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1218 "*Text string to display as the sample text for `list-faces-display'.")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1219
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1220
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1221 ;; 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
1222 ;; conflict with Lucid, which uses that name differently.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1223
48914
bb52f186fa1e (help-xref-stack): Add defvar to avoid warning.
Richard M. Stallman <rms@gnu.org>
parents: 48713
diff changeset
1224 (defvar help-xref-stack)
59872
d7da3e10bfef (list-faces-display): Add optional argument.
Richard M. Stallman <rms@gnu.org>
parents: 59281
diff changeset
1225 (defun list-faces-display (&optional regexp)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1226 "List all faces, using the same sample text in each.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1227 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
1228 `list-faces-sample-text'.
d7da3e10bfef (list-faces-display): Add optional argument.
Richard M. Stallman <rms@gnu.org>
parents: 59281
diff changeset
1229
d7da3e10bfef (list-faces-display): Add optional argument.
Richard M. Stallman <rms@gnu.org>
parents: 59281
diff changeset
1230 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
1231 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
1232 arg, prompt for a regular expression."
d7da3e10bfef (list-faces-display): Add optional argument.
Richard M. Stallman <rms@gnu.org>
parents: 59281
diff changeset
1233 (interactive (list (and current-prefix-arg
d7da3e10bfef (list-faces-display): Add optional argument.
Richard M. Stallman <rms@gnu.org>
parents: 59281
diff changeset
1234 (read-string "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
1235 (let ((all-faces (zerop (length regexp)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1236 (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
1237 (max-length 0)
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1238 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
1239 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
1240 ;; 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
1241 (setq faces
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1242 (delq nil
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1243 (mapcar (lambda (f)
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1244 (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
1245 (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
1246 (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
1247 f)))
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1248 (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
1249 (unless faces
2a5dbdf6d22a (list-faces-display): Improve the formatting by computing the maximum length
Juanma Barranquero <lekktu@gmail.com>
parents: 62922
diff changeset
1250 (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
1251 (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
1252 line-format (format "%%-%ds" max-length))
86010
d42c1cd75af4 (list-faces-display, describe-face):
Martin Rudalics <rudalics@gmx.at>
parents: 85996
diff changeset
1253 (with-help-window "*Faces*"
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1254 (save-excursion
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1255 (set-buffer standard-output)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1256 (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
1257 (insert
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1258 (substitute-command-keys
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1259 (concat
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1260 "Use "
27736
b4d0a1247b35 (list-faces-display): Use display-mouse-p, not window-system.
Eli Zaretskii <eliz@gnu.org>
parents: 27716
diff changeset
1261 (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
1262 "\\[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
1263 "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
1264 (setq help-xref-stack nil)
59872
d7da3e10bfef (list-faces-display): Add optional argument.
Richard M. Stallman <rms@gnu.org>
parents: 59281
diff changeset
1265 (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
1266 (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
1267 (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
1268 ;; 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
1269 ;; 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
1270 (save-excursion
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1271 (save-match-data
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1272 (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
1273 (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
1274 (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
1275 (let ((beg (point))
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1276 (line-beg (line-beginning-position)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1277 (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
1278 ;; 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
1279 (save-excursion
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1280 (save-match-data
a3d981ee3185 Don't require custom. Add more specific :groups to various deffaces.
Dave Love <fx@gnu.org>
parents: 27571
diff changeset
1281 (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
1282 (help-xref-button 0 'help-face face)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1283 (insert "\n")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1284 (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
1285 ;; 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
1286 ;; anywhere in the line.
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1287 (put-text-property line-beg (1- (point)) 'read-face-name face)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1288 ;; If the sample text has multiple lines, line up all of them.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1289 (goto-char beg)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1290 (forward-line 1)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1291 (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
1292 (insert-char ?\s max-length)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1293 (forward-line 1))))
86010
d42c1cd75af4 (list-faces-display, describe-face):
Martin Rudalics <rudalics@gmx.at>
parents: 85996
diff changeset
1294 (goto-char (point-min))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1295 ;; If the *Faces* buffer appears in a different frame,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1296 ;; copy all the face definitions from FRAME,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1297 ;; so that the display will reflect the frame that was selected.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1298 (setq window (get-buffer-window (get-buffer "*Faces*") t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1299 (setq disp-frame (if window (window-frame window)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1300 (car (frame-list))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1301 (or (eq frame disp-frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1302 (let ((faces (face-list)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1303 (while faces
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1304 (copy-face (car faces) (car faces) frame disp-frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1305 (setq faces (cdr faces)))))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1306
59872
d7da3e10bfef (list-faces-display): Add optional argument.
Richard M. Stallman <rms@gnu.org>
parents: 59281
diff changeset
1307
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1308 (defun describe-face (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1309 "Display the properties of face FACE on FRAME.
45314
d752ae89321a (describe-face): Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents: 45255
diff changeset
1310 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
1311 and FRAME defaults to the selected frame.
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1312
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1313 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
1314 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
1315 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
1316 (interactive (list (read-face-name "Describe face" "= `default' face" t)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1317 (let* ((attrs '((:family . "Family")
95862
afdd781501c8 (set-face-attribute): Parse "FOUNDRY-FAMILY" form here.
Kenichi Handa <handa@m17n.org>
parents: 95841
diff changeset
1318 (:foundry . "Foundry")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1319 (:width . "Width")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1320 (:height . "Height")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1321 (:weight . "Weight")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1322 (:slant . "Slant")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1323 (:foreground . "Foreground")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1324 (:background . "Background")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1325 (:underline . "Underline")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1326 (:overline . "Overline")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1327 (:strike-through . "Strike-through")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1328 (:box . "Box")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1329 (:inverse-video . "Inverse")
28214
73c16c6e401e (read-face-font): Fix TABLE arg to completing-read.
Kenichi Handa <handa@m17n.org>
parents: 27928
diff changeset
1330 (:stipple . "Stipple")
89129
ed1d9d1cfc71 (describe-face): Describe :fontset property too.
Kenichi Handa <handa@m17n.org>
parents: 43550
diff changeset
1331 (:font . "Font")
ed1d9d1cfc71 (describe-face): Describe :fontset property too.
Kenichi Handa <handa@m17n.org>
parents: 43550
diff changeset
1332 (:fontset . "Fontset")
31179
354c781f2864 (describe-face): Add support for :inherit attribute.
Miles Bader <miles@gnu.org>
parents: 30971
diff changeset
1333 (:inherit . "Inherit")))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1334 (max-width (apply #'max (mapcar #'(lambda (x) (length (cdr x)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1335 attrs))))
39830
aed9c3afb7ed (describe-face): Call help-setup-xref earlier.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39799
diff changeset
1336 (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
1337 (unless face
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1338 (setq face 'default))
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1339 (if (not (listp face))
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1340 (setq face (list face)))
86010
d42c1cd75af4 (list-faces-display, describe-face):
Martin Rudalics <rudalics@gmx.at>
parents: 85996
diff changeset
1341 (with-help-window (help-buffer)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1342 (save-excursion
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1343 (set-buffer standard-output)
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1344 (dolist (f face)
85297
01f68ac2fb98 (describe-face): Allow handling a string as the face name.
Juri Linkov <juri@jurta.org>
parents: 85272
diff changeset
1345 (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
1346 (insert "Face: " (symbol-name f))
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1347 (if (not (facep f))
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1348 (insert " undefined face.\n")
62386
3eeae124dcab (describe-face): Output a definition link button.
Richard M. Stallman <rms@gnu.org>
parents: 61481
diff changeset
1349 (let ((customize-label "customize this face")
3eeae124dcab (describe-face): Output a definition link button.
Richard M. Stallman <rms@gnu.org>
parents: 61481
diff changeset
1350 file-name)
73668
1d779fbeeaef (faces-sample-overlay, describe-face): Revert last changes.
Eli Zaretskii <eliz@gnu.org>
parents: 73580
diff changeset
1351 (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
1352 (princ (concat " (" customize-label ")\n"))
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1353 (insert "Documentation: "
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1354 (or (face-documentation f)
46041
53b3233b2574 (describe-face): Capitalize "not documented" message.
Juanma Barranquero <lekktu@gmail.com>
parents: 45722
diff changeset
1355 "Not documented as a face.")
62386
3eeae124dcab (describe-face): Output a definition link button.
Richard M. Stallman <rms@gnu.org>
parents: 61481
diff changeset
1356 "\n")
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1357 (with-current-buffer standard-output
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1358 (save-excursion
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1359 (re-search-backward
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1360 (concat "\\(" customize-label "\\)") nil t)
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1361 (help-xref-button 1 'help-customize-face f)))
62386
3eeae124dcab (describe-face): Output a definition link button.
Richard M. Stallman <rms@gnu.org>
parents: 61481
diff changeset
1362 ;; The next 4 sexps are copied from describe-function-1
3eeae124dcab (describe-face): Output a definition link button.
Richard M. Stallman <rms@gnu.org>
parents: 61481
diff changeset
1363 ;; and simplified.
3eeae124dcab (describe-face): Output a definition link button.
Richard M. Stallman <rms@gnu.org>
parents: 61481
diff changeset
1364 (setq file-name (symbol-file f 'defface))
66351
fc5672d9fc45 (describe-face): Use describe-simplify-lib-file-name.
Richard M. Stallman <rms@gnu.org>
parents: 65730
diff changeset
1365 (setq file-name (describe-simplify-lib-file-name file-name))
62386
3eeae124dcab (describe-face): Output a definition link button.
Richard M. Stallman <rms@gnu.org>
parents: 61481
diff changeset
1366 (when file-name
3eeae124dcab (describe-face): Output a definition link button.
Richard M. Stallman <rms@gnu.org>
parents: 61481
diff changeset
1367 (princ "Defined in `")
3eeae124dcab (describe-face): Output a definition link button.
Richard M. Stallman <rms@gnu.org>
parents: 61481
diff changeset
1368 (princ file-name)
3eeae124dcab (describe-face): Output a definition link button.
Richard M. Stallman <rms@gnu.org>
parents: 61481
diff changeset
1369 (princ "'")
3eeae124dcab (describe-face): Output a definition link button.
Richard M. Stallman <rms@gnu.org>
parents: 61481
diff changeset
1370 ;; Make a hyperlink to the library.
3eeae124dcab (describe-face): Output a definition link button.
Richard M. Stallman <rms@gnu.org>
parents: 61481
diff changeset
1371 (save-excursion
3eeae124dcab (describe-face): Output a definition link button.
Richard M. Stallman <rms@gnu.org>
parents: 61481
diff changeset
1372 (re-search-backward "`\\([^`']+\\)'" nil t)
3eeae124dcab (describe-face): Output a definition link button.
Richard M. Stallman <rms@gnu.org>
parents: 61481
diff changeset
1373 (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
1374 (princ ".")
3eeae124dcab (describe-face): Output a definition link button.
Richard M. Stallman <rms@gnu.org>
parents: 61481
diff changeset
1375 (terpri)
3eeae124dcab (describe-face): Output a definition link button.
Richard M. Stallman <rms@gnu.org>
parents: 61481
diff changeset
1376 (terpri))
44886
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1377 (dolist (a attrs)
fe167023fdf0 (read-face-name): New defaulting features.
Richard M. Stallman <rms@gnu.org>
parents: 44590
diff changeset
1378 (let ((attr (face-attribute f (car a) frame)))
64539
c94d5f576885 (describe-face): "?\ " -> "?\s".
Juanma Barranquero <lekktu@gmail.com>
parents: 64497
diff changeset
1379 (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
1380 (cdr a) ": " (format "%s" attr))
6606e83775f0 (set-face-underline): Delete this duplicate function
Juri Linkov <juri@jurta.org>
parents: 64762
diff changeset
1381 (if (and (eq (car a) :inherit)
6606e83775f0 (set-face-underline): Delete this duplicate function
Juri Linkov <juri@jurta.org>
parents: 64762
diff changeset
1382 (not (eq attr 'unspecified)))
6606e83775f0 (set-face-underline): Delete this duplicate function
Juri Linkov <juri@jurta.org>
parents: 64762
diff changeset
1383 ;; Make a hyperlink to the parent face.
6606e83775f0 (set-face-underline): Delete this duplicate function
Juri Linkov <juri@jurta.org>
parents: 64762
diff changeset
1384 (save-excursion
6606e83775f0 (set-face-underline): Delete this duplicate function
Juri Linkov <juri@jurta.org>
parents: 64762
diff changeset
1385 (re-search-backward ": \\([^:]+\\)" nil t)
6606e83775f0 (set-face-underline): Delete this duplicate function
Juri Linkov <juri@jurta.org>
parents: 64762
diff changeset
1386 (help-xref-button 1 'help-face attr)))
6606e83775f0 (set-face-underline): Delete this duplicate function
Juri Linkov <juri@jurta.org>
parents: 64762
diff changeset
1387 (insert "\n")))))
86010
d42c1cd75af4 (list-faces-display, describe-face):
Martin Rudalics <rudalics@gmx.at>
parents: 85996
diff changeset
1388 (terpri))))))
39799
99f30ac48ec0 (list-faces-display, describe-face): Fix args to `help-xref-button'.
Miles Bader <miles@gnu.org>
parents: 39549
diff changeset
1389
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1390
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1391 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1392 ;;; Face specifications (defface).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1393 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1394
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1395 ;; Parameter FRAME Is kept for call compatibility to with previous
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1396 ;; face implementation.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1397
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1398 (defun face-attr-construct (face &optional frame)
64539
c94d5f576885 (describe-face): "?\ " -> "?\s".
Juanma Barranquero <lekktu@gmail.com>
parents: 64497
diff changeset
1399 "Return a `defface'-style attribute list for FACE on FRAME.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1400 Value is a property list of pairs ATTRIBUTE VALUE for all specified
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1401 face attributes of FACE where ATTRIBUTE is the attribute name and
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1402 VALUE is the specified value of that attribute."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1403 (let (result)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1404 (dolist (entry face-attribute-name-alist result)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1405 (let* ((attribute (car entry))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1406 (value (face-attribute face attribute)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1407 (unless (eq value 'unspecified)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1408 (setq result (nconc (list attribute value) result)))))))
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1409
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1410
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1411 (defun face-spec-set-match-display (display frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1412 "Non-nil if DISPLAY matches FRAME.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1413 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
1414 If FRAME is nil, the current FRAME is used."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1415 (let* ((conjuncts display)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1416 conjunct req options
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1417 ;; t means we have succeeded against all the conjuncts in
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1418 ;; DISPLAY that have been tested so far.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1419 (match t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1420 (if (eq conjuncts t)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1421 (setq conjuncts nil))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1422 (while (and conjuncts match)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1423 (setq conjunct (car conjuncts)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1424 conjuncts (cdr conjuncts)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1425 req (car conjunct)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1426 options (cdr conjunct)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1427 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
1428 (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
1429 ;; 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
1430 ;; 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
1431 ;; 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
1432 ;; 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
1433 ;; 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
1434 ;; 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
1435 (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
1436 (memq 'tty options))
25887
099a3776ff00 (face-spec-set-match-display): Recognize `type' of
Gerd Moellmann <gerd@gnu.org>
parents: 25814
diff changeset
1437 (and (memq 'motif options)
099a3776ff00 (face-spec-set-match-display): Recognize `type' of
Gerd Moellmann <gerd@gnu.org>
parents: 25814
diff changeset
1438 (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
1439 (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
1440 (featurep 'gtk))
25887
099a3776ff00 (face-spec-set-match-display): Recognize `type' of
Gerd Moellmann <gerd@gnu.org>
parents: 25814
diff changeset
1441 (and (memq 'lucid options)
099a3776ff00 (face-spec-set-match-display): Recognize `type' of
Gerd Moellmann <gerd@gnu.org>
parents: 25814
diff changeset
1442 (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
1443 (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
1444 (not (featurep 'gtk)))
25887
099a3776ff00 (face-spec-set-match-display): Recognize `type' of
Gerd Moellmann <gerd@gnu.org>
parents: 25814
diff changeset
1445 (and (memq 'x-toolkit options)
099a3776ff00 (face-spec-set-match-display): Recognize `type' of
Gerd Moellmann <gerd@gnu.org>
parents: 25814
diff changeset
1446 (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
1447 ((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
1448 (>= (display-color-cells frame) (car options)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1449 ((eq req 'class)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1450 (memq (frame-parameter frame 'display-type) options))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1451 ((eq req 'background)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1452 (memq (frame-parameter frame 'background-mode)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1453 options))
45722
c553d91619aa (display-supports-face-attributes-p): Work correctly if DISPLAY is a frame.
Miles Bader <miles@gnu.org>
parents: 45717
diff changeset
1454 ((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
1455 (display-supports-face-attributes-p options frame))
28840
d0531e35d9f2 Some doc fixes.
Dave Love <fx@gnu.org>
parents: 28214
diff changeset
1456 (t (error "Unknown req `%S' with options `%S'"
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1457 req options)))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1458 match))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1459
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1460
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1461 (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
1462 "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
1463 If SPEC is nil, return nil."
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1464 (unless frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1465 (setq frame (selected-frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1466 (let ((tail spec)
58935
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1467 result defaults)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1468 (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
1469 (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
1470 (display (car entry))
58935
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1471 (attrs (cdr entry))
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1472 thisval)
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1473 ;; 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
1474 (setq thisval
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1475 (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
1476 ;; 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
1477 ;; first element.
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1478 (car attrs)
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1479 attrs))
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1480
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1481 ;; 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
1482 ;; for following conditions.
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1483 (if (eq display 'default)
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1484 (setq defaults thisval)
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1485 ;; Otherwise, if it matches, use it.
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1486 (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
1487 (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
1488 (setq tail nil)))))
58935
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
1489 (if defaults (append result defaults) result)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1490
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1491
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1492 (defun face-spec-reset-face (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1493 "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
1494 (let ((attrs face-attribute-name-alist))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1495 (while attrs
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1496 (let ((attr-and-name (car attrs)))
31401
0b8165a82e34 (set-face-attribute, face-spec-reset-face)
Gerd Moellmann <gerd@gnu.org>
parents: 31197
diff changeset
1497 (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
1498 (setq attrs (cdr attrs)))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1499
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1500
87483
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1501 (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
1502 "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
1503 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
1504 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
1505 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
1506 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
1507 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
1508
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1509 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
1510 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
1511 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
1512
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1513 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
1514 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
1515 That usage is deprecated.
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1516
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1517 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
1518 (if (framep for-defface)
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1519 ;; 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
1520 (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
1521 (if for-defface
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1522 ;; 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
1523 ;; 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
1524 (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
1525 ;; 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
1526 ;; 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
1527 (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
1528 ;;; RMS 29 dec 2007: Perhaps this code should be reinstated.
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1529 ;;; That depends on whether the overriding spec
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1530 ;;; or the default face attributes
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1531 ;;; should take priority.
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1532 ;;; ;; Clear all the new-frame default attributes for this face.
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1533 ;;; ;; face-spec-reset-face won't do it right.
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1534 ;;; (let ((facevec (cdr (assq face face-new-frame-defaults))))
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1535 ;;; (dotimes (i (length facevec))
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1536 ;;; (unless (= i 0)
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1537 ;;; (aset facevec i 'unspecified))))
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1538 ;; 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
1539 (dolist (frame (frame-list))
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1540 (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
1541
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1542 (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
1543 "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
1544 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
1545 then the override spec."
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1546 (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
1547 (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
1548 (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
1549 (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
1550 (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
1551 (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
1552 (dolist (spec theme-faces)
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1553 (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
1554 (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
1555
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1556 (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
1557 "Set the face attributes of FACE on FRAME according to SPEC."
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1558 (let* ((attrs (face-spec-choose spec frame)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1559 (while attrs
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1560 (let ((attribute (car attrs))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1561 (value (car (cdr attrs))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1562 ;; Support some old-style attribute names and values.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1563 (case attribute
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1564 (:bold (setq attribute :weight value (if value 'bold 'normal)))
30010
281fa98f5c87 (face-spec-set): Ignore invalid attributes like 20.x.
Gerd Moellmann <gerd@gnu.org>
parents: 29976
diff changeset
1565 (:italic (setq attribute :slant value (if value 'italic 'normal)))
34682
4130c0ad0a5e (face-spec-set): Interpret a nil in specs for
Gerd Moellmann <gerd@gnu.org>
parents: 34587
diff changeset
1566 ((:foreground :background)
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
1567 ;; Compatibility with 20.x. Some bogus face specs seem to
34682
4130c0ad0a5e (face-spec-set): Interpret a nil in specs for
Gerd Moellmann <gerd@gnu.org>
parents: 34587
diff changeset
1568 ;; exist containing things like `:foreground nil'.
4130c0ad0a5e (face-spec-set): Interpret a nil in specs for
Gerd Moellmann <gerd@gnu.org>
parents: 34587
diff changeset
1569 (if (null value) (setq value 'unspecified)))
30010
281fa98f5c87 (face-spec-set): Ignore invalid attributes like 20.x.
Gerd Moellmann <gerd@gnu.org>
parents: 29976
diff changeset
1570 (t (unless (assq attribute face-x-resources)
281fa98f5c87 (face-spec-set): Ignore invalid attributes like 20.x.
Gerd Moellmann <gerd@gnu.org>
parents: 29976
diff changeset
1571 (setq attribute nil))))
281fa98f5c87 (face-spec-set): Ignore invalid attributes like 20.x.
Gerd Moellmann <gerd@gnu.org>
parents: 29976
diff changeset
1572 (when attribute
31401
0b8165a82e34 (set-face-attribute, face-spec-reset-face)
Gerd Moellmann <gerd@gnu.org>
parents: 31197
diff changeset
1573 (set-face-attribute face frame attribute value)))
87483
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1574 (setq attrs (cdr (cdr attrs))))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1575
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1576 (defun face-attr-match-p (face attrs &optional frame)
30971
9a23751378f3 (face-attr-match-p):
Miles Bader <miles@gnu.org>
parents: 30306
diff changeset
1577 "Return t if attributes of FACE match values in plist ATTRS.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1578 Optional parameter FRAME is the frame whose definition of FACE
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1579 is used. If nil or omitted, use the selected frame."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1580 (unless frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1581 (setq frame (selected-frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1582 (let ((list face-attribute-name-alist)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1583 (match t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1584 (while (and match (not (null list)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1585 (let* ((attr (car (car list)))
30971
9a23751378f3 (face-attr-match-p):
Miles Bader <miles@gnu.org>
parents: 30306
diff changeset
1586 (specified-value
9a23751378f3 (face-attr-match-p):
Miles Bader <miles@gnu.org>
parents: 30306
diff changeset
1587 (if (plist-member attrs attr)
9a23751378f3 (face-attr-match-p):
Miles Bader <miles@gnu.org>
parents: 30306
diff changeset
1588 (plist-get attrs attr)
9a23751378f3 (face-attr-match-p):
Miles Bader <miles@gnu.org>
parents: 30306
diff changeset
1589 'unspecified))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1590 (value-now (face-attribute face attr frame)))
30971
9a23751378f3 (face-attr-match-p):
Miles Bader <miles@gnu.org>
parents: 30306
diff changeset
1591 (setq match (equal specified-value value-now))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1592 (setq list (cdr list))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1593 match))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1594
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1595 (defun face-spec-match-p (face spec &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1596 "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
1597 (face-attr-match-p face (face-spec-choose spec frame) frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1598
32795
975cc2648ee4 (face-default-spec, face-user-default-spec): Make defsubsts.
Miles Bader <miles@gnu.org>
parents: 32758
diff changeset
1599 (defsubst face-default-spec (face)
975cc2648ee4 (face-default-spec, face-user-default-spec): Make defsubsts.
Miles Bader <miles@gnu.org>
parents: 32758
diff changeset
1600 "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
1601 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
1602 (get face 'face-defface-spec))
975cc2648ee4 (face-default-spec, face-user-default-spec): Make defsubsts.
Miles Bader <miles@gnu.org>
parents: 32758
diff changeset
1603
975cc2648ee4 (face-default-spec, face-user-default-spec): Make defsubsts.
Miles Bader <miles@gnu.org>
parents: 32758
diff changeset
1604 (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
1605 "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
1606 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
1607 (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
1608 (get face 'saved-face)
32795
975cc2648ee4 (face-default-spec, face-user-default-spec): Make defsubsts.
Miles Bader <miles@gnu.org>
parents: 32758
diff changeset
1609 (face-default-spec face)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1610
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1611
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1612 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26736
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1613 ;;; 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
1614 ;;; 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
1615 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1616
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1617 (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
1618 "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
1619 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
1620 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
1621 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
1622 If FRAME is nil, that stands for the selected frame."
32752
923b8d6d8277 Initial check-in: changes for building Emacs under Mac OS.
Andrew Choi <akochoi@shaw.ca>
parents: 32734
diff changeset
1623 (if (memq (framep (or frame (selected-frame))) '(x w32 mac))
26736
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1624 (xw-defined-colors frame)
27090
52e469fb402a (read-face-attribute, defined-colors, color-defined-p):
Eli Zaretskii <eliz@gnu.org>
parents: 26927
diff changeset
1625 (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
1626 (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
1627
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1628 (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
1629
26736
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1630 (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
1631 "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
1632 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
1633 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
1634 \"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
1635 (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
1636 nil
32752
923b8d6d8277 Initial check-in: changes for building Emacs under Mac OS.
Andrew Choi <akochoi@shaw.ca>
parents: 32734
diff changeset
1637 (if (member (framep (or frame (selected-frame))) '(x w32 mac))
26736
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1638 (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
1639 (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
1640 (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
1641
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1642 (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
1643
26736
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1644 (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
1645 "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
1646 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
1647 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
1648 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
1649 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
1650 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
1651 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
1652 \"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
1653 (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
1654 nil
32752
923b8d6d8277 Initial check-in: changes for building Emacs under Mac OS.
Andrew Choi <akochoi@shaw.ca>
parents: 32734
diff changeset
1655 (if (memq (framep (or frame (selected-frame))) '(x w32 mac))
26736
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1656 (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
1657 (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
1658 (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
1659
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1660 (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
1661
26736
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1662 (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
1663 "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
1664 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
1665 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
1666 If omitted or nil, that stands for the selected frame's display."
32752
923b8d6d8277 Initial check-in: changes for building Emacs under Mac OS.
Andrew Choi <akochoi@shaw.ca>
parents: 32734
diff changeset
1667 (if (memq (framep-on-display display) '(x w32 mac))
27571
4a4f7f602836 (display-color-p): Use framep-on-display.
Eli Zaretskii <eliz@gnu.org>
parents: 27117
diff changeset
1668 (xw-display-color-p display)
4a4f7f602836 (display-color-p): Use framep-on-display.
Eli Zaretskii <eliz@gnu.org>
parents: 27117
diff changeset
1669 (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
1670 (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
1671
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1672 (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
1673
27571
4a4f7f602836 (display-color-p): Use framep-on-display.
Eli Zaretskii <eliz@gnu.org>
parents: 27117
diff changeset
1674 (defun display-grayscale-p (&optional display)
4a4f7f602836 (display-color-p): Use framep-on-display.
Eli Zaretskii <eliz@gnu.org>
parents: 27117
diff changeset
1675 "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
1676 (let ((frame-type (framep-on-display display)))
4a4f7f602836 (display-color-p): Use framep-on-display.
Eli Zaretskii <eliz@gnu.org>
parents: 27117
diff changeset
1677 (cond
4a4f7f602836 (display-color-p): Use framep-on-display.
Eli Zaretskii <eliz@gnu.org>
parents: 27117
diff changeset
1678 ((memq frame-type '(x w32 mac))
4a4f7f602836 (display-color-p): Use framep-on-display.
Eli Zaretskii <eliz@gnu.org>
parents: 27117
diff changeset
1679 (x-display-grayscale-p display))
4a4f7f602836 (display-color-p): Use framep-on-display.
Eli Zaretskii <eliz@gnu.org>
parents: 27117
diff changeset
1680 (t
4a4f7f602836 (display-color-p): Use framep-on-display.
Eli Zaretskii <eliz@gnu.org>
parents: 27117
diff changeset
1681 (> (tty-color-gray-shades display) 2)))))
4a4f7f602836 (display-color-p): Use framep-on-display.
Eli Zaretskii <eliz@gnu.org>
parents: 27117
diff changeset
1682
85758
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1683 (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
1684 "Read a color name or RGB hex value: #RRRRGGGGBBBB.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1685 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
1686 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
1687 #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
1688 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
1689 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
1690
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1691 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
1692 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
1693 color is used.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1694
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1695 * `foreground at point' - foreground under the cursor
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1696 * `background at point' - background under the cursor
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1697
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1698 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
1699 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
1700 ALLOW-EMPTY-NAME-P).
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1701
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1702 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
1703
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1704 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
1705 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
1706
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1707 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
1708 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
1709 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
1710 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
1711 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
1712
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1713 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
1714 a message."
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1715 (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
1716 (let* ((completion-ignore-case t)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1717 (colors (append '("foreground at point" "background at point")
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1718 (defined-colors)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1719 (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
1720 colors))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1721 hex-string)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1722 (cond ((string= "foreground at point" color)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1723 (setq color (foreground-color-at-point)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1724 ((string= "background at point" color)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1725 (setq color (background-color-at-point))))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1726 (unless color
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1727 (setq color ""))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1728 (setq hex-string
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1729 (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
1730 (if (and allow-empty-name-p (string= "" color))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1731 ""
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1732 (when (and hex-string (not (eq (aref color 0) ?#)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1733 (setq color (concat "#" color))) ; No #; add it.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1734 (unless hex-string
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1735 (when (or (string= "" color) (not (test-completion color colors)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1736 (error "No such color: %S" color))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1737 (when convert-to-RGB-p
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1738 (let ((components (x-color-values color)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1739 (unless components (error "No such color: %S" color))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1740 (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
1741 (setq color (format "#%04X%04X%04X"
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1742 (logand 65535 (nth 0 components))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1743 (logand 65535 (nth 1 components))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1744 (logand 65535 (nth 2 components))))))))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1745 (when msg-p (message "Color: `%s'" color))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1746 color)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1747
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1748 ;; 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
1749 ;; duplicates in read-color's completion list.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1750
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1751 ;; (defun defined-colors-without-duplicates ()
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1752 ;; "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
1753 ;; 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
1754 ;; (let ((result (copy-sequence (defined-colors)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1755 ;; to-be-rejected)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1756 ;; (save-match-data
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1757 ;; (dolist (this result)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1758 ;; (if (string-match " " this)
92115
b4b2ac0c80f8 (font-weight-table): Fix value of `semi-light'.
Juanma Barranquero <lekktu@gmail.com>
parents: 92112
diff changeset
1759 ;; (push (replace-regexp-in-string " " ""
85758
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1760 ;; this)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1761 ;; to-be-rejected)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1762 ;; (dolist (elt to-be-rejected)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1763 ;; (let ((as-found (car (member-ignore-case elt result))))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1764 ;; (setq result (delete as-found result)))))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1765 ;; result))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1766
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1767 (defun face-at-point ()
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1768 "Return the face of the character after point.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1769 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
1770 Return nil if it has no specified face."
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1771 (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
1772 (get-char-property (point) 'face)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1773 'default))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1774 (face (cond ((symbolp faceprop) faceprop)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1775 ;; List of faces (don't treat an attribute spec).
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1776 ;; Just use the first face.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1777 ((and (consp faceprop) (not (keywordp (car faceprop)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1778 (not (memq (car faceprop)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1779 '(foreground-color background-color))))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1780 (car faceprop))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1781 (t nil)))) ; Invalid face value.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1782 (if (facep face) face nil)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1783
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1784 (defun foreground-color-at-point ()
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1785 "Return the foreground color of the character after point."
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1786 ;; `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
1787 ;; 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
1788 (let ((face (or (face-at-point)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1789 (get-char-property (point) 'read-face-name)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1790 (get-char-property (point) 'face))))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1791 (cond ((and face (symbolp face))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1792 (let ((value (face-foreground face nil 'default)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1793 (if (member value '("unspecified-fg" "unspecified-bg"))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1794 nil
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1795 value)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1796 ((consp face)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1797 (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
1798 ((memq ':foreground face) (cadr (memq ':foreground face)))))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1799 (t nil)))) ; Invalid face value.
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1800
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1801 (defun background-color-at-point ()
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1802 "Return the background color of the character after point."
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1803 ;; `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
1804 ;; 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
1805 (let ((face (or (face-at-point)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1806 (get-char-property (point) 'read-face-name)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1807 (get-char-property (point) 'face))))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1808 (cond ((and face (symbolp face))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1809 (let ((value (face-background face nil 'default)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1810 (if (member value '("unspecified-fg" "unspecified-bg"))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1811 nil
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1812 value)))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1813 ((consp face)
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1814 (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
1815 ((memq ':background face) (cadr (memq ':background face)))))
674b001d26e1 (read-color): New function.
Richard M. Stallman <rms@gnu.org>
parents: 85415
diff changeset
1816 (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
1817
a0674327c167 Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents: 26657
diff changeset
1818 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1819 ;;; Background mode.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1820 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1821
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1822 (defcustom frame-background-mode nil
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1823 "*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
1824 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
1825 `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
1826 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
1827 variable with `setq'; this won't have the expected effect."
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1828 :group 'faces
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1829 :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
1830 (set-default var value)
31528
a461cad7a942 (face-x-resources): Make custom type more specific.
Dave Love <fx@gnu.org>
parents: 31500
diff changeset
1831 (mapc 'frame-set-background-mode (frame-list)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1832 :initialize 'custom-initialize-changed
67503
71e68cea180c (frame-background-mode): Replace `choice-item' keywords
Juri Linkov <juri@jurta.org>
parents: 67049
diff changeset
1833 :type '(choice (const dark)
71e68cea180c (frame-background-mode): Replace `choice-item' keywords
Juri Linkov <juri@jurta.org>
parents: 67049
diff changeset
1834 (const light)
71e68cea180c (frame-background-mode): Replace `choice-item' keywords
Juri Linkov <juri@jurta.org>
parents: 67049
diff changeset
1835 (const :tag "automatic" nil)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1836
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1837
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1838 (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
1839 (attribute class &optional component subclass))
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1840
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1841 (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
1842 "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
1843 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
1844 according to the `background-mode' and `display-type' frame parameters."
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1845 (let* ((bg-resource
83004
7900111db01c Converted display hooks to be display-local. Plus many bugfixes.
Karoly Lorentey <lorentey@elte.hu>
parents: 52401
diff changeset
1846 (and (window-system frame)
50025
ffbc79f0f914 (frame-set-background-mode): Fix reference to attribute "backgroundMode".
Juanma Barranquero <lekktu@gmail.com>
parents: 48914
diff changeset
1847 (x-get-resource "backgroundMode" "BackgroundMode")))
32641
48709f040160 (frame-set-background-mode): If a tty frame defines a
Eli Zaretskii <eliz@gnu.org>
parents: 32404
diff changeset
1848 (bg-color (frame-parameter frame 'background-color))
83524
673d62ad74b5 Fix and/or simplify terminal initialization files.
Karoly Lorentey <lorentey@elte.hu>
parents: 83523
diff changeset
1849 (terminal-bg-mode (terminal-parameter frame 'background-mode))
673d62ad74b5 Fix and/or simplify terminal initialization files.
Karoly Lorentey <lorentey@elte.hu>
parents: 83523
diff changeset
1850 (tty-type (tty-type frame))
32376
267a06bd1387 (frame-set-background-mode):
Miles Bader <miles@gnu.org>
parents: 32373
diff changeset
1851 (bg-mode
267a06bd1387 (frame-set-background-mode):
Miles Bader <miles@gnu.org>
parents: 32373
diff changeset
1852 (cond (frame-background-mode)
32641
48709f040160 (frame-set-background-mode): If a tty frame defines a
Eli Zaretskii <eliz@gnu.org>
parents: 32404
diff changeset
1853 (bg-resource
48709f040160 (frame-set-background-mode): If a tty frame defines a
Eli Zaretskii <eliz@gnu.org>
parents: 32404
diff changeset
1854 (intern (downcase bg-resource)))
83524
673d62ad74b5 Fix and/or simplify terminal initialization files.
Karoly Lorentey <lorentey@elte.hu>
parents: 83523
diff changeset
1855 (terminal-bg-mode)
83074
34a7a8f40548 Fix background-mode on terminal frames (Dan Nicolaescu).
Karoly Lorentey <lorentey@elte.hu>
parents: 83067
diff changeset
1856 ((and (null (window-system frame))
34a7a8f40548 Fix background-mode on terminal frames (Dan Nicolaescu).
Karoly Lorentey <lorentey@elte.hu>
parents: 83067
diff changeset
1857 ;; Unspecified frame background color can only
34a7a8f40548 Fix background-mode on terminal frames (Dan Nicolaescu).
Karoly Lorentey <lorentey@elte.hu>
parents: 83067
diff changeset
1858 ;; happen on tty's.
34a7a8f40548 Fix background-mode on terminal frames (Dan Nicolaescu).
Karoly Lorentey <lorentey@elte.hu>
parents: 83067
diff changeset
1859 (member bg-color '(nil unspecified "unspecified-bg")))
34a7a8f40548 Fix background-mode on terminal frames (Dan Nicolaescu).
Karoly Lorentey <lorentey@elte.hu>
parents: 83067
diff changeset
1860 ;; There is no way to determine the background mode
34a7a8f40548 Fix background-mode on terminal frames (Dan Nicolaescu).
Karoly Lorentey <lorentey@elte.hu>
parents: 83067
diff changeset
1861 ;; automatically, so we make a guess based on the
34a7a8f40548 Fix background-mode on terminal frames (Dan Nicolaescu).
Karoly Lorentey <lorentey@elte.hu>
parents: 83067
diff changeset
1862 ;; terminal type.
34a7a8f40548 Fix background-mode on terminal frames (Dan Nicolaescu).
Karoly Lorentey <lorentey@elte.hu>
parents: 83067
diff changeset
1863 (if (and tty-type
34a7a8f40548 Fix background-mode on terminal frames (Dan Nicolaescu).
Karoly Lorentey <lorentey@elte.hu>
parents: 83067
diff changeset
1864 (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)"
34a7a8f40548 Fix background-mode on terminal frames (Dan Nicolaescu).
Karoly Lorentey <lorentey@elte.hu>
parents: 83067
diff changeset
1865 tty-type))
34a7a8f40548 Fix background-mode on terminal frames (Dan Nicolaescu).
Karoly Lorentey <lorentey@elte.hu>
parents: 83067
diff changeset
1866 'light
34a7a8f40548 Fix background-mode on terminal frames (Dan Nicolaescu).
Karoly Lorentey <lorentey@elte.hu>
parents: 83067
diff changeset
1867 'dark))
32734
92b46ad86f6a (color-values, color-defined-p): Use `member', not
Miles Bader <miles@gnu.org>
parents: 32649
diff changeset
1868 ((equal bg-color "unspecified-fg") ; inverted colors
83074
34a7a8f40548 Fix background-mode on terminal frames (Dan Nicolaescu).
Karoly Lorentey <lorentey@elte.hu>
parents: 83067
diff changeset
1869 (if (and tty-type
34a7a8f40548 Fix background-mode on terminal frames (Dan Nicolaescu).
Karoly Lorentey <lorentey@elte.hu>
parents: 83067
diff changeset
1870 (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)"
34a7a8f40548 Fix background-mode on terminal frames (Dan Nicolaescu).
Karoly Lorentey <lorentey@elte.hu>
parents: 83067
diff changeset
1871 tty-type))
34a7a8f40548 Fix background-mode on terminal frames (Dan Nicolaescu).
Karoly Lorentey <lorentey@elte.hu>
parents: 83067
diff changeset
1872 'dark
34a7a8f40548 Fix background-mode on terminal frames (Dan Nicolaescu).
Karoly Lorentey <lorentey@elte.hu>
parents: 83067
diff changeset
1873 'light))
75705
6c6d674034cd (frame-set-background-mode): Use `color-values' and `display-color-p',
Juanma Barranquero <lekktu@gmail.com>
parents: 75703
diff changeset
1874 ((>= (apply '+ (color-values bg-color frame))
32376
267a06bd1387 (frame-set-background-mode):
Miles Bader <miles@gnu.org>
parents: 32373
diff changeset
1875 ;; Just looking at the screen, colors whose
267a06bd1387 (frame-set-background-mode):
Miles Bader <miles@gnu.org>
parents: 32373
diff changeset
1876 ;; values add up to .6 of the white total
267a06bd1387 (frame-set-background-mode):
Miles Bader <miles@gnu.org>
parents: 32373
diff changeset
1877 ;; still look dark to me.
75705
6c6d674034cd (frame-set-background-mode): Use `color-values' and `display-color-p',
Juanma Barranquero <lekktu@gmail.com>
parents: 75703
diff changeset
1878 (* (apply '+ (color-values "white" frame)) .6))
32641
48709f040160 (frame-set-background-mode): If a tty frame defines a
Eli Zaretskii <eliz@gnu.org>
parents: 32404
diff changeset
1879 'light)
48709f040160 (frame-set-background-mode): If a tty frame defines a
Eli Zaretskii <eliz@gnu.org>
parents: 32404
diff changeset
1880 (t 'dark)))
32376
267a06bd1387 (frame-set-background-mode):
Miles Bader <miles@gnu.org>
parents: 32373
diff changeset
1881 (display-type
83004
7900111db01c Converted display hooks to be display-local. Plus many bugfixes.
Karoly Lorentey <lorentey@elte.hu>
parents: 52401
diff changeset
1882 (cond ((null (window-system frame))
32376
267a06bd1387 (frame-set-background-mode):
Miles Bader <miles@gnu.org>
parents: 32373
diff changeset
1883 (if (tty-display-color-p frame) 'color 'mono))
75705
6c6d674034cd (frame-set-background-mode): Use `color-values' and `display-color-p',
Juanma Barranquero <lekktu@gmail.com>
parents: 75703
diff changeset
1884 ((display-color-p frame)
32376
267a06bd1387 (frame-set-background-mode):
Miles Bader <miles@gnu.org>
parents: 32373
diff changeset
1885 'color)
267a06bd1387 (frame-set-background-mode):
Miles Bader <miles@gnu.org>
parents: 32373
diff changeset
1886 ((x-display-grayscale-p frame)
267a06bd1387 (frame-set-background-mode):
Miles Bader <miles@gnu.org>
parents: 32373
diff changeset
1887 'grayscale)
267a06bd1387 (frame-set-background-mode):
Miles Bader <miles@gnu.org>
parents: 32373
diff changeset
1888 (t 'mono)))
267a06bd1387 (frame-set-background-mode):
Miles Bader <miles@gnu.org>
parents: 32373
diff changeset
1889 (old-bg-mode
267a06bd1387 (frame-set-background-mode):
Miles Bader <miles@gnu.org>
parents: 32373
diff changeset
1890 (frame-parameter frame 'background-mode))
267a06bd1387 (frame-set-background-mode):
Miles Bader <miles@gnu.org>
parents: 32373
diff changeset
1891 (old-display-type
267a06bd1387 (frame-set-background-mode):
Miles Bader <miles@gnu.org>
parents: 32373
diff changeset
1892 (frame-parameter frame 'display-type)))
267a06bd1387 (frame-set-background-mode):
Miles Bader <miles@gnu.org>
parents: 32373
diff changeset
1893
267a06bd1387 (frame-set-background-mode):
Miles Bader <miles@gnu.org>
parents: 32373
diff changeset
1894 (unless (and (eq bg-mode old-bg-mode) (eq display-type old-display-type))
34246
e7acfcef56ae (frame-set-background-mode): Avoid stomping on locally modified faces.
Miles Bader <miles@gnu.org>
parents: 34162
diff changeset
1895 (let ((locally-modified-faces nil))
e7acfcef56ae (frame-set-background-mode): Avoid stomping on locally modified faces.
Miles Bader <miles@gnu.org>
parents: 34162
diff changeset
1896 ;; Before modifying the frame parameters, we collect a list of
e7acfcef56ae (frame-set-background-mode): Avoid stomping on locally modified faces.
Miles Bader <miles@gnu.org>
parents: 34162
diff changeset
1897 ;; faces that don't match what their face-spec says they should
87483
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1898 ;; look like; we then avoid changing these faces below.
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1899 ;; These are the faces whose attributes were modified on FRAME.
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1900 ;; We use a negative list on the assumption that most faces will
34246
e7acfcef56ae (frame-set-background-mode): Avoid stomping on locally modified faces.
Miles Bader <miles@gnu.org>
parents: 34162
diff changeset
1901 ;; be unmodified, so we can avoid consing in the common case.
e7acfcef56ae (frame-set-background-mode): Avoid stomping on locally modified faces.
Miles Bader <miles@gnu.org>
parents: 34162
diff changeset
1902 (dolist (face (face-list))
87483
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1903 (and (not (get face 'face-override-spec))
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1904 (not (face-spec-match-p face
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1905 (face-user-default-spec face)
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1906 (selected-frame)))
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1907 (push face locally-modified-faces)))
34246
e7acfcef56ae (frame-set-background-mode): Avoid stomping on locally modified faces.
Miles Bader <miles@gnu.org>
parents: 34162
diff changeset
1908 ;; Now change to the new frame parameters
e7acfcef56ae (frame-set-background-mode): Avoid stomping on locally modified faces.
Miles Bader <miles@gnu.org>
parents: 34162
diff changeset
1909 (modify-frame-parameters frame
e7acfcef56ae (frame-set-background-mode): Avoid stomping on locally modified faces.
Miles Bader <miles@gnu.org>
parents: 34162
diff changeset
1910 (list (cons 'background-mode bg-mode)
e7acfcef56ae (frame-set-background-mode): Avoid stomping on locally modified faces.
Miles Bader <miles@gnu.org>
parents: 34162
diff changeset
1911 (cons 'display-type display-type)))
e7acfcef56ae (frame-set-background-mode): Avoid stomping on locally modified faces.
Miles Bader <miles@gnu.org>
parents: 34162
diff changeset
1912 ;; For all named faces, choose face specs matching the new frame
e7acfcef56ae (frame-set-background-mode): Avoid stomping on locally modified faces.
Miles Bader <miles@gnu.org>
parents: 34162
diff changeset
1913 ;; parameters, unless they have been locally modified.
e7acfcef56ae (frame-set-background-mode): Avoid stomping on locally modified faces.
Miles Bader <miles@gnu.org>
parents: 34162
diff changeset
1914 (dolist (face (face-list))
e7acfcef56ae (frame-set-background-mode): Avoid stomping on locally modified faces.
Miles Bader <miles@gnu.org>
parents: 34162
diff changeset
1915 (unless (memq face locally-modified-faces)
87483
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
1916 (face-spec-recalc face frame)))))))
25012
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
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 ;;; Frame creation.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1921 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1922
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1923 (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
1924
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1925 (defun x-handle-named-frame-geometry (parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1926 "Add geometry parameters for a named frame to parameter list PARAMETERS.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1927 Value is the new parameter list."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1928 (let* ((name (or (cdr (assq 'name parameters))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1929 (cdr (assq 'name default-frame-alist))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1930 (x-resource-name name)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1931 (res-geometry (if name (x-get-resource "geometry" "Geometry"))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1932 (when res-geometry
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1933 (let ((parsed (x-parse-geometry res-geometry)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1934 ;; If the resource specifies a position, call the position
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1935 ;; and size "user-specified".
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1936 (when (or (assq 'top parsed)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1937 (assq 'left parsed))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1938 (setq parsed (append '((user-position . t) (user-size . t)) parsed)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1939 ;; Put the geometry parameters at the end. Copy
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1940 ;; default-frame-alist so that they go after it.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1941 (setq parameters (append parameters default-frame-alist parsed))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1942 parameters))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1943
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1944
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1945 (defun x-handle-reverse-video (frame parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1946 "Handle the reverse-video frame parameter and X resource.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1947 `x-create-frame' does not handle this one."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1948 (when (cdr (or (assq 'reverse parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1949 (assq 'reverse default-frame-alist)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1950 (let ((resource (x-get-resource "reverseVideo"
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1951 "ReverseVideo")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1952 (if resource
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1953 (cons nil (member (downcase resource)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1954 '("on" "true")))))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1955 (let* ((params (frame-parameters frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1956 (bg (cdr (assq 'foreground-color params)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1957 (fg (cdr (assq 'background-color params))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1958 (modify-frame-parameters frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1959 (list (cons 'foreground-color fg)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1960 (cons 'background-color bg)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1961 (if (equal bg (cdr (assq 'border-color params)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1962 (modify-frame-parameters frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1963 (list (cons 'border-color fg))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1964 (if (equal bg (cdr (assq 'mouse-color params)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1965 (modify-frame-parameters frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1966 (list (cons 'mouse-color fg))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1967 (if (equal bg (cdr (assq 'cursor-color params)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1968 (modify-frame-parameters frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1969 (list (cons 'cursor-color fg)))))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1970
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1971 (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
1972 (declare-function x-setup-function-keys "term/x-win" (frame))
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95787
diff changeset
1973 (declare-function tool-bar-setup "tool-bar" (&optional frame))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1974
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1975 (defun x-create-frame-with-faces (&optional parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1976 "Create a frame from optional frame parameters PARAMETERS.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1977 Parameters not specified by PARAMETERS are taken from
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1978 `default-frame-alist'. If PARAMETERS specify a frame name,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1979 handle X geometry resources for that name. If either PARAMETERS
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1980 or `default-frame-alist' contains a `reverse' parameter, or
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1981 the X resource ``reverseVideo'' is present, handle that.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1982 Value is the new frame created."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1983 (setq parameters (x-handle-named-frame-geometry parameters))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1984 (let ((visibility-spec (assq 'visibility parameters))
83016
1d7467694692 Fix initialization of the window-system variable.
Karoly Lorentey <lorentey@elte.hu>
parents: 83014
diff changeset
1985 (frame (x-create-frame `((visibility . nil) . ,parameters)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1986 success)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1987 (unwind-protect
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1988 (progn
83316
102194c6d773 Update Lisp code for a terminal-local `function-key-map'.
Karoly Lorentey <lorentey@elte.hu>
parents: 83314
diff changeset
1989 (x-setup-function-keys frame)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1990 (x-handle-reverse-video frame parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1991 (frame-set-background-mode frame)
51248
e21b4eb91135 (x-create-frame-with-faces): Call `face-set-after-frame-default'.
John Paul Wallington <jpw@pobox.com>
parents: 51095
diff changeset
1992 (face-set-after-frame-default frame)
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
1993 ;; Make sure the tool-bar is ready to be enabled. The
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
1994 ;; `tool-bar-lines' frame parameter will not take effect
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
1995 ;; without this call.
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
1996 (tool-bar-setup frame)
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
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2005 (defun face-set-after-frame-default (frame)
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2006 "Set frame-local faces of FRAME from face specs and resources.
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2007 Initialize colors of certain faces from frame parameters."
66360
fcb2ec449238 (inhibit-face-set-after-frame-default): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 66351
diff changeset
2008 (unless inhibit-face-set-after-frame-default
95863
d4b7c9244713 (set-face-attribute): Parse "FOUNDRY-FAMILY" here.
Kenichi Handa <handa@m17n.org>
parents: 95862
diff changeset
2009 (if (face-attribute 'default :font t)
66360
fcb2ec449238 (inhibit-face-set-after-frame-default): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 66351
diff changeset
2010 (set-face-attribute 'default frame :font
95863
d4b7c9244713 (set-face-attribute): Parse "FOUNDRY-FAMILY" here.
Kenichi Handa <handa@m17n.org>
parents: 95862
diff changeset
2011 (face-attribute 'default :font t))
d4b7c9244713 (set-face-attribute): Parse "FOUNDRY-FAMILY" here.
Kenichi Handa <handa@m17n.org>
parents: 95862
diff changeset
2012 (set-face-attribute 'default frame :family
d4b7c9244713 (set-face-attribute): Parse "FOUNDRY-FAMILY" here.
Kenichi Handa <handa@m17n.org>
parents: 95862
diff changeset
2013 (face-attribute 'default :family t))
d4b7c9244713 (set-face-attribute): Parse "FOUNDRY-FAMILY" here.
Kenichi Handa <handa@m17n.org>
parents: 95862
diff changeset
2014 (set-face-attribute 'default frame :height
d4b7c9244713 (set-face-attribute): Parse "FOUNDRY-FAMILY" here.
Kenichi Handa <handa@m17n.org>
parents: 95862
diff changeset
2015 (face-attribute 'default :height t))
d4b7c9244713 (set-face-attribute): Parse "FOUNDRY-FAMILY" here.
Kenichi Handa <handa@m17n.org>
parents: 95862
diff changeset
2016 (set-face-attribute 'default frame :slant
d4b7c9244713 (set-face-attribute): Parse "FOUNDRY-FAMILY" here.
Kenichi Handa <handa@m17n.org>
parents: 95862
diff changeset
2017 (face-attribute 'default :slant t))
d4b7c9244713 (set-face-attribute): Parse "FOUNDRY-FAMILY" here.
Kenichi Handa <handa@m17n.org>
parents: 95862
diff changeset
2018 (set-face-attribute 'default frame :weight
d4b7c9244713 (set-face-attribute): Parse "FOUNDRY-FAMILY" here.
Kenichi Handa <handa@m17n.org>
parents: 95862
diff changeset
2019 (face-attribute 'default :weight t))
d4b7c9244713 (set-face-attribute): Parse "FOUNDRY-FAMILY" here.
Kenichi Handa <handa@m17n.org>
parents: 95862
diff changeset
2020 (set-face-attribute 'default frame :width
d4b7c9244713 (set-face-attribute): Parse "FOUNDRY-FAMILY" here.
Kenichi Handa <handa@m17n.org>
parents: 95862
diff changeset
2021 (face-attribute 'default :width t))))
75696
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2022 ;; Find attributes that should be initialized from frame parameters.
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2023 (let ((face-params '((foreground-color default :foreground)
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2024 (background-color default :background)
96079
efbaf6995245 * w32fns.c, xfns.c (Qfont_param): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 96074
diff changeset
2025 (font-parameter default :font)
75696
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2026 (border-color border :background)
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2027 (cursor-color cursor :background)
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2028 (scroll-bar-foreground scroll-bar :foreground)
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2029 (scroll-bar-background scroll-bar :background)
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2030 (mouse-color mouse :background)))
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2031 apply-params)
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2032 (dolist (param face-params)
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2033 (let* ((value (frame-parameter frame (nth 0 param)))
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2034 (face (nth 1 param))
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2035 (attr (nth 2 param))
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2036 (default-value (face-attribute face attr t)))
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2037 ;; Compile a list of face attributes to set, but don't set
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2038 ;; them yet. The call to make-face-x-resource-internal,
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2039 ;; below, can change frame parameters, and the final set of
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2040 ;; frame parameters should be the ones acquired at this step.
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2041 (if (eq default-value 'unspecified)
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2042 ;; The face spec does not specify a new-frame value for
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2043 ;; this attribute. Check if the existing frame parameter
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2044 ;; specifies it.
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2045 (if value
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2046 (push (list face frame attr value) apply-params))
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2047 ;; The face spec specifies a value for this attribute, to be
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2048 ;; applied to the face on all new frames.
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2049 (push (list face frame attr default-value) apply-params))))
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2050 ;; Initialize faces from face specs and X resources. The
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2051 ;; condition-case prevents invalid specs from causing frame
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2052 ;; creation to fail.
96074
83c52d8906f5 (face-set-after-frame-default): Don't exclude `default'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 95864
diff changeset
2053 (dolist (face (face-list))
83c52d8906f5 (face-set-after-frame-default): Don't exclude `default'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 95864
diff changeset
2054 ;; This loop used to exclude the `default' face for an unknown reason.
83c52d8906f5 (face-set-after-frame-default): Don't exclude `default'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 95864
diff changeset
2055 ;; It lead to odd behaviors where face-spec settings on the `default'
83c52d8906f5 (face-set-after-frame-default): Don't exclude `default'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 95864
diff changeset
2056 ;; face weren't obeyed for new frame.
75696
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2057 (condition-case ()
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2058 (progn
87483
bdb419612503 (face-spec-set): Third arg is now FOR-DEFFACE.
Richard M. Stallman <rms@gnu.org>
parents: 87453
diff changeset
2059 (face-spec-recalc face frame)
83556
07774e5c3ff5 Merged from emacs@sv.gnu.org
Karoly Lorentey <karoly@lorentey.hu>
parents: 83554 75884
diff changeset
2060 (if (memq (window-system frame) '(x w32 mac))
76447
6da62180836c (face-set-after-frame-default): Recalculate face customizations after
Chong Yidong <cyd@stupidchicken.com>
parents: 76292
diff changeset
2061 (make-face-x-resource-internal face frame))
76731
e3710dba6329 (face-set-after-frame-default): Revert 2007-03-10 change. Merge in X
Chong Yidong <cyd@stupidchicken.com>
parents: 76585
diff changeset
2062 (internal-merge-in-global-face face frame))
75696
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2063 (error nil)))
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2064 ;; Apply the attributes specified by frame parameters. This
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2065 ;; rewrites parameters changed by make-face-x-resource-internal
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2066 (dolist (param apply-params)
97897143b20e (face-set-after-frame-default): Compile attributes to be set by frame
Chong Yidong <cyd@stupidchicken.com>
parents: 75591
diff changeset
2067 (apply 'set-face-attribute param))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2068
33008
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2069 (defun tty-handle-reverse-video (frame parameters)
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2070 "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
2071 (when (cdr (or (assq 'reverse parameters)
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2072 (assq 'reverse default-frame-alist)))
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2073 (let* ((params (frame-parameters frame))
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2074 (bg (cdr (assq 'foreground-color params)))
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2075 (fg (cdr (assq 'background-color params))))
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2076 (modify-frame-parameters frame
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2077 (list (cons 'foreground-color fg)
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2078 (cons 'background-color bg)))
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2079 (if (equal bg (cdr (assq 'mouse-color params)))
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2080 (modify-frame-parameters frame
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2081 (list (cons 'mouse-color fg))))
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2082 (if (equal bg (cdr (assq 'cursor-color params)))
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2083 (modify-frame-parameters frame
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2084 (list (cons 'cursor-color fg)))))))
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2085
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2086
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2087 (defun tty-create-frame-with-faces (&optional parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2088 "Create a frame from optional frame parameters PARAMETERS.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2089 Parameters not specified by PARAMETERS are taken from
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2090 `default-frame-alist'. If either PARAMETERS or `default-frame-alist'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2091 contains a `reverse' parameter, handle that. Value is the new frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2092 created."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2093 (let ((frame (make-terminal-frame parameters))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2094 success)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2095 (unwind-protect
83129
b1ded6fb31d1 Use with-selected-frame.
Karoly Lorentey <lorentey@elte.hu>
parents: 83123
diff changeset
2096 (with-selected-frame frame
33008
c30c394884b8 (tty-handle-reverse-video): New function.
Eli Zaretskii <eliz@gnu.org>
parents: 32940
diff changeset
2097 (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
2098
85415
b1e285a2d293 (tty-create-frame-with-faces): Make sure not only
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 85311
diff changeset
2099 (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
2100 (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
2101 (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
2102 (tty-run-terminal-initialization frame))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2103 (frame-set-background-mode frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2104 (face-set-after-frame-default frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2105 (setq success t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2106 (unless success
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2107 (delete-frame frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2108 frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2109
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
2110 (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
2111 "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
2112 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
2113
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 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
2115 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
2116 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
2117 (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
2118 (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
2119 (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
2120 ;; 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
2121 (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
2122 (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
2123 (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
2124 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
2125 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
2126
83524
673d62ad74b5 Fix and/or simplify terminal initialization files.
Karoly Lorentey <lorentey@elte.hu>
parents: 83523
diff changeset
2127 (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
2128 "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
2129 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
2130 terminal type to a different value."
673d62ad74b5 Fix and/or simplify terminal initialization files.
Karoly Lorentey <lorentey@elte.hu>
parents: 83523
diff changeset
2131 (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
2132 ;; Load library for our terminal type.
8f0c7632f259 Slightly refactor the terminal initialization code for simplicity.
Karoly Lorentey <lorentey@elte.hu>
parents: 83358
diff changeset
2133 ;; 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
2134 (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
2135 (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
2136 (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
2137 ;; 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
2138 ;; 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
2139 (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
2140 (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
2141 (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
2142 (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
2143 (load file t t)))))
83524
673d62ad74b5 Fix and/or simplify terminal initialization files.
Karoly Lorentey <lorentey@elte.hu>
parents: 83523
diff changeset
2144 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
2145 ;; 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
2146 (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
2147 (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
2148 (intern (concat "terminal-init-" type)))))
83524
673d62ad74b5 Fix and/or simplify terminal initialization files.
Karoly Lorentey <lorentey@elte.hu>
parents: 83523
diff changeset
2149 type)
83380
94f174e5569d Merged from miles@gnu.org--gnu-2005 (patch 543)
Karoly Lorentey <lorentey@elte.hu>
parents: 83359
diff changeset
2150 (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
2151 (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
2152 (set-terminal-parameter frame 'terminal-initted term-init-func)))))
25012
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 ;; Called from C function init_display to initialize faces of the
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2155 ;; dumped terminal frame on startup.
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 (defun tty-set-up-initial-frame-faces ()
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2158 (let ((frame (selected-frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2159 (frame-set-background-mode frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2160 (face-set-after-frame-default frame)))
37943
e4f0e3e1c22e minor optimization
Sam Steingold <sds@gnu.org>
parents: 37476
diff changeset
2161
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2162
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2163
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2164
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2165 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2166 ;;; Compatiblity with 20.2
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2167 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2168
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2169 ;; Update a frame's faces when we change its default font.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2170
55883
cde9d1fff89c (frame-update-faces): Add empty docstring so the one for `ignore' doesn't
Juanma Barranquero <lekktu@gmail.com>
parents: 55545
diff changeset
2171 (defalias 'frame-update-faces 'ignore "")
46053
ef0684c3e07b (frame-update-faces): Fix obsolescence declaration.
Juanma Barranquero <lekktu@gmail.com>
parents: 46041
diff changeset
2172 (make-obsolete 'frame-update-faces "no longer necessary." "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2173
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2174 ;; Update the colors of FACE, after FRAME's own colors have been
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2175 ;; changed.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2176
64539
c94d5f576885 (describe-face): "?\ " -> "?\s".
Juanma Barranquero <lekktu@gmail.com>
parents: 64497
diff changeset
2177 (define-obsolete-function-alias 'frame-update-face-colors
c94d5f576885 (describe-face): "?\ " -> "?\s".
Juanma Barranquero <lekktu@gmail.com>
parents: 64497
diff changeset
2178 'frame-set-background-mode "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2179
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2180
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2181 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2182 ;;; Standard faces.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2183 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2184
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2185 (defgroup basic-faces nil
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2186 "The standard faces of Emacs."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2187 :group 'faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2188
93694
a60642ce1ede (default): Ensure the face-defface-spec property is set.
Chong Yidong <cyd@stupidchicken.com>
parents: 92948
diff changeset
2189 (defface default
a60642ce1ede (default): Ensure the face-defface-spec property is set.
Chong Yidong <cyd@stupidchicken.com>
parents: 92948
diff changeset
2190 '((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
2191 "Basic default face."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2192 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2193
65730
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2194 (defface bold
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2195 '((t :weight bold))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2196 "Basic bold 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 italic
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2200 '((((supports :slant italic))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2201 :slant italic)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2202 (((supports :underline t))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2203 :underline t)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2204 (t
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2205 ;; 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
2206 ;; 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
2207 ;; 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
2208 :slant italic))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2209 "Basic italic face."
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2210 :group 'basic-faces)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2211
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2212 (defface bold-italic
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2213 '((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
2214 "Basic bold-italic face."
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2215 :group 'basic-faces)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2216
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2217 (defface underline
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2218 '((((supports :underline t))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2219 :underline t)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2220 (((supports :weight bold))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2221 :weight bold)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2222 (t :underline t))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2223 "Basic underlined face."
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2224 :group 'basic-faces)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2225
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2226 (defface fixed-pitch
96169
abc9f7184a8c (fixed-pitch): Use "Monospace" family.
Chong Yidong <cyd@stupidchicken.com>
parents: 96079
diff changeset
2227 '((t :family "Monospace"))
65730
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2228 "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
2229 :group 'basic-faces)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2230
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2231 (defface variable-pitch
96247
002173686f70 (face-font-family-alternatives, variable-pitch): Use
Andreas Schwab <schwab@suse.de>
parents: 96241
diff changeset
2232 '((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
2233 "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
2234 :group 'basic-faces)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2235
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2236 (defface shadow
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2237 '((((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
2238 :foreground "grey50")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2239 (((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
2240 :foreground "grey70")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2241 (((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
2242 :foreground "green")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2243 (((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
2244 :foreground "yellow"))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2245 "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
2246 :group 'basic-faces
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2247 :version "22.1")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2248
68341
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2249 (defface link
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2250 '((((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
2251 :foreground "blue1" :underline t)
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2252 (((class color) (background light))
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2253 :foreground "blue" :underline t)
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2254 (((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
2255 :foreground "cyan1" :underline t)
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2256 (((class color) (background dark))
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2257 :foreground "cyan" :underline t)
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2258 (t :inherit underline))
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2259 "Basic face for unvisited links."
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2260 :group 'basic-faces
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2261 :version "22.1")
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2262
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2263 (defface link-visited
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2264 '((default :inherit link)
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2265 (((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
2266 (((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
2267 "Basic face for visited links."
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2268 :group 'basic-faces
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2269 :version "22.1")
acccd9689759 (link, link-visited): New faces based on default values
Juri Linkov <juri@jurta.org>
parents: 68214
diff changeset
2270
65730
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2271 (defface highlight
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2272 '((((class color) (min-colors 88) (background light))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2273 :background "darkseagreen2")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2274 (((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
2275 :background "darkolivegreen")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2276 (((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
2277 :background "darkseagreen2")
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 16) (background dark))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2279 :background "darkolivegreen")
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 8))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2281 :background "green" :foreground "black")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2282 (t :inverse-video t))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2283 "Basic face for highlighting."
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2284 :group 'basic-faces)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2285
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2286 (defface region
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2287 '((((class color) (min-colors 88) (background dark))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2288 :background "blue3")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2289 (((class color) (min-colors 88) (background light))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2290 :background "lightgoldenrod2")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2291 (((class color) (min-colors 16) (background dark))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2292 :background "blue3")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2293 (((class color) (min-colors 16) (background light))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2294 :background "lightgoldenrod2")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2295 (((class color) (min-colors 8))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2296 :background "blue" :foreground "white")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2297 (((type tty) (class mono))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2298 :inverse-video t)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2299 (t :background "gray"))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2300 "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
2301 :version "21.1"
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2302 :group 'basic-faces)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2303
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2304 (defface secondary-selection
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2305 '((((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
2306 :background "yellow1")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2307 (((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
2308 :background "SkyBlue4")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2309 (((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
2310 :background "yellow")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2311 (((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
2312 :background "SkyBlue4")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2313 (((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
2314 :background "cyan" :foreground "black")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2315 (t :inverse-video t))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2316 "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
2317 :group 'basic-faces)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2318
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2319 (defface trailing-whitespace
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2320 '((((class color) (background light))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2321 :background "red1")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2322 (((class color) (background dark))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2323 :background "red1")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2324 (t :inverse-video t))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2325 "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
2326 :version "21.1"
67503
71e68cea180c (frame-background-mode): Replace `choice-item' keywords
Juri Linkov <juri@jurta.org>
parents: 67049
diff changeset
2327 :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
2328 :group 'basic-faces)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2329
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2330 (defface escape-glyph
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2331 '((((background dark)) :foreground "cyan")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2332 ;; 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
2333 ;; 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
2334 (((type pc)) :foreground "magenta")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2335 ;; 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
2336 ;; 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
2337 (t :foreground "brown"))
72280
67323a6ea60e (escape-glyph): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 71591
diff changeset
2338 "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
2339 :group 'basic-faces
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2340 :version "22.1")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2341
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2342 (defface nobreak-space
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2343 '((((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
2344 (((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
2345 (t :inverse-video t))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2346 "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
2347 :group 'basic-faces
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2348 :version "22.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2349
68214
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2350 (defgroup mode-line-faces nil
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2351 "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
2352 :group 'mode-line
68214
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2353 :group 'faces
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2354 :version "22.1")
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2355
25650
8b06b47a1fea (mode-line): Replaces `modeline'.
Gerd Moellmann <gerd@gnu.org>
parents: 25616
diff changeset
2356 (defface mode-line
59077
294a7f7e3daf (mode-line, mode-line-inactive): Use min-colors.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 59054
diff changeset
2357 '((((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
2358 :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
2359 :background "grey75" :foreground "black")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2360 (t
43711
d15360503e4e (face-spec-choose): Allow `t' to appear before the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43550
diff changeset
2361 :inverse-video t))
43204
1b0f33edf842 (mode-line-inactive): New face for mode-line for
Kim F. Storm <storm@cua.dk>
parents: 42969
diff changeset
2362 "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
2363 :version "21.1"
68214
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2364 :group 'mode-line-faces
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2365 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2366
43204
1b0f33edf842 (mode-line-inactive): New face for mode-line for
Kim F. Storm <storm@cua.dk>
parents: 42969
diff changeset
2367 (defface mode-line-inactive
58935
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
2368 '((default
43711
d15360503e4e (face-spec-choose): Allow `t' to appear before the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43550
diff changeset
2369 :inherit mode-line)
59077
294a7f7e3daf (mode-line, mode-line-inactive): Use min-colors.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 59054
diff changeset
2370 (((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
2371 :weight light
1b0f33edf842 (mode-line-inactive): New face for mode-line for
Kim F. Storm <storm@cua.dk>
parents: 42969
diff changeset
2372 :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
2373 :foreground "grey20" :background "grey90")
59077
294a7f7e3daf (mode-line, mode-line-inactive): Use min-colors.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 59054
diff changeset
2374 (((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
2375 :weight light
4c5a2e2ddf43 (mode-line-inactive): Add dark-background variant.
Miles Bader <miles@gnu.org>
parents: 43204
diff changeset
2376 :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
2377 :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
2378 "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
2379 :version "22.1"
68214
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2380 :group 'mode-line-faces
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2381 :group 'basic-faces)
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2382
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2383 (defface mode-line-highlight
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2384 '((((class color) (min-colors 88))
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2385 :box (:line-width 2 :color "grey40" :style released-button))
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2386 (t
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2387 :inherit highlight))
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2388 "Basic mode line face for highlighting."
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2389 :version "22.1"
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2390 :group 'mode-line-faces
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2391 :group 'basic-faces)
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2392
92717
fec088bf4a02 (mode-line-emphasis): New face.
Glenn Morris <rgm@gnu.org>
parents: 92446
diff changeset
2393 (defface mode-line-emphasis
fec088bf4a02 (mode-line-emphasis): New face.
Glenn Morris <rgm@gnu.org>
parents: 92446
diff changeset
2394 '((t (:weight bold)))
fec088bf4a02 (mode-line-emphasis): New face.
Glenn Morris <rgm@gnu.org>
parents: 92446
diff changeset
2395 "Face used to emphasize certain mode line features.
fec088bf4a02 (mode-line-emphasis): New face.
Glenn Morris <rgm@gnu.org>
parents: 92446
diff changeset
2396 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
2397 :version "23.1"
fec088bf4a02 (mode-line-emphasis): New face.
Glenn Morris <rgm@gnu.org>
parents: 92446
diff changeset
2398 :group 'mode-line-faces
fec088bf4a02 (mode-line-emphasis): New face.
Glenn Morris <rgm@gnu.org>
parents: 92446
diff changeset
2399 :group 'basic-faces)
fec088bf4a02 (mode-line-emphasis): New face.
Glenn Morris <rgm@gnu.org>
parents: 92446
diff changeset
2400
68214
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2401 (defface mode-line-buffer-id
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2402 '((t (:weight bold)))
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2403 "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
2404 :version "22.1"
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2405 :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
2406 :group 'basic-faces)
1b0f33edf842 (mode-line-inactive): New face for mode-line for
Kim F. Storm <storm@cua.dk>
parents: 42969
diff changeset
2407
25650
8b06b47a1fea (mode-line): Replaces `modeline'.
Gerd Moellmann <gerd@gnu.org>
parents: 25616
diff changeset
2408 ;; Make `modeline' an alias for `mode-line', for compatibility.
8b06b47a1fea (mode-line): Replaces `modeline'.
Gerd Moellmann <gerd@gnu.org>
parents: 25616
diff changeset
2409 (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
2410 (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
2411 (put 'modeline-highlight 'face-alias 'mode-line-highlight)
68214
7943b5aaa49d (mode-line-faces): New defgroup.
Juri Linkov <juri@jurta.org>
parents: 67503
diff changeset
2412 (put 'modeline-buffer-id 'face-alias 'mode-line-buffer-id)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2413
25545
b0a117037bde (header-line): Renamed from `top-line'.
Gerd Moellmann <gerd@gnu.org>
parents: 25542
diff changeset
2414 (defface header-line
58935
95bb6b9a27a3 (header-line, mode-line-inactive, tool-bar):
Richard M. Stallman <rms@gnu.org>
parents: 58851
diff changeset
2415 '((default
54574
76b831799f4d (read-face-font): Don't cons up unnecessarily.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54161
diff changeset
2416 :inherit mode-line)
76b831799f4d (read-face-font): Don't cons up unnecessarily.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54161
diff changeset
2417 (((type tty))
32404
d355f52b4497 (header-line): Change tty-variant to use underlining.
Miles Bader <miles@gnu.org>
parents: 32378
diff changeset
2418 ;; 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
2419 ;; 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
2420 ;; 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
2421 ;; 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
2422 ;; 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
2423 ;; 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
2424 ;; 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
2425 ;; 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
2426 ;; the info browser. XXX
54574
76b831799f4d (read-face-font): Don't cons up unnecessarily.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54161
diff changeset
2427 :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
2428 :underline t)
32756
ccfb1ed059ca (header-line): Make more reasonable on mono/grayscale displays.
Miles Bader <miles@gnu.org>
parents: 32752
diff changeset
2429 (((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
2430 :background "grey90" :foreground "grey20"
54574
76b831799f4d (read-face-font): Don't cons up unnecessarily.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54161
diff changeset
2431 :box nil)
32756
ccfb1ed059ca (header-line): Make more reasonable on mono/grayscale displays.
Miles Bader <miles@gnu.org>
parents: 32752
diff changeset
2432 (((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
2433 :background "grey20" :foreground "grey90"
54574
76b831799f4d (read-face-font): Don't cons up unnecessarily.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54161
diff changeset
2434 :box nil)
32756
ccfb1ed059ca (header-line): Make more reasonable on mono/grayscale displays.
Miles Bader <miles@gnu.org>
parents: 32752
diff changeset
2435 (((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
2436 :background "white" :foreground "black"
900ca3da6e01 (header-line): Use `:box nil' for color/gs displays too.
Miles Bader <miles@gnu.org>
parents: 33447
diff changeset
2437 :inverse-video nil
900ca3da6e01 (header-line): Use `:box nil' for color/gs displays too.
Miles Bader <miles@gnu.org>
parents: 33447
diff changeset
2438 :box nil
54574
76b831799f4d (read-face-font): Don't cons up unnecessarily.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54161
diff changeset
2439 :underline t)
32756
ccfb1ed059ca (header-line): Make more reasonable on mono/grayscale displays.
Miles Bader <miles@gnu.org>
parents: 32752
diff changeset
2440 (((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
2441 :background "black" :foreground "white"
900ca3da6e01 (header-line): Use `:box nil' for color/gs displays too.
Miles Bader <miles@gnu.org>
parents: 33447
diff changeset
2442 :inverse-video nil
900ca3da6e01 (header-line): Use `:box nil' for color/gs displays too.
Miles Bader <miles@gnu.org>
parents: 33447
diff changeset
2443 :box nil
54574
76b831799f4d (read-face-font): Don't cons up unnecessarily.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54161
diff changeset
2444 :underline t))
25545
b0a117037bde (header-line): Renamed from `top-line'.
Gerd Moellmann <gerd@gnu.org>
parents: 25542
diff changeset
2445 "Basic header-line face."
25687
afad62240679 (mode-line, header-line, tool-bar, ): Add :version.
Dave Love <fx@gnu.org>
parents: 25650
diff changeset
2446 :version "21.1"
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2447 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2448
75166
d9e4f75aee3d (momentary): Change :group to basic-faces where all
Juri Linkov <juri@jurta.org>
parents: 75109
diff changeset
2449 (defface vertical-border
d9e4f75aee3d (momentary): Change :group to basic-faces where all
Juri Linkov <juri@jurta.org>
parents: 75109
diff changeset
2450 '((((type tty)) :inherit mode-line-inactive))
d9e4f75aee3d (momentary): Change :group to basic-faces where all
Juri Linkov <juri@jurta.org>
parents: 75109
diff changeset
2451 "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
2452 :version "22.1"
d9e4f75aee3d (momentary): Change :group to basic-faces where all
Juri Linkov <juri@jurta.org>
parents: 75109
diff changeset
2453 :group 'basic-faces)
d9e4f75aee3d (momentary): Change :group to basic-faces where all
Juri Linkov <juri@jurta.org>
parents: 75109
diff changeset
2454
65084
87a66a9a9328 (minibuffer-prompt): Doc fix.
Juri Linkov <juri@jurta.org>
parents: 65068
diff changeset
2455 (defface minibuffer-prompt
87a66a9a9328 (minibuffer-prompt): Doc fix.
Juri Linkov <juri@jurta.org>
parents: 65068
diff changeset
2456 '((((background dark)) :foreground "cyan")
87a66a9a9328 (minibuffer-prompt): Doc fix.
Juri Linkov <juri@jurta.org>
parents: 65068
diff changeset
2457 ;; 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
2458 ;; their foreground color to be blue.
87a66a9a9328 (minibuffer-prompt): Doc fix.
Juri Linkov <juri@jurta.org>
parents: 65068
diff changeset
2459 (((type pc)) :foreground "magenta")
76292
81d50597174e (minibuffer-prompt): Use medium blue by default.
Richard M. Stallman <rms@gnu.org>
parents: 75884
diff changeset
2460 (t :foreground "medium blue"))
65084
87a66a9a9328 (minibuffer-prompt): Doc fix.
Juri Linkov <juri@jurta.org>
parents: 65068
diff changeset
2461 "Face for minibuffer prompts.
87a66a9a9328 (minibuffer-prompt): Doc fix.
Juri Linkov <juri@jurta.org>
parents: 65068
diff changeset
2462 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
2463 `minibuffer-prompt-properties', which is a list of text properties
87a66a9a9328 (minibuffer-prompt): Doc fix.
Juri Linkov <juri@jurta.org>
parents: 65068
diff changeset
2464 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
2465 :version "22.1"
42298
d020b569f212 (minibuffer-prompt): New face.
Richard M. Stallman <rms@gnu.org>
parents: 40456
diff changeset
2466 :group 'basic-faces)
d020b569f212 (minibuffer-prompt): New face.
Richard M. Stallman <rms@gnu.org>
parents: 40456
diff changeset
2467
d020b569f212 (minibuffer-prompt): New face.
Richard M. Stallman <rms@gnu.org>
parents: 40456
diff changeset
2468 (setq minibuffer-prompt-properties
d020b569f212 (minibuffer-prompt): New face.
Richard M. Stallman <rms@gnu.org>
parents: 40456
diff changeset
2469 (append minibuffer-prompt-properties (list 'face 'minibuffer-prompt)))
d020b569f212 (minibuffer-prompt): New face.
Richard M. Stallman <rms@gnu.org>
parents: 40456
diff changeset
2470
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2471 (defface fringe
29943
b8314fd10792 (fringe): Change face for different backgrounds.
Gerd Moellmann <gerd@gnu.org>
parents: 29880
diff changeset
2472 '((((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
2473 :background "grey95")
d15360503e4e (face-spec-choose): Allow `t' to appear before the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43550
diff changeset
2474 (((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
2475 :background "grey10")
d15360503e4e (face-spec-choose): Allow `t' to appear before the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43550
diff changeset
2476 (t
d15360503e4e (face-spec-choose): Allow `t' to appear before the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 43550
diff changeset
2477 :background "gray"))
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2478 "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
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 'frames
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2481 :group 'basic-faces)
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2482
70178
667cd756c089 (scroll-bar, border, cursor, mouse): Avoid nil spec in defface.
Luc Teirlinck <teirllm@auburn.edu>
parents: 68651
diff changeset
2483 (defface scroll-bar '((t nil))
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2484 "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
2485 :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
2486 :group 'frames
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2487 :group 'basic-faces)
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2488
70178
667cd756c089 (scroll-bar, border, cursor, mouse): Avoid nil spec in defface.
Luc Teirlinck <teirllm@auburn.edu>
parents: 68651
diff changeset
2489 (defface border '((t nil))
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2490 "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
2491 :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
2492 :group 'frames
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2493 :group 'basic-faces)
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2494
70178
667cd756c089 (scroll-bar, border, cursor, mouse): Avoid nil spec in defface.
Luc Teirlinck <teirllm@auburn.edu>
parents: 68651
diff changeset
2495 (defface cursor '((t nil))
57105
8f14c8ea51a1 (cursor): Add face-no-inherit property. Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 55902
diff changeset
2496 "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
2497 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
2498 :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
2499 :group 'cursor
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2500 :group 'basic-faces)
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2501
57105
8f14c8ea51a1 (cursor): Add face-no-inherit property. Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 55902
diff changeset
2502 (put 'cursor 'face-no-inherit t)
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2503
70178
667cd756c089 (scroll-bar, border, cursor, mouse): Avoid nil spec in defface.
Luc Teirlinck <teirllm@auburn.edu>
parents: 68651
diff changeset
2504 (defface mouse '((t nil))
25588
1d8ba3dd04e9 (face-set-after-frame-default): Initialize some
Gerd Moellmann <gerd@gnu.org>
parents: 25561
diff changeset
2505 "Basic face for the mouse color under X."
25137
1bee9402f747 (bitmap-area): Add :version.
Dave Love <fx@gnu.org>
parents: 25090
diff changeset
2506 :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
2507 :group 'mouse
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2508 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2509
65730
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2510 (defface tool-bar
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2511 '((default
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2512 :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
2513 :foreground "black")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2514 (((type x w32 mac) (class color))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2515 :background "grey75")
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2516 (((type x) (class mono))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2517 :background "grey"))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2518 "Basic tool-bar face."
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2519 :version "21.1"
25687
afad62240679 (mode-line, header-line, tool-bar, ): Add :version.
Dave Love <fx@gnu.org>
parents: 25650
diff changeset
2520 :group 'basic-faces)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2521
65730
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2522 (defface menu
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2523 '((((type tty))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2524 :inverse-video t)
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2525 (((type x-toolkit))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2526 )
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2527 (t
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2528 :inverse-video t))
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2529 "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
2530 :version "21.1"
65730
a9f7501916e6 Rearrange face definitions to be in the same order as
Juri Linkov <juri@jurta.org>
parents: 65289
diff changeset
2531 :group 'menu
25687
afad62240679 (mode-line, header-line, tool-bar, ): Add :version.
Dave Love <fx@gnu.org>
parents: 25650
diff changeset
2532 :group 'basic-faces)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2533
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2534
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2535 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2536 ;;; Manipulating font names.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2537 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2538
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2539 ;; 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
2540 ;; international/fontset.el uses x-resolve-font-name. The following
6d7ba0ba3bc3 Declare more functions obsolete.
Dave Love <fx@gnu.org>
parents: 28849
diff changeset
2541 ;; functions are not used in the face implementation itself.
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2542
16687
049c87a96dca Change defconsts to defvars.
Richard M. Stallman <rms@gnu.org>
parents: 16590
diff changeset
2543 (defvar x-font-regexp nil)
049c87a96dca Change defconsts to defvars.
Richard M. Stallman <rms@gnu.org>
parents: 16590
diff changeset
2544 (defvar x-font-regexp-head nil)
049c87a96dca Change defconsts to defvars.
Richard M. Stallman <rms@gnu.org>
parents: 16590
diff changeset
2545 (defvar x-font-regexp-weight nil)
049c87a96dca Change defconsts to defvars.
Richard M. Stallman <rms@gnu.org>
parents: 16590
diff changeset
2546 (defvar x-font-regexp-slant nil)
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2547
12668
7660e82d0346 (x-font-regexp-weight-subnum, x-font-regexp-slant-subnum)
Karl Heuer <kwzh@gnu.org>
parents: 12651
diff changeset
2548 (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
2549 (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
2550 (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
2551 (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
2552
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2553 ;;; Regexps matching font names in "Host Portable Character Representation."
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2554 ;;;
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2555 (let ((- "[-?]")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2556 (foundry "[^-]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2557 (family "[^-]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2558 (weight "\\(bold\\|demibold\\|medium\\)") ; 1
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2559 ; (weight\? "\\(\\*\\|bold\\|demibold\\|medium\\|\\)") ; 1
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2560 (weight\? "\\([^-]*\\)") ; 1
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2561 (slant "\\([ior]\\)") ; 2
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2562 ; (slant\? "\\([ior?*]?\\)") ; 2
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2563 (slant\? "\\([^-]?\\)") ; 2
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2564 ; (swidth "\\(\\*\\|normal\\|semicondensed\\|\\)") ; 3
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2565 (swidth "\\([^-]*\\)") ; 3
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2566 ; (adstyle "\\(\\*\\|sans\\|\\)") ; 4
12690
e2d3fa52d100 (x-font-regexp): Add \\(\\) for substring extraction.
Karl Heuer <kwzh@gnu.org>
parents: 12668
diff changeset
2567 (adstyle "\\([^-]*\\)") ; 4
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2568 (pixelsize "[0-9]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2569 (pointsize "[0-9][0-9]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2570 (resx "[0-9][0-9]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2571 (resy "[0-9][0-9]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2572 (spacing "[cmp?*]")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2573 (avgwidth "[0-9]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2574 (registry "[^-]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2575 (encoding "[^-]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2576 )
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2577 (setq x-font-regexp
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2578 (concat "\\`\\*?[-?*]"
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2579 foundry - family - weight\? - slant\? - swidth - adstyle -
12475
eb436b0c4ab3 (x-font-regexp): Include the avgwidth.
Richard M. Stallman <rms@gnu.org>
parents: 12460
diff changeset
2580 pixelsize - pointsize - resx - resy - spacing - avgwidth -
eb436b0c4ab3 (x-font-regexp): Include the avgwidth.
Richard M. Stallman <rms@gnu.org>
parents: 12460
diff changeset
2581 registry - encoding "\\*?\\'"
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2582 ))
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2583 (setq x-font-regexp-head
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2584 (concat "\\`[-?*]" foundry - family - weight\? - slant\?
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2585 "\\([-*?]\\|\\'\\)"))
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2586 (setq x-font-regexp-slant (concat - slant -))
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2587 (setq x-font-regexp-weight (concat - weight -))
28840
d0531e35d9f2 Some doc fixes.
Dave Love <fx@gnu.org>
parents: 28214
diff changeset
2588 nil)
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2589
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2590
3071
68de05fb5751 * faces.el (set-face-font): Call x-resolve-font-name on the font
Jim Blandy <jimb@redhat.com>
parents: 3049
diff changeset
2591 (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
2592 "Return a font name matching PATTERN.
28849
76e727bc0dfd Fix make-obsolete for internal-get-face.
Dave Love <fx@gnu.org>
parents: 28840
diff changeset
2593 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
2594 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
2595 contains wildcards.
10170
5fc240a3e4a0 (face-initialize): Test for framep not t or nil.
Richard M. Stallman <rms@gnu.org>
parents: 10107
diff changeset
2596 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
2597 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
2598 (or (symbolp face)
28b2df35c33e (x-resolve-font-name): Allow symbol as FACE arg.
Richard M. Stallman <rms@gnu.org>
parents: 3182
diff changeset
2599 (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
2600 (and (eq frame t)
28b2df35c33e (x-resolve-font-name): Allow symbol as FACE arg.
Richard M. Stallman <rms@gnu.org>
parents: 3182
diff changeset
2601 (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
2602 (if pattern
5092
36508a7c0a3f (x-resolve-font-name): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 5081
diff changeset
2603 ;; 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
2604 (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
2605 (or fonts
82c29bacb6b3 * faces.el (x-resolve-font-name): If PATTERN is nil, return the
Jim Blandy <jimb@redhat.com>
parents: 3071
diff changeset
2606 (if face
10584
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
2607 (if (string-match "\\*" pattern)
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
2608 (if (null (face-font face))
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
2609 (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
2610 (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
2611 (if (null (face-font face))
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
2612 (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
2613 pattern)
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
2614 (error "Height of font `%s' doesn't match face `%s'"
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
2615 pattern face)))
3353
8cbd38886eef (x-resolve-font-name): Clean up error messages.
Richard M. Stallman <rms@gnu.org>
parents: 3298
diff changeset
2616 (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
2617 (car fonts))
82c29bacb6b3 * faces.el (x-resolve-font-name): If PATTERN is nil, return the
Jim Blandy <jimb@redhat.com>
parents: 3071
diff changeset
2618 (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
2619
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2620
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2621 (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
2622 (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
2623 (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
2624 (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
2625 (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
2626 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
2627 (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
2628 (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
2629 ;; 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
2630 ;; 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
2631 ;; 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
2632 "*"
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 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
2634 ((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
2635 (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
2636 (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
2637 ((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
2638 (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
2639 (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
2640 (make-obsolete 'x-frob-font-weight 'make-face-... "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2641
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2642 (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
2643 (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
2644 (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
2645 (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
2646 (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
2647 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
2648 (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
2649 (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
2650 ;; 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
2651 ;; 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
2652 ;; 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
2653 "*"
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
2654 (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
2655 ((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
2656 (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
2657 (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
2658 ((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
2659 (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
2660 (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
2661 (make-obsolete 'x-frob-font-slant 'make-face-... "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2662
40351
a44d4a7dd8de (internal-get-face): Use facep instead of the obsolete
Eli Zaretskii <eliz@gnu.org>
parents: 39830
diff changeset
2663 ;; 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
2664 ;; functions from the byte compiler.
a44d4a7dd8de (internal-get-face): Use facep instead of the obsolete
Eli Zaretskii <eliz@gnu.org>
parents: 39830
diff changeset
2665 (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
2666 (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
2667
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2668 (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
2669 "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
2670 If that can't be done, return nil."
40351
a44d4a7dd8de (internal-get-face): Use facep instead of the obsolete
Eli Zaretskii <eliz@gnu.org>
parents: 39830
diff changeset
2671 (internal-frob-font-weight font "bold"))
29354
4ed4a700358b Update calls to make-obsolete with a WHEN argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28907
diff changeset
2672 (make-obsolete 'x-make-font-bold 'make-face-bold "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2673
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2674 (defun x-make-font-demibold (font)
4439
e7ab04f23df5 Make boldness and italicness affect subsequently created frames.
Richard M. Stallman <rms@gnu.org>
parents: 4122
diff changeset
2675 "Given an X font specification, make a demibold version of it.
e7ab04f23df5 Make boldness and italicness affect subsequently created frames.
Richard M. Stallman <rms@gnu.org>
parents: 4122
diff changeset
2676 If that can't be done, return nil."
40351
a44d4a7dd8de (internal-get-face): Use facep instead of the obsolete
Eli Zaretskii <eliz@gnu.org>
parents: 39830
diff changeset
2677 (internal-frob-font-weight font "demibold"))
29354
4ed4a700358b Update calls to make-obsolete with a WHEN argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28907
diff changeset
2678 (make-obsolete 'x-make-font-demibold 'make-face-bold "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2679
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2680 (defun x-make-font-unbold (font)
4439
e7ab04f23df5 Make boldness and italicness affect subsequently created frames.
Richard M. Stallman <rms@gnu.org>
parents: 4122
diff changeset
2681 "Given an X font specification, make a non-bold version of it.
e7ab04f23df5 Make boldness and italicness affect subsequently created frames.
Richard M. Stallman <rms@gnu.org>
parents: 4122
diff changeset
2682 If that can't be done, return nil."
40351
a44d4a7dd8de (internal-get-face): Use facep instead of the obsolete
Eli Zaretskii <eliz@gnu.org>
parents: 39830
diff changeset
2683 (internal-frob-font-weight font "medium"))
29354
4ed4a700358b Update calls to make-obsolete with a WHEN argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28907
diff changeset
2684 (make-obsolete 'x-make-font-unbold 'make-face-unbold "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2685
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2686 (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
2687 "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
2688 If that can't be done, return nil."
40351
a44d4a7dd8de (internal-get-face): Use facep instead of the obsolete
Eli Zaretskii <eliz@gnu.org>
parents: 39830
diff changeset
2689 (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
2690 (make-obsolete 'x-make-font-italic 'make-face-italic "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2691
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2692 (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
2693 "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
2694 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
2695 (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
2696 (make-obsolete 'x-make-font-oblique 'make-face-italic "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2697
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2698 (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
2699 "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
2700 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
2701 (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
2702 (make-obsolete 'x-make-font-unitalic 'make-face-unitalic "21.1")
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
2703
17752
2687f3d7c191 (x-make-font-bold-italic): New function.
Kenichi Handa <handa@m17n.org>
parents: 17560
diff changeset
2704 (defun x-make-font-bold-italic (font)
2687f3d7c191 (x-make-font-bold-italic): New function.
Kenichi Handa <handa@m17n.org>
parents: 17560
diff changeset
2705 "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
2706 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
2707 (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
2708 (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
2709 (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
2710
2715
9caee9338229 * faces.el: Call internal-set-face-1, not internat-set-face-1.
Jim Blandy <jimb@redhat.com>
parents: 2714
diff changeset
2711 (provide 'faces)
9caee9338229 * faces.el: Call internal-set-face-1, not internat-set-face-1.
Jim Blandy <jimb@redhat.com>
parents: 2714
diff changeset
2712
63382
9cbfa983c1cf (read-face-name): Use complete-in-turn complete non-aliases
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 63311
diff changeset
2713 ;; arch-tag: 19a4759f-2963-445f-b004-425b9aadd7d6
28840
d0531e35d9f2 Some doc fixes.
Dave Love <fx@gnu.org>
parents: 28214
diff changeset
2714 ;;; faces.el ends here