diff options
| author | Miles Bader | 2000-11-24 09:12:12 +0000 |
|---|---|---|
| committer | Miles Bader | 2000-11-24 09:12:12 +0000 |
| commit | 51a1edab455583e9aa943e69a96092bd934a7950 (patch) | |
| tree | 2cfd706d451f549407d9e253d2ea9132ed3c6883 | |
| parent | f5b50baad33a98aba08e7889451b2749994e159b (diff) | |
| download | emacs-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/ChangeLog | 12 | ||||
| -rw-r--r-- | lisp/cus-face.el | 168 |
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 @@ | |||
| 1 | 2000-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 | |||
| 1 | 2000-11-24 Michael Kifer <kifer@cs.sunysb.edu> | 13 | 2000-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 | ||
| 305 | The elements are of the form (KEY TYPE SET GET), where KEY is the name | 228 | The elements are of the form (KEY TYPE PRE-FILTER POST-FILTER), |
| 306 | of the attribute, TYPE is a widget type for editing the attibute, SET | 229 | where KEY is the name of the attribute, TYPE is a widget type for |
| 307 | is a function for setting the attribute value, and GET is a function | 230 | editing the attribute, PRE-FILTER is a function to make the attribute's |
| 308 | for getiing the attribute value. | 231 | value suitable for the customization widget, and POST-FILTER is a |
| 232 | function to make the customized value suitable for storing. PRE-FILTER | ||
| 233 | and POST-FILTER are optional. | ||
| 309 | 234 | ||
| 310 | The SET function should take three arguments, the face to modify, the | 235 | The PRE-FILTER should take a single argument, the attribute value as |
| 311 | value of the attribute, and optionally the frame where the face should | 236 | stored, and should return a value for customization (using the |
| 312 | be changed. | 237 | customization type TYPE). |
| 313 | 238 | ||
| 314 | The GET function should take two arguments, the face to examine, and | 239 | The POST-FILTER should also take a single argument, the value after |
| 315 | optionally the frame where the face should be examined.") | 240 | being customized, and should return a value suitable for setting the |
| 241 | given face attribute.") | ||
| 316 | 242 | ||
| 317 | 243 | ||
| 318 | (defun custom-face-attributes-get (face frame) | 244 | (defun custom-face-attributes-get (face frame) |