Mercurial > emacs
annotate lisp/cus-face.el @ 34097:0225d8e15f2c
(coordinates_in_window): Handle computations for
positions on the vertical bar and fringes differently for
window-system frames. Consider some pixels near the vertical bar
as on the bar if the frame doesn't have vertical scroll bars.
Associate positions between mode or header lines with the
right window, the left one.
author | Gerd Moellmann <gerd@gnu.org> |
---|---|
date | Fri, 01 Dec 2000 20:44:31 +0000 |
parents | 70ea62504011 |
children | b174db545cfd |
rev | line source |
---|---|
17524
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
1 ;;; cus-face.el -- customization support for faces. |
17334 | 2 ;; |
33844
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
3 ;; Copyright (C) 1996, 1997, 1999, 2000 Free Software Foundation, Inc. |
17334 | 4 ;; |
5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> | |
6 ;; Keywords: help, faces | |
17568
65f85125b4f2
Changed version number.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17567
diff
changeset
|
7 ;; Version: Emacs |
17334 | 8 |
17524
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
9 ;; This file is part of GNU Emacs. |
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
10 |
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
11 ;; GNU Emacs is free software; you can redistribute it and/or modify |
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
12 ;; it under the terms of the GNU General Public License as published by |
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
13 ;; the Free Software Foundation; either version 2, or (at your option) |
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
14 ;; any later version. |
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
15 |
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
16 ;; GNU Emacs is distributed in the hope that it will be useful, |
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
19 ;; GNU General Public License for more details. |
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
20 |
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
21 ;; You should have received a copy of the GNU General Public License |
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
24 ;; Boston, MA 02111-1307, USA. |
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
25 |
17334 | 26 ;;; Commentary: |
27 ;; | |
28 ;; See `custom.el'. | |
29 | |
30 ;;; Code: | |
31 | |
24984 | 32 (defalias 'custom-facep 'facep) |
17856
1e5f1a1f0db3
(custom-facep): Defined (once again).
Richard M. Stallman <rms@gnu.org>
parents:
17568
diff
changeset
|
33 |
17334 | 34 ;;; Declaring a face. |
35 | |
36 ;;;###autoload | |
37 (defun custom-declare-face (face spec doc &rest args) | |
38 "Like `defface', but FACE is evaluated as a normal argument." | |
17524
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
39 (unless (get face 'face-defface-spec) |
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
40 (put face 'face-defface-spec spec) |
17334 | 41 (when (fboundp 'facep) |
17524
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
42 (unless (facep face) |
17334 | 43 ;; If the user has already created the face, respect that. |
44 (let ((value (or (get face 'saved-face) spec)) | |
17524
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
45 (frames (frame-list)) |
17334 | 46 frame) |
47 ;; Create global face. | |
48 (make-empty-face face) | |
49 ;; Create frame local faces | |
50 (while frames | |
51 (setq frame (car frames) | |
52 frames (cdr frames)) | |
19257
e487ed925a50
(custom-declare-face): Call make-face-x-resource-internal.
Richard M. Stallman <rms@gnu.org>
parents:
18935
diff
changeset
|
53 (face-spec-set face value frame))) |
e487ed925a50
(custom-declare-face): Call make-face-x-resource-internal.
Richard M. Stallman <rms@gnu.org>
parents:
18935
diff
changeset
|
54 ;; When making a face after frames already exist |
e487ed925a50
(custom-declare-face): Call make-face-x-resource-internal.
Richard M. Stallman <rms@gnu.org>
parents:
18935
diff
changeset
|
55 (if (memq window-system '(x w32)) |
e487ed925a50
(custom-declare-face): Call make-face-x-resource-internal.
Richard M. Stallman <rms@gnu.org>
parents:
18935
diff
changeset
|
56 (make-face-x-resource-internal face)))) |
18935
ab4cd3135797
(custom-declare-face): Use [set-]face-documentation.
Richard M. Stallman <rms@gnu.org>
parents:
18599
diff
changeset
|
57 (when (and doc (null (face-documentation face))) |
26583
3251a6750150
(custom-declare-face): Purecopy DOC.
Dave Love <fx@gnu.org>
parents:
25684
diff
changeset
|
58 (set-face-documentation face (purecopy doc))) |
17334 | 59 (custom-handle-all-keywords face args 'custom-face) |
60 (run-hooks 'custom-define-hook)) | |
61 face) | |
62 | |
24984 | 63 ;;; Face attributes. |
64 | |
65 ;; Below, nil is used in widget specifications for `unspecified' face | |
66 ;; attributes and `off' is used instead of nil attribute values. The | |
67 ;; reason for this is that nil corresponds to the result you get when | |
68 ;; looking up an attribute in a defface spec that isn't contained in | |
69 ;; the spec. | |
17334 | 70 |
71 (defconst custom-face-attributes | |
24984 | 72 '((:family |
73 (choice :tag "Font family" | |
74 :help-echo "Font family or fontset alias name." | |
75 (const :tag "*" nil) | |
33844
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
76 (string :tag "Family"))) |
24984 | 77 |
78 (:width | |
79 (choice :tag "Width" | |
80 :help-echo "Font width." | |
81 (const :tag "*" nil) | |
82 (const :tag "compressed" condensed) | |
83 (const :tag "condensed" condensed) | |
84 (const :tag "demiexpanded" semi-expanded) | |
85 (const :tag "expanded" expanded) | |
86 (const :tag "extracondensed" extra-condensed) | |
87 (const :tag "extraexpanded" extra-expanded) | |
88 (const :tag "medium" normal) | |
89 (const :tag "narrow" condensed) | |
90 (const :tag "normal" normal) | |
91 (const :tag "regular" normal) | |
92 (const :tag "semicondensed" semi-condensed) | |
93 (const :tag "semiexpanded" semi-expanded) | |
94 (const :tag "ultracondensed" ultra-condensed) | |
95 (const :tag "ultraexpanded" ultra-expanded) | |
33844
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
96 (const :tag "wide" extra-expanded))) |
24984 | 97 |
98 (:height | |
99 (choice :tag "Height" | |
100 :help-echo "Face's font height." | |
101 (const :tag "*" nil) | |
31192 | 102 (integer :tag "Height in 1/10 pt") |
33844
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
103 (number :tag "Scale" 1.0))) |
31192 | 104 |
24984 | 105 (:weight |
106 (choice :tag "Weight" | |
107 :help-echo "Font weight." | |
108 (const :tag "*" nil) | |
109 (const :tag "black" ultra_bold) | |
110 (const :tag "bold" bold) | |
111 (const :tag "book" semi-light) | |
112 (const :tag "demibold" semi-bold) | |
113 (const :tag "extralight" extra-light) | |
114 (const :tag "extrabold" extra-bold) | |
115 (const :tag "heavy" extra-bold) | |
116 (const :tag "light" light) | |
117 (const :tag "medium" normal) | |
118 (const :tag "normal" normal) | |
119 (const :tag "regular" normal) | |
120 (const :tag "semibold" semi-bold) | |
121 (const :tag "semilight" semi-light) | |
122 (const :tag "ultralight" ultra-light) | |
33844
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
123 (const :tag "ultrabold" ultra-bold))) |
24984 | 124 |
125 (:slant | |
126 (choice :tag "Slant" | |
127 :help-echo "Font slant." | |
128 (const :tag "*" nil) | |
129 (const :tag "italic" italic) | |
130 (const :tag "oblique" oblique) | |
33844
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
131 (const :tag "normal" normal))) |
24984 | 132 |
133 (:underline | |
134 (choice :tag "Underline" | |
135 :help-echo "Control text underlining." | |
136 (const :tag "*" nil) | |
137 (const :tag "On" t) | |
138 (const :tag "Off" off) | |
33844
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
139 (color :tag "Colored"))) |
24984 | 140 |
141 (:overline | |
142 (choice :tag "Overline" | |
143 :help-echo "Control text overlining." | |
144 (const :tag "*" nil) | |
145 (const :tag "On" t) | |
146 (const :tag "Off" off) | |
33844
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
147 (color :tag "Colored"))) |
24984 | 148 |
149 (:strike-through | |
150 (choice :tag "Strike-through" | |
151 :help-echo "Control text strike-through." | |
152 (const :tag "*" nil) | |
153 (const :tag "On" t) | |
154 (const :tag "Off" off) | |
33844
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
155 (color :tag "Colored"))) |
24984 | 156 |
157 (:box | |
25684
e3ed0e86532c
(custom-face-attributes): Simplify :underline, :overline,
Dave Love <fx@gnu.org>
parents:
24984
diff
changeset
|
158 ;; Fixme: this can probably be done better. |
24984 | 159 (choice :tag "Box around text" |
160 :help-echo "Control box around text." | |
33844
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
161 (const :tag "*" nil) |
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
162 (const :tag "Off" off) |
24984 | 163 (list :tag "Box" |
33936
e66f3c5840a4
(custom-face-attributes): Add post-filter function for :box.
Miles Bader <miles@gnu.org>
parents:
33874
diff
changeset
|
164 :value (:line-width 2 :color "grey75" :style released-button) |
25684
e3ed0e86532c
(custom-face-attributes): Simplify :underline, :overline,
Dave Love <fx@gnu.org>
parents:
24984
diff
changeset
|
165 (const :format "" :value :line-width) |
24984 | 166 (integer :tag "Width") |
25684
e3ed0e86532c
(custom-face-attributes): Simplify :underline, :overline,
Dave Love <fx@gnu.org>
parents:
24984
diff
changeset
|
167 (const :format "" :value :color) |
e3ed0e86532c
(custom-face-attributes): Simplify :underline, :overline,
Dave Love <fx@gnu.org>
parents:
24984
diff
changeset
|
168 (choice :tag "Color" (const :tag "*" nil) color) |
e3ed0e86532c
(custom-face-attributes): Simplify :underline, :overline,
Dave Love <fx@gnu.org>
parents:
24984
diff
changeset
|
169 (const :format "" :value :style) |
e3ed0e86532c
(custom-face-attributes): Simplify :underline, :overline,
Dave Love <fx@gnu.org>
parents:
24984
diff
changeset
|
170 (choice :tag "Style" |
e3ed0e86532c
(custom-face-attributes): Simplify :underline, :overline,
Dave Love <fx@gnu.org>
parents:
24984
diff
changeset
|
171 (const :tag "Raised" released-button) |
e3ed0e86532c
(custom-face-attributes): Simplify :underline, :overline,
Dave Love <fx@gnu.org>
parents:
24984
diff
changeset
|
172 (const :tag "Sunken" pressed-button) |
e3ed0e86532c
(custom-face-attributes): Simplify :underline, :overline,
Dave Love <fx@gnu.org>
parents:
24984
diff
changeset
|
173 (const :tag "None" nil)))) |
33844
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
174 ;; filter to make value suitable for customize |
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
175 (lambda (real-value) |
33939
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
176 (if (null real-value) |
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
177 'off |
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
178 (let ((lwidth |
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
179 (or (and (consp real-value) (plist-get real-value :line-width)) |
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
180 (and (integerp real-value) real-value) |
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
181 1)) |
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
182 (color |
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
183 (or (and (consp real-value) (plist-get real-value :color)) |
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
184 (and (stringp real-value) real-value) |
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
185 nil)) |
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
186 (style |
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
187 (and (consp real-value) (plist-get real-value :style)))) |
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
188 (list :line-width lwidth :color color :style style)))) |
33936
e66f3c5840a4
(custom-face-attributes): Add post-filter function for :box.
Miles Bader <miles@gnu.org>
parents:
33874
diff
changeset
|
189 ;; filter to make customized-value suitable for storing |
e66f3c5840a4
(custom-face-attributes): Add post-filter function for :box.
Miles Bader <miles@gnu.org>
parents:
33874
diff
changeset
|
190 (lambda (cus-value) |
33939
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
191 (cond ((null cus-value) |
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
192 'unspecified) |
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
193 ((eq cus-value 'off) |
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
194 nil) |
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
195 (t |
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
196 (let ((lwidth (plist-get cus-value :line-width)) |
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
197 (color (plist-get cus-value :color)) |
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
198 (style (plist-get cus-value :style))) |
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
199 (cond ((and (null color) (null style)) |
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
200 lwidth) |
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
201 ((and (null lwidth) (null style)) |
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
202 ;; actually can't happen, because LWIDTH is always an int |
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
203 color) |
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
204 (t |
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
205 ;; Keep as a plist, but remove null entries |
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
206 (nconc (and lwidth `(:line-width ,lwidth)) |
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
207 (and color `(:color ,color)) |
70ea62504011
(custom-face-attributes): Handle mapping `nil' and `unspecified' to
Miles Bader <miles@gnu.org>
parents:
33938
diff
changeset
|
208 (and style `(:style ,style)))))))))) |
24984 | 209 |
210 (:inverse-video | |
211 (choice :tag "Inverse-video" | |
212 :help-echo "Control whether text should be in inverse-video." | |
213 (const :tag "*" nil) | |
214 (const :tag "On" t) | |
33844
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
215 (const :tag "Off" off))) |
24984 | 216 |
217 (:foreground | |
218 (choice :tag "Foreground" | |
219 :help-echo "Set foreground color." | |
220 (const :tag "*" nil) | |
33844
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
221 (color :tag "Color"))) |
24984 | 222 |
223 (:background | |
224 (choice :tag "Background" | |
225 :help-echo "Set background color." | |
226 (const :tag "*" nil) | |
33844
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
227 (color :tag "Color"))) |
24984 | 228 |
229 (:stipple | |
230 (choice :tag "Stipple" | |
33874
2dccf621b517
(custom-face-attributes): Add "None" choice to :stipple.
Miles Bader <miles@gnu.org>
parents:
33844
diff
changeset
|
231 :help-echo "Background bit-mask" |
24984 | 232 (const :tag "*" nil) |
33874
2dccf621b517
(custom-face-attributes): Add "None" choice to :stipple.
Miles Bader <miles@gnu.org>
parents:
33844
diff
changeset
|
233 (const :tag "None" off) |
2dccf621b517
(custom-face-attributes): Add "None" choice to :stipple.
Miles Bader <miles@gnu.org>
parents:
33844
diff
changeset
|
234 (file :tag "File" |
2dccf621b517
(custom-face-attributes): Add "None" choice to :stipple.
Miles Bader <miles@gnu.org>
parents:
33844
diff
changeset
|
235 :help-echo "Name of bitmap file." |
2dccf621b517
(custom-face-attributes): Add "None" choice to :stipple.
Miles Bader <miles@gnu.org>
parents:
33844
diff
changeset
|
236 :must-match t))) |
31192 | 237 |
238 (:inherit | |
239 (repeat :tag "Inherit" | |
240 :help-echo "List of faces to inherit attributes from." | |
241 (face :Tag "Face" default)) | |
33844
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
242 ;; filter to make value suitable for customize |
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
243 (lambda (real-value) |
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
244 (cond ((or (null real-value) (eq real-value 'unspecified)) |
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
245 nil) |
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
246 ((symbolp real-value) |
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
247 (list real-value)) |
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
248 (t |
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
249 real-value))) |
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
250 ;; filter to make customized-value suitable for storing |
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
251 (lambda (cus-value) |
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
252 (if (and (consp cus-value) (null (cdr cus-value))) |
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
253 (car cus-value) |
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
254 cus-value)))) |
24984 | 255 |
256 "Alist of face attributes. | |
257 | |
33844
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
258 The elements are of the form (KEY TYPE PRE-FILTER POST-FILTER), |
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
259 where KEY is the name of the attribute, TYPE is a widget type for |
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
260 editing the attribute, PRE-FILTER is a function to make the attribute's |
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
261 value suitable for the customization widget, and POST-FILTER is a |
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
262 function to make the customized value suitable for storing. PRE-FILTER |
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
263 and POST-FILTER are optional. |
17334 | 264 |
33844
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
265 The PRE-FILTER should take a single argument, the attribute value as |
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
266 stored, and should return a value for customization (using the |
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
267 customization type TYPE). |
17334 | 268 |
33844
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
269 The POST-FILTER should also take a single argument, the value after |
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
270 being customized, and should return a value suitable for setting the |
1ae73b01ef27
(custom-face-attributes): Remove SET and GET functions. Add some
Miles Bader <miles@gnu.org>
parents:
31192
diff
changeset
|
271 given face attribute.") |
17334 | 272 |
24984 | 273 |
17334 | 274 (defun custom-face-attributes-get (face frame) |
17524
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
275 "For FACE on FRAME, return an alternating list describing its attributes. |
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
276 The list has the form (KEYWORD VALUE KEYWORD VALUE...). |
17334 | 277 Each keyword should be listed in `custom-face-attributes'. |
278 | |
17524
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
279 If FRAME is nil, use the global defaults for FACE." |
24984 | 280 (let ((attrs custom-face-attributes) |
281 plist) | |
282 (while attrs | |
283 (let* ((attribute (car (car attrs))) | |
284 (value (face-attribute face attribute frame))) | |
285 (setq attrs (cdr attrs)) | |
31192 | 286 (unless (or (eq value 'unspecified) |
287 (and (null value) (memq attribute '(:inherit)))) | |
24984 | 288 (setq plist (cons attribute (cons value plist)))))) |
289 plist)) | |
17334 | 290 |
291 ;;; Initializing. | |
292 | |
293 ;;;###autoload | |
294 (defun custom-set-faces (&rest args) | |
295 "Initialize faces according to user preferences. | |
296 The arguments should be a list where each entry has the form: | |
297 | |
25684
e3ed0e86532c
(custom-face-attributes): Simplify :underline, :overline,
Dave Love <fx@gnu.org>
parents:
24984
diff
changeset
|
298 (FACE SPEC [NOW [COMMENT]]) |
17334 | 299 |
17524
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
300 SPEC is stored as the saved value for FACE. |
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
301 If NOW is present and non-nil, FACE is created now, according to SPEC. |
25684
e3ed0e86532c
(custom-face-attributes): Simplify :underline, :overline,
Dave Love <fx@gnu.org>
parents:
24984
diff
changeset
|
302 COMMENT is a string comment about FACE. |
17334 | 303 |
304 See `defface' for the format of SPEC." | |
305 (while args | |
306 (let ((entry (car args))) | |
307 (if (listp entry) | |
308 (let ((face (nth 0 entry)) | |
309 (spec (nth 1 entry)) | |
25684
e3ed0e86532c
(custom-face-attributes): Simplify :underline, :overline,
Dave Love <fx@gnu.org>
parents:
24984
diff
changeset
|
310 (now (nth 2 entry)) |
e3ed0e86532c
(custom-face-attributes): Simplify :underline, :overline,
Dave Love <fx@gnu.org>
parents:
24984
diff
changeset
|
311 (comment (nth 3 entry))) |
17334 | 312 (put face 'saved-face spec) |
25684
e3ed0e86532c
(custom-face-attributes): Simplify :underline, :overline,
Dave Love <fx@gnu.org>
parents:
24984
diff
changeset
|
313 (put face 'saved-face-comment comment) |
17334 | 314 (when now |
315 (put face 'force-face t)) | |
17524
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
316 (when (or now (facep face)) |
25684
e3ed0e86532c
(custom-face-attributes): Simplify :underline, :overline,
Dave Love <fx@gnu.org>
parents:
24984
diff
changeset
|
317 (put face 'face-comment comment) |
17524
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
318 (make-empty-face face) |
8ba505704d9d
Major simplification; most of file contents deleted.
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
319 (face-spec-set face spec)) |
17334 | 320 (setq args (cdr args))) |
321 ;; Old format, a plist of FACE SPEC pairs. | |
322 (let ((face (nth 0 args)) | |
323 (spec (nth 1 args))) | |
324 (put face 'saved-face spec)) | |
325 (setq args (cdr (cdr args))))))) | |
326 | |
327 ;;; The End. | |
328 | |
329 (provide 'cus-face) | |
330 | |
25684
e3ed0e86532c
(custom-face-attributes): Simplify :underline, :overline,
Dave Love <fx@gnu.org>
parents:
24984
diff
changeset
|
331 ;;; cus-face.el ends here |