# HG changeset patch # User Miles Bader # Date 975056995 0 # Node ID 388a61e78c539d6d8fc8a5d9da0c3fedc5f4a065 # Parent f6a67d77484a0d6048ed76cdfd8cb68adfa1b266 (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'. diff -r f6a67d77484a -r 388a61e78c53 lisp/cus-edit.el --- a/lisp/cus-edit.el Fri Nov 24 08:15:11 2000 +0000 +++ b/lisp/cus-edit.el Fri Nov 24 09:09:55 2000 +0000 @@ -2593,6 +2593,57 @@ (defconst custom-face-selected (widget-convert 'custom-face-selected) "Converted version of the `custom-face-selected' widget.") +(defun custom-filter-face-spec (spec filter-index default-filter) + "Return a canonicalized version of SPEC using. +FILTER-INDEX is the index in the entry for each attribute in +`custom-face-attributes' at which the appropriate filter function can be +found, and DEFAULT-FILTER is the filter to apply for attributes that +don't specify one." + (mapcar (lambda (entry) + ;; Filter a single face-spec entry + (let ((tests (car entry)) + (unfiltered-attrs + ;; Handle both old- and new-style attribute syntax + (if (listp (car (cdr entry))) + (car (cdr entry)) + (cdr entry))) + (filtered-attrs nil)) + ;; Filter each face attribute + (while unfiltered-attrs + (let* ((attr (pop unfiltered-attrs)) + (pre-filtered-value (pop unfiltered-attrs)) + (filter + (or (nth filter-index (assq attr custom-face-attributes)) + default-filter)) + (filtered-value + (if filter + (funcall filter pre-filtered-value) + pre-filtered-value))) + (push filtered-value filtered-attrs) + (push attr filtered-attrs))) + ;; + (list tests filtered-attrs))) + spec)) + +(defun custom-pre-filter-face-spec (spec) + "Return SPEC changed as necessary for editing by the face customization widget. +SPEC must be a full face spec." + (custom-filter-face-spec + spec 2 + (lambda (value) + (cond ((eq value 'unspecified) nil) + ((eq value nil) 'off) + (t value))))) + +(defun custom-post-filter-face-spec (spec) + "Return the customized SPEC in a form suitable for setting the face." + (custom-filter-face-spec + spec 3 + (lambda (value) + (cond ((eq value nil) 'unspecified) + ((eq value 'off) nil) + (t value))))) + (defun custom-face-value-create (widget) "Create a list of the display specifications for WIDGET." (let ((buttons (widget-get widget :buttons)) @@ -2681,6 +2732,7 @@ ;; edit it as the user has specified it. (if (not (face-spec-match-p symbol spec (selected-frame))) (setq spec (list (list t (face-attr-construct symbol (selected-frame)))))) + (setq spec (custom-pre-filter-face-spec spec)) (setq edit (widget-create-child-and-convert widget (cond ((and (eq form 'selected) @@ -2794,7 +2846,7 @@ "Make the face attributes in WIDGET take effect." (let* ((symbol (widget-value widget)) (child (car (widget-get widget :children))) - (value (widget-value child)) + (value (custom-post-filter-face-spec (widget-value child))) (comment-widget (widget-get widget :comment-widget)) (comment (widget-value comment-widget))) (when (equal comment "") @@ -2802,7 +2854,11 @@ ;; Make the comment invisible by hand if it's empty (custom-comment-hide comment-widget)) (put symbol 'customized-face value) - (face-spec-set symbol value) + (if (face-spec-choose value) + (face-spec-set symbol value) + ;; face-set-spec ignores empty attribute lists, so just give it + ;; something harmless instead. + (face-spec-set symbol '((t :foreground unspecified)))) (put symbol 'customized-face-comment comment) (put symbol 'face-comment comment) (custom-face-state-set widget)