(face): Derive from symbol widget. Display sample

of the current face on the fly.
(widget-face-sample-face-get, widget-face-notify): New functions.
(widget-face-value-create): Remove.

diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index fb76aa6c3d899bd104ea2da2e6234536e5d2cdff..0b06b3f6980836c11b8116e0ce8186e982fc909a 100644 (file)
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -3296,65 +3296,37 @@ restoring it to the state of a face that has never been customized."
 (defvar widget-face-prompt-value-history nil
   "History of input to `widget-face-prompt-value'.")
 
-(define-widget 'face 'restricted-sexp
-  "A Lisp face name."
+(define-widget 'face 'symbol
+  "A Lisp face name (with sample)."
+  :format "%t: (%{sample%}) %v"
+  :tag "Face"
+  :value 'default
+  :sample-face-get 'widget-face-sample-face-get
+  :notify 'widget-face-notify
+  :match (lambda (widget value) (facep value))
   :complete-function (lambda ()
                       (interactive)
                       (lisp-complete-symbol 'facep))
-  :prompt-value 'widget-field-prompt-value
-  :prompt-internal 'widget-symbol-prompt-internal
   :prompt-match 'facep
   :prompt-history 'widget-face-prompt-value-history
-  :value-create 'widget-face-value-create
-  :action 'widget-field-action
-  :match-alternatives '(facep)
   :validate (lambda (widget)
              (unless (facep (widget-value widget))
-               (widget-put widget :error (format "Invalid face: %S"
-                                                 (widget-value widget)))
-               widget))
-  :value 'ignore
-  :tag "Function")
-
-
-;;; There is a bug here: the sample doesn't get redisplayed
-;;; in the new font when you specify one.  Does anyone know how to
-;;; make that work?  -- rms.
-
-(defun widget-face-value-create (widget)
-  "Create an editable face name field."
-  (let ((buttons (widget-get widget :buttons))
-       (symbol (widget-get widget :value)))
-    ;; Sample.
-    (push (widget-create-child-and-convert widget 'item
-                                          :format "(%{%t%})"
-                                          :sample-face symbol
-                                          :tag "sample")
-         buttons)
-    (insert " ")
-    ;; Update buttons.
-    (widget-put widget :buttons buttons))
-
-  (let ((size (widget-get widget :size))
-       (value (widget-get widget :value))
-       (from (point))
-       ;; This is changed to a real overlay in `widget-setup'.  We
-       ;; need the end points to behave differently until
-       ;; `widget-setup' is called.
-       (overlay (cons (make-marker) (make-marker))))
-    (widget-put widget :field-overlay overlay)
-    (insert value)
-    (and size
-        (< (length value) size)
-        (insert-char ?\  (- size (length value))))
-    (unless (memq widget widget-field-list)
-      (setq widget-field-new (cons widget widget-field-new)))
-    (move-marker (cdr overlay) (point))
-    (set-marker-insertion-type (cdr overlay) nil)
-    (when (null size)
-      (insert ?\n))
-    (move-marker (car overlay) from)
-    (set-marker-insertion-type (car overlay) t)))
+               (widget-put widget
+                           :error (format "Invalid face: %S"
+                                          (widget-value widget)))
+               widget)))
+
+(defun widget-face-sample-face-get (widget)
+  (let ((value (widget-value widget)))
+    (if (facep value)
+       value
+      'default)))
+
+(defun widget-face-notify (widget child &optional event)
+  "Update the sample, and notify the parent."
+  (overlay-put (widget-get widget :sample-overlay)
+              'face (widget-apply widget :sample-face-get))
+  (widget-default-notify widget child event))
 
 
 ;;; The `hook' Widget.