mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-22 07:09:54 +00:00
(custom-face-attributes): Remove SET and GET functions. Add some
IN-FILTER and OUT-FILTER functions in the few cases they're needed.
This commit is contained in:
Miles Bader
parent
f5b50baad3
commit
51a1edab45
@ -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>
|
||||
|
||||
* ediff-diff.el: Moved variables around to have it compile under NT.
|
||||
|
||||
168
lisp/cus-face.el
168
lisp/cus-face.el
@ -1,6 +1,6 @@
|
||||
;;; 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>
|
||||
;; Keywords: help, faces
|
||||
@ -73,12 +73,7 @@
|
||||
(choice :tag "Font family"
|
||||
:help-echo "Font family or fontset alias name."
|
||||
(const :tag "*" nil)
|
||||
(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))))
|
||||
(string :tag "Family")))
|
||||
|
||||
(:width
|
||||
(choice :tag "Width"
|
||||
@ -98,24 +93,14 @@
|
||||
(const :tag "semiexpanded" semi-expanded)
|
||||
(const :tag "ultracondensed" ultra-condensed)
|
||||
(const :tag "ultraexpanded" ultra-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))))
|
||||
(const :tag "wide" extra-expanded)))
|
||||
|
||||
(:height
|
||||
(choice :tag "Height"
|
||||
:help-echo "Face's font height."
|
||||
(const :tag "*" nil)
|
||||
(integer :tag "Height in 1/10 pt")
|
||||
(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))))
|
||||
(number :tag "Scale" 1.0)))
|
||||
|
||||
(:weight
|
||||
(choice :tag "Weight"
|
||||
@ -135,12 +120,7 @@
|
||||
(const :tag "semibold" semi-bold)
|
||||
(const :tag "semilight" semi-light)
|
||||
(const :tag "ultralight" ultra-light)
|
||||
(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))))
|
||||
(const :tag "ultrabold" ultra-bold)))
|
||||
|
||||
(:slant
|
||||
(choice :tag "Slant"
|
||||
@ -148,12 +128,7 @@
|
||||
(const :tag "*" nil)
|
||||
(const :tag "italic" italic)
|
||||
(const :tag "oblique" oblique)
|
||||
(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))))
|
||||
(const :tag "normal" normal)))
|
||||
|
||||
(:underline
|
||||
(choice :tag "Underline"
|
||||
@ -161,15 +136,7 @@
|
||||
(const :tag "*" nil)
|
||||
(const :tag "On" t)
|
||||
(const :tag "Off" off)
|
||||
(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)))))
|
||||
(color :tag "Colored")))
|
||||
|
||||
(:overline
|
||||
(choice :tag "Overline"
|
||||
@ -177,15 +144,7 @@
|
||||
(const :tag "*" nil)
|
||||
(const :tag "On" t)
|
||||
(const :tag "Off" off)
|
||||
(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)))))
|
||||
(color :tag "Colored")))
|
||||
|
||||
(:strike-through
|
||||
(choice :tag "Strike-through"
|
||||
@ -193,23 +152,14 @@
|
||||
(const :tag "*" nil)
|
||||
(const :tag "On" t)
|
||||
(const :tag "Off" off)
|
||||
(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)))
|
||||
(color :tag "Colored")))
|
||||
|
||||
(:box
|
||||
;; Fixme: this can probably be done better.
|
||||
(choice :tag "Box around text"
|
||||
:help-echo "Control box around text."
|
||||
(const :tag "*" t)
|
||||
(const :tag "Off" nil)
|
||||
(const :tag "*" nil)
|
||||
(const :tag "Off" off)
|
||||
(list :tag "Box"
|
||||
:value (:line-width 2 :color "grey75"
|
||||
:style released-button)
|
||||
@ -222,97 +172,73 @@
|
||||
(const :tag "Raised" released-button)
|
||||
(const :tag "Sunken" pressed-button)
|
||||
(const :tag "None" nil))))
|
||||
(lambda (face value &optional frame)
|
||||
(set-face-attribute face frame :box value))
|
||||
(lambda (face &optional frame)
|
||||
(let ((value (face-attribute face :box frame)))
|
||||
(if (consp value)
|
||||
(list :line-width (or (plist-get value :line-width) 1)
|
||||
:color (plist-get value :color)
|
||||
:style (plist-get value :style))
|
||||
value))))
|
||||
;; filter to make value suitable for customize
|
||||
(lambda (real-value)
|
||||
(if (consp real-value)
|
||||
(list :line-width (or (plist-get real-value :line-width) 1)
|
||||
:color (plist-get real-value :color)
|
||||
:style (plist-get real-value :style))
|
||||
real-value)))
|
||||
|
||||
(:inverse-video
|
||||
(choice :tag "Inverse-video"
|
||||
:help-echo "Control whether text should be in inverse-video."
|
||||
(const :tag "*" nil)
|
||||
(const :tag "On" t)
|
||||
(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)))))
|
||||
(const :tag "Off" off)))
|
||||
|
||||
(:foreground
|
||||
(choice :tag "Foreground"
|
||||
:help-echo "Set foreground color."
|
||||
(const :tag "*" nil)
|
||||
(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))))
|
||||
(color :tag "Color")))
|
||||
|
||||
(:background
|
||||
(choice :tag "Background"
|
||||
:help-echo "Set background color."
|
||||
(const :tag "*" nil)
|
||||
(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))))
|
||||
(color :tag "Color")))
|
||||
|
||||
(:stipple
|
||||
(choice :tag "Stipple"
|
||||
:help-echo "Name of background bitmap file."
|
||||
(const :tag "*" nil)
|
||||
(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))))
|
||||
(file :tag "File" :must-match t)))
|
||||
|
||||
(:inherit
|
||||
(repeat :tag "Inherit"
|
||||
:help-echo "List of faces to inherit attributes from."
|
||||
(face :Tag "Face" default))
|
||||
(lambda (face value &optional frame)
|
||||
(message "Setting to: <%s>" value)
|
||||
(set-face-attribute face frame :inherit
|
||||
(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)
|
||||
((symbolp value)
|
||||
(list value))
|
||||
(t
|
||||
value))))))
|
||||
;; filter to make value suitable for customize
|
||||
(lambda (real-value)
|
||||
(cond ((or (null real-value) (eq real-value 'unspecified))
|
||||
nil)
|
||||
((symbolp real-value)
|
||||
(list real-value))
|
||||
(t
|
||||
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.
|
||||
|
||||
The elements are of the form (KEY TYPE SET GET), where KEY is the name
|
||||
of the attribute, TYPE is a widget type for editing the attibute, SET
|
||||
is a function for setting the attribute value, and GET is a function
|
||||
for getiing the attribute value.
|
||||
The elements are of the form (KEY TYPE PRE-FILTER POST-FILTER),
|
||||
where KEY is the name of the attribute, TYPE is a widget type for
|
||||
editing the attribute, PRE-FILTER is a function to make the attribute's
|
||||
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
|
||||
value of the attribute, and optionally the frame where the face should
|
||||
be changed.
|
||||
The PRE-FILTER should take a single argument, the attribute value as
|
||||
stored, and should return a value for customization (using the
|
||||
customization type TYPE).
|
||||
|
||||
The GET function should take two arguments, the face to examine, and
|
||||
optionally the frame where the face should be examined.")
|
||||
The POST-FILTER should also take a single argument, the value after
|
||||
being customized, and should return a value suitable for setting the
|
||||
given face attribute.")
|
||||
|
||||
|
||||
(defun custom-face-attributes-get (face frame)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user