# HG changeset patch # User Miles Bader # Date 975057046 0 # Node ID 1ae73b01ef272b7a1a2986bbc34c441b47d797f3 # Parent 388a61e78c539d6d8fc8a5d9da0c3fedc5f4a065 (custom-face-attributes): Remove SET and GET functions. Add some IN-FILTER and OUT-FILTER functions in the few cases they're needed. diff -r 388a61e78c53 -r 1ae73b01ef27 lisp/cus-face.el --- a/lisp/cus-face.el Fri Nov 24 09:09:55 2000 +0000 +++ b/lisp/cus-face.el Fri Nov 24 09:10:46 2000 +0000 @@ -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 ;; 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)