aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiles Bader2000-11-24 09:12:12 +0000
committerMiles Bader2000-11-24 09:12:12 +0000
commit51a1edab455583e9aa943e69a96092bd934a7950 (patch)
tree2cfd706d451f549407d9e253d2ea9132ed3c6883
parentf5b50baad33a98aba08e7889451b2749994e159b (diff)
downloademacs-51a1edab455583e9aa943e69a96092bd934a7950.tar.gz
emacs-51a1edab455583e9aa943e69a96092bd934a7950.zip
(custom-face-attributes): Remove SET and GET functions. Add some
IN-FILTER and OUT-FILTER functions in the few cases they're needed.
-rw-r--r--lisp/ChangeLog12
-rw-r--r--lisp/cus-face.el168
2 files changed, 59 insertions, 121 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 4145a9a85c4..7f41204fea5 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,15 @@
12000-11-24 Miles Bader <miles@gnu.org>
2
3 * cus-edit.el (custom-filter-face-spec, custom-pre-filter-face-spec)
4 (custom-post-filter-face-spec): New functions.
5 (custom-face-set, custom-face-value-create): Filter the face spec
6 before and after customization.
7 (custom-face-set): If VALUE specifies a null face, pass a
8 non-null-but-otherwise-ignored face-spec instead to `face-spec-set'.
9 * cus-face.el (custom-face-attributes): Remove SET and GET
10 functions. Add some IN-FILTER and OUT-FILTER functions in the few
11 cases they're needed.
12
12000-11-24 Michael Kifer <kifer@cs.sunysb.edu> 132000-11-24 Michael Kifer <kifer@cs.sunysb.edu>
2 14
3 * ediff-diff.el: Moved variables around to have it compile under NT. 15 * ediff-diff.el: Moved variables around to have it compile under NT.
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index a9290eb7294..62f5cb57a82 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -1,6 +1,6 @@
1;;; cus-face.el -- customization support for faces. 1;;; cus-face.el -- customization support for faces.
2;; 2;;
3;; Copyright (C) 1996, 1997, 1999 Free Software Foundation, Inc. 3;; Copyright (C) 1996, 1997, 1999, 2000 Free Software Foundation, Inc.
4;; 4;;
5;; Author: Per Abrahamsen <abraham@dina.kvl.dk> 5;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
6;; Keywords: help, faces 6;; Keywords: help, faces
@@ -73,12 +73,7 @@
73 (choice :tag "Font family" 73 (choice :tag "Font family"
74 :help-echo "Font family or fontset alias name." 74 :help-echo "Font family or fontset alias name."
75 (const :tag "*" nil) 75 (const :tag "*" nil)
76 (string :tag "Family")) 76 (string :tag "Family")))
77 (lambda (face value &optional frame)
78 (set-face-attribute face frame :family (or value 'unspecified)))
79 (lambda (face &optional frame)
80 (let ((family (face-attribute face :family frame)))
81 (if (eq family 'unspecified) nil family))))
82 77
83 (:width 78 (:width
84 (choice :tag "Width" 79 (choice :tag "Width"
@@ -98,24 +93,14 @@
98 (const :tag "semiexpanded" semi-expanded) 93 (const :tag "semiexpanded" semi-expanded)
99 (const :tag "ultracondensed" ultra-condensed) 94 (const :tag "ultracondensed" ultra-condensed)
100 (const :tag "ultraexpanded" ultra-expanded) 95 (const :tag "ultraexpanded" ultra-expanded)
101 (const :tag "wide" extra-expanded)) 96 (const :tag "wide" extra-expanded)))
102 (lambda (face value &optional frame)
103 (set-face-attribute face frame :width (or value 'unspecified)))
104 (lambda (face &optional frame)
105 (let ((width (face-attribute face :width frame)))
106 (if (eq width 'unspecified) nil width))))
107 97
108 (:height 98 (:height
109 (choice :tag "Height" 99 (choice :tag "Height"
110 :help-echo "Face's font height." 100 :help-echo "Face's font height."
111 (const :tag "*" nil) 101 (const :tag "*" nil)
112 (integer :tag "Height in 1/10 pt") 102 (integer :tag "Height in 1/10 pt")
113 (number :tag "Scale" 1.0)) 103 (number :tag "Scale" 1.0)))
114 (lambda (face value &optional frame)
115 (set-face-attribute face frame :height (or value 'unspecified)))
116 (lambda (face &optional frame)
117 (let ((height (face-attribute face :height frame)))
118 (if (eq height 'unspecified) nil height))))
119 104
120 (:weight 105 (:weight
121 (choice :tag "Weight" 106 (choice :tag "Weight"
@@ -135,12 +120,7 @@
135 (const :tag "semibold" semi-bold) 120 (const :tag "semibold" semi-bold)
136 (const :tag "semilight" semi-light) 121 (const :tag "semilight" semi-light)
137 (const :tag "ultralight" ultra-light) 122 (const :tag "ultralight" ultra-light)
138 (const :tag "ultrabold" ultra-bold)) 123 (const :tag "ultrabold" ultra-bold)))
139 (lambda (face value &optional frame)
140 (set-face-attribute face frame :weight (or value 'unspecified)))
141 (lambda (face &optional frame)
142 (let ((weight (face-attribute face :weight frame)))
143 (if (eq weight 'unspecified) nil weight))))
144 124
145 (:slant 125 (:slant
146 (choice :tag "Slant" 126 (choice :tag "Slant"
@@ -148,12 +128,7 @@
148 (const :tag "*" nil) 128 (const :tag "*" nil)
149 (const :tag "italic" italic) 129 (const :tag "italic" italic)
150 (const :tag "oblique" oblique) 130 (const :tag "oblique" oblique)
151 (const :tag "normal" normal)) 131 (const :tag "normal" normal)))
152 (lambda (face value &optional frame)
153 (set-face-attribute face frame :slant (or value 'unspecified)))
154 (lambda (face &optional frame)
155 (let ((slant (face-attribute face :slant frame)))
156 (if (eq slant 'unspecified) nil slant))))
157 132
158 (:underline 133 (:underline
159 (choice :tag "Underline" 134 (choice :tag "Underline"
@@ -161,15 +136,7 @@
161 (const :tag "*" nil) 136 (const :tag "*" nil)
162 (const :tag "On" t) 137 (const :tag "On" t)
163 (const :tag "Off" off) 138 (const :tag "Off" off)
164 (color :tag "Colored")) 139 (color :tag "Colored")))
165 (lambda (face value &optional frame)
166 (cond ((eq value 'off) (setq value nil))
167 ((null value) (setq value 'unspecified)))
168 (set-face-attribute face frame :underline value))
169 (lambda (face &optional frame)
170 (let ((underline (face-attribute face :underline frame)))
171 (cond ((eq underline 'unspecified) nil)
172 ((null underline) 'off)))))
173 140
174 (:overline 141 (:overline
175 (choice :tag "Overline" 142 (choice :tag "Overline"
@@ -177,15 +144,7 @@
177 (const :tag "*" nil) 144 (const :tag "*" nil)
178 (const :tag "On" t) 145 (const :tag "On" t)
179 (const :tag "Off" off) 146 (const :tag "Off" off)
180 (color :tag "Colored")) 147 (color :tag "Colored")))
181 (lambda (face value &optional frame)
182 (cond ((eq value 'off) (setq value nil))
183 ((null value) (setq value 'unspecified)))
184 (set-face-attribute face frame :overline value))
185 (lambda (face &optional frame)
186 (let ((overline (face-attribute face :overline frame)))
187 (cond ((eq overline 'unspecified) nil)
188 ((null overline) 'off)))))
189 148
190 (:strike-through 149 (:strike-through
191 (choice :tag "Strike-through" 150 (choice :tag "Strike-through"
@@ -193,23 +152,14 @@
193 (const :tag "*" nil) 152 (const :tag "*" nil)
194 (const :tag "On" t) 153 (const :tag "On" t)
195 (const :tag "Off" off) 154 (const :tag "Off" off)
196 (color :tag "Colored")) 155 (color :tag "Colored")))
197 (lambda (face value &optional frame)
198 (cond ((eq value 'off) (setq value nil))
199 ((null value) (setq value 'unspecified)))
200 (set-face-attribute face frame :strike-through value))
201 (lambda (face &optional frame)
202 (let ((value (face-attribute face :strike-through frame)))
203 (cond ((eq value 'unspecified) (setq value nil))
204 ((null value) (setq value 'off)))
205 value)))
206 156
207 (:box 157 (:box
208 ;; Fixme: this can probably be done better. 158 ;; Fixme: this can probably be done better.
209 (choice :tag "Box around text" 159 (choice :tag "Box around text"
210 :help-echo "Control box around text." 160 :help-echo "Control box around text."
211 (const :tag "*" t) 161 (const :tag "*" nil)
212 (const :tag "Off" nil) 162 (const :tag "Off" off)
213 (list :tag "Box" 163 (list :tag "Box"
214 :value (:line-width 2 :color "grey75" 164 :value (:line-width 2 :color "grey75"
215 :style released-button) 165 :style released-button)
@@ -222,97 +172,73 @@
222 (const :tag "Raised" released-button) 172 (const :tag "Raised" released-button)
223 (const :tag "Sunken" pressed-button) 173 (const :tag "Sunken" pressed-button)
224 (const :tag "None" nil)))) 174 (const :tag "None" nil))))
225 (lambda (face value &optional frame) 175 ;; filter to make value suitable for customize
226 (set-face-attribute face frame :box value)) 176 (lambda (real-value)
227 (lambda (face &optional frame) 177 (if (consp real-value)
228 (let ((value (face-attribute face :box frame))) 178 (list :line-width (or (plist-get real-value :line-width) 1)
229 (if (consp value) 179 :color (plist-get real-value :color)
230 (list :line-width (or (plist-get value :line-width) 1) 180 :style (plist-get real-value :style))
231 :color (plist-get value :color) 181 real-value)))
232 :style (plist-get value :style))
233 value))))
234 182
235 (:inverse-video 183 (:inverse-video
236 (choice :tag "Inverse-video" 184 (choice :tag "Inverse-video"
237 :help-echo "Control whether text should be in inverse-video." 185 :help-echo "Control whether text should be in inverse-video."
238 (const :tag "*" nil) 186 (const :tag "*" nil)
239 (const :tag "On" t) 187 (const :tag "On" t)
240 (const :tag "Off" off)) 188 (const :tag "Off" off)))
241 (lambda (face value &optional frame)
242 (cond ((eq value 'off) (setq value nil))
243 ((null value) (setq value 'unspecified)))
244 (set-face-attribute face frame :inverse-video value))
245 (lambda (face &optional frame)
246 (let ((value (face-attribute face :inverse-video frame)))
247 (cond ((eq value 'unspecified)
248 nil)
249 ((null value)'off)))))
250 189
251 (:foreground 190 (:foreground
252 (choice :tag "Foreground" 191 (choice :tag "Foreground"
253 :help-echo "Set foreground color." 192 :help-echo "Set foreground color."
254 (const :tag "*" nil) 193 (const :tag "*" nil)
255 (color :tag "Color")) 194 (color :tag "Color")))
256 (lambda (face value &optional frame)
257 (set-face-attribute face frame :foreground (or value 'unspecified)))
258 (lambda (face &optional frame)
259 (let ((value (face-attribute face :foreground frame)))
260 (if (eq value 'unspecified) nil value))))
261 195
262 (:background 196 (:background
263 (choice :tag "Background" 197 (choice :tag "Background"
264 :help-echo "Set background color." 198 :help-echo "Set background color."
265 (const :tag "*" nil) 199 (const :tag "*" nil)
266 (color :tag "Color")) 200 (color :tag "Color")))
267 (lambda (face value &optional frame)
268 (set-face-attribute face frame :background (or value 'unspecified)))
269 (lambda (face &optional frame)
270 (let ((value (face-attribute face :background frame)))
271 (if (eq value 'unspecified) nil value))))
272 201
273 (:stipple 202 (:stipple
274 (choice :tag "Stipple" 203 (choice :tag "Stipple"
275 :help-echo "Name of background bitmap file." 204 :help-echo "Name of background bitmap file."
276 (const :tag "*" nil) 205 (const :tag "*" nil)
277 (file :tag "File" :must-match t)) 206 (file :tag "File" :must-match t)))
278 (lambda (face value &optional frame)
279 (set-face-attribute face frame :stipple (or value 'unspecified)))
280 (lambda (face &optional frame)
281 (let ((value (face-attribute face :stipple frame)))
282 (if (eq value 'unspecified) nil value))))
283 207
284 (:inherit 208 (:inherit
285 (repeat :tag "Inherit" 209 (repeat :tag "Inherit"
286 :help-echo "List of faces to inherit attributes from." 210 :help-echo "List of faces to inherit attributes from."
287 (face :Tag "Face" default)) 211 (face :Tag "Face" default))
288 (lambda (face value &optional frame) 212 ;; filter to make value suitable for customize
289 (message "Setting to: <%s>" value) 213 (lambda (real-value)
290 (set-face-attribute face frame :inherit 214 (cond ((or (null real-value) (eq real-value 'unspecified))
291 (if (and (consp value) (null (cdr value))) 215 nil)
292 (car value) 216 ((symbolp real-value)
293 value))) 217 (list real-value))
294 (lambda (face &optional frame) 218 (t
295 (let ((value (face-attribute face :inherit frame))) 219 real-value)))
296 (cond ((or (null value) (eq value 'unspecified)) 220 ;; filter to make customized-value suitable for storing
297 nil) 221 (lambda (cus-value)
298 ((symbolp value) 222 (if (and (consp cus-value) (null (cdr cus-value)))
299 (list value)) 223 (car cus-value)
300 (t 224 cus-value))))
301 value))))))
302 225
303 "Alist of face attributes. 226 "Alist of face attributes.
304 227
305The elements are of the form (KEY TYPE SET GET), where KEY is the name 228The elements are of the form (KEY TYPE PRE-FILTER POST-FILTER),
306of the attribute, TYPE is a widget type for editing the attibute, SET 229where KEY is the name of the attribute, TYPE is a widget type for
307is a function for setting the attribute value, and GET is a function 230editing the attribute, PRE-FILTER is a function to make the attribute's
308for getiing the attribute value. 231value suitable for the customization widget, and POST-FILTER is a
232function to make the customized value suitable for storing. PRE-FILTER
233and POST-FILTER are optional.
309 234
310The SET function should take three arguments, the face to modify, the 235The PRE-FILTER should take a single argument, the attribute value as
311value of the attribute, and optionally the frame where the face should 236stored, and should return a value for customization (using the
312be changed. 237customization type TYPE).
313 238
314The GET function should take two arguments, the face to examine, and 239The POST-FILTER should also take a single argument, the value after
315optionally the frame where the face should be examined.") 240being customized, and should return a value suitable for setting the
241given face attribute.")
316 242
317 243
318(defun custom-face-attributes-get (face frame) 244(defun custom-face-attributes-get (face frame)