procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

(custom-face-attributes): Remove SET and GET functions. Add some

Browse source 
IN-FILTER and OUT-FILTER functions in the few cases they're needed.
This commit is contained in:
Miles Bader 2000-11-24 09:12:12 +00:00
parent f5b50baad3
commit 51a1edab45
2 changed files with 59 additions and 121 deletions
Download patch file Download diff file Expand all files Collapse all files

12
lisp/ChangeLog
View file

@ -1,3 +1,15 @@
2000-11-24 Miles Bader <miles@gnu.org>
* cus-edit.el (custom-filter-face-spec, custom-pre-filter-face-spec)
(custom-post-filter-face-spec): New functions.
(custom-face-set, custom-face-value-create): Filter the face spec
before and after customization.
(custom-face-set): If VALUE specifies a null face, pass a
non-null-but-otherwise-ignored face-spec instead to `face-spec-set'.
* cus-face.el (custom-face-attributes): Remove SET and GET
functions. Add some IN-FILTER and OUT-FILTER functions in the few
cases they're needed.
2000-11-24 Michael Kifer <kifer@cs.sunysb.edu> 2000-11-24 Michael Kifer <kifer@cs.sunysb.edu>
* ediff-diff.el: Moved variables around to have it compile under NT. * ediff-diff.el: Moved variables around to have it compile under NT.

164
lisp/cus-face.el
View file

@ -1,6 +1,6 @@
;;; cus-face.el -- customization support for faces. ;;; cus-face.el -- customization support for faces.
;; ;;
;; Copyright (C) 1996, 1997, 1999 Free Software Foundation, Inc. ;; Copyright (C) 1996, 1997, 1999, 2000 Free Software Foundation, Inc.
;; ;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces ;; Keywords: help, faces
@ -73,12 +73,7 @@
(choice :tag "Font family" (choice :tag "Font family"
:help-echo "Font family or fontset alias name." :help-echo "Font family or fontset alias name."
(const :tag "*" nil) (const :tag "*" nil)
(string :tag "Family")) (string :tag "Family")))
(lambda (face value &optional frame)
(set-face-attribute face frame :family (or value 'unspecified)))
(lambda (face &optional frame)
(let ((family (face-attribute face :family frame)))
(if (eq family 'unspecified) nil family))))
(:width (:width
(choice :tag "Width" (choice :tag "Width"
@ -98,24 +93,14 @@
(const :tag "semiexpanded" semi-expanded) (const :tag "semiexpanded" semi-expanded)
(const :tag "ultracondensed" ultra-condensed) (const :tag "ultracondensed" ultra-condensed)
(const :tag "ultraexpanded" ultra-expanded) (const :tag "ultraexpanded" ultra-expanded)
(const :tag "wide" extra-expanded)) (const :tag "wide" extra-expanded)))
(lambda (face value &optional frame)
(set-face-attribute face frame :width (or value 'unspecified)))
(lambda (face &optional frame)
(let ((width (face-attribute face :width frame)))
(if (eq width 'unspecified) nil width))))
(:height (:height
(choice :tag "Height" (choice :tag "Height"
:help-echo "Face's font height." :help-echo "Face's font height."
(const :tag "*" nil) (const :tag "*" nil)
(integer :tag "Height in 1/10 pt") (integer :tag "Height in 1/10 pt")
(number :tag "Scale" 1.0)) (number :tag "Scale" 1.0)))
(lambda (face value &optional frame)
(set-face-attribute face frame :height (or value 'unspecified)))
(lambda (face &optional frame)
(let ((height (face-attribute face :height frame)))
(if (eq height 'unspecified) nil height))))
(:weight (:weight
(choice :tag "Weight" (choice :tag "Weight"
@ -135,12 +120,7 @@
(const :tag "semibold" semi-bold) (const :tag "semibold" semi-bold)
(const :tag "semilight" semi-light) (const :tag "semilight" semi-light)
(const :tag "ultralight" ultra-light) (const :tag "ultralight" ultra-light)
(const :tag "ultrabold" ultra-bold)) (const :tag "ultrabold" ultra-bold)))
(lambda (face value &optional frame)
(set-face-attribute face frame :weight (or value 'unspecified)))
(lambda (face &optional frame)
(let ((weight (face-attribute face :weight frame)))
(if (eq weight 'unspecified) nil weight))))
(:slant (:slant
(choice :tag "Slant" (choice :tag "Slant"
@ -148,12 +128,7 @@
(const :tag "*" nil) (const :tag "*" nil)
(const :tag "italic" italic) (const :tag "italic" italic)
(const :tag "oblique" oblique) (const :tag "oblique" oblique)
(const :tag "normal" normal)) (const :tag "normal" normal)))
(lambda (face value &optional frame)
(set-face-attribute face frame :slant (or value 'unspecified)))
(lambda (face &optional frame)
(let ((slant (face-attribute face :slant frame)))
(if (eq slant 'unspecified) nil slant))))
(:underline (:underline
(choice :tag "Underline" (choice :tag "Underline"
@ -161,15 +136,7 @@
(const :tag "*" nil) (const :tag "*" nil)
(const :tag "On" t) (const :tag "On" t)
(const :tag "Off" off) (const :tag "Off" off)
(color :tag "Colored")) (color :tag "Colored")))
(lambda (face value &optional frame)
(cond ((eq value 'off) (setq value nil))
((null value) (setq value 'unspecified)))
(set-face-attribute face frame :underline value))
(lambda (face &optional frame)
(let ((underline (face-attribute face :underline frame)))
(cond ((eq underline 'unspecified) nil)
((null underline) 'off)))))
(:overline (:overline
(choice :tag "Overline" (choice :tag "Overline"
@ -177,15 +144,7 @@
(const :tag "*" nil) (const :tag "*" nil)
(const :tag "On" t) (const :tag "On" t)
(const :tag "Off" off) (const :tag "Off" off)
(color :tag "Colored")) (color :tag "Colored")))
(lambda (face value &optional frame)
(cond ((eq value 'off) (setq value nil))
((null value) (setq value 'unspecified)))
(set-face-attribute face frame :overline value))
(lambda (face &optional frame)
(let ((overline (face-attribute face :overline frame)))
(cond ((eq overline 'unspecified) nil)
((null overline) 'off)))))
(:strike-through (:strike-through
(choice :tag "Strike-through" (choice :tag "Strike-through"
@ -193,23 +152,14 @@
(const :tag "*" nil) (const :tag "*" nil)
(const :tag "On" t) (const :tag "On" t)
(const :tag "Off" off) (const :tag "Off" off)
(color :tag "Colored")) (color :tag "Colored")))
(lambda (face value &optional frame)
(cond ((eq value 'off) (setq value nil))
((null value) (setq value 'unspecified)))
(set-face-attribute face frame :strike-through value))
(lambda (face &optional frame)
(let ((value (face-attribute face :strike-through frame)))
(cond ((eq value 'unspecified) (setq value nil))
((null value) (setq value 'off)))
value)))
(:box (:box
;; Fixme: this can probably be done better. ;; Fixme: this can probably be done better.
(choice :tag "Box around text" (choice :tag "Box around text"
:help-echo "Control box around text." :help-echo "Control box around text."
(const :tag "*" t) (const :tag "*" nil)
(const :tag "Off" nil) (const :tag "Off" off)
(list :tag "Box" (list :tag "Box"
:value (:line-width 2 :color "grey75" :value (:line-width 2 :color "grey75"
:style released-button) :style released-button)
@ -222,97 +172,73 @@
(const :tag "Raised" released-button) (const :tag "Raised" released-button)
(const :tag "Sunken" pressed-button) (const :tag "Sunken" pressed-button)
(const :tag "None" nil)))) (const :tag "None" nil))))
(lambda (face value &optional frame) ;; filter to make value suitable for customize
(set-face-attribute face frame :box value)) (lambda (real-value)
(lambda (face &optional frame) (if (consp real-value)
(let ((value (face-attribute face :box frame))) (list :line-width (or (plist-get real-value :line-width) 1)
(if (consp value) :color (plist-get real-value :color)
(list :line-width (or (plist-get value :line-width) 1) :style (plist-get real-value :style))
:color (plist-get value :color) real-value)))
:style (plist-get value :style))
value))))
(:inverse-video (:inverse-video
(choice :tag "Inverse-video" (choice :tag "Inverse-video"
:help-echo "Control whether text should be in inverse-video." :help-echo "Control whether text should be in inverse-video."
(const :tag "*" nil) (const :tag "*" nil)
(const :tag "On" t) (const :tag "On" t)
(const :tag "Off" off)) (const :tag "Off" off)))
(lambda (face value &optional frame)
(cond ((eq value 'off) (setq value nil))
((null value) (setq value 'unspecified)))
(set-face-attribute face frame :inverse-video value))
(lambda (face &optional frame)
(let ((value (face-attribute face :inverse-video frame)))
(cond ((eq value 'unspecified)
nil)
((null value)'off)))))
(:foreground (:foreground
(choice :tag "Foreground" (choice :tag "Foreground"
:help-echo "Set foreground color." :help-echo "Set foreground color."
(const :tag "*" nil) (const :tag "*" nil)
(color :tag "Color")) (color :tag "Color")))
(lambda (face value &optional frame)
(set-face-attribute face frame :foreground (or value 'unspecified)))
(lambda (face &optional frame)
(let ((value (face-attribute face :foreground frame)))
(if (eq value 'unspecified) nil value))))
(:background (:background
(choice :tag "Background" (choice :tag "Background"
:help-echo "Set background color." :help-echo "Set background color."
(const :tag "*" nil) (const :tag "*" nil)
(color :tag "Color")) (color :tag "Color")))
(lambda (face value &optional frame)
(set-face-attribute face frame :background (or value 'unspecified)))
(lambda (face &optional frame)
(let ((value (face-attribute face :background frame)))
(if (eq value 'unspecified) nil value))))
(:stipple (:stipple
(choice :tag "Stipple" (choice :tag "Stipple"
:help-echo "Name of background bitmap file." :help-echo "Name of background bitmap file."
(const :tag "*" nil) (const :tag "*" nil)
(file :tag "File" :must-match t)) (file :tag "File" :must-match t)))
(lambda (face value &optional frame)
(set-face-attribute face frame :stipple (or value 'unspecified)))
(lambda (face &optional frame)
(let ((value (face-attribute face :stipple frame)))
(if (eq value 'unspecified) nil value))))
(:inherit (:inherit
(repeat :tag "Inherit" (repeat :tag "Inherit"
:help-echo "List of faces to inherit attributes from." :help-echo "List of faces to inherit attributes from."
(face :Tag "Face" default)) (face :Tag "Face" default))
(lambda (face value &optional frame) ;; filter to make value suitable for customize
(message "Setting to: <%s>" value) (lambda (real-value)
(set-face-attribute face frame :inherit (cond ((or (null real-value) (eq real-value 'unspecified))
(if (and (consp value) (null (cdr value)))
(car value)
value)))
(lambda (face &optional frame)
(let ((value (face-attribute face :inherit frame)))
(cond ((or (null value) (eq value 'unspecified))
nil) nil)
((symbolp value) ((symbolp real-value)
(list value)) (list real-value))
(t (t
value)))))) real-value)))
;; filter to make customized-value suitable for storing
(lambda (cus-value)
(if (and (consp cus-value) (null (cdr cus-value)))
(car cus-value)
cus-value))))
"Alist of face attributes. "Alist of face attributes.
The elements are of the form (KEY TYPE SET GET), where KEY is the name The elements are of the form (KEY TYPE PRE-FILTER POST-FILTER),
of the attribute, TYPE is a widget type for editing the attibute, SET where KEY is the name of the attribute, TYPE is a widget type for
is a function for setting the attribute value, and GET is a function editing the attribute, PRE-FILTER is a function to make the attribute's
for getiing the attribute value. value suitable for the customization widget, and POST-FILTER is a
function to make the customized value suitable for storing. PRE-FILTER
and POST-FILTER are optional.
The SET function should take three arguments, the face to modify, the The PRE-FILTER should take a single argument, the attribute value as
value of the attribute, and optionally the frame where the face should stored, and should return a value for customization (using the
be changed. customization type TYPE).
The GET function should take two arguments, the face to examine, and The POST-FILTER should also take a single argument, the value after
optionally the frame where the face should be examined.") being customized, and should return a value suitable for setting the
given face attribute.")
(defun custom-face-attributes-get (face frame) (defun custom-face-attributes-get (face frame)