changeset 61307:0592ebb75598

(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.

--- a/lisp/cus-edit.el	Tue Apr 05 06:38:49 2005 +0000
+++ b/lisp/cus-edit.el	Tue Apr 05 06:40:12 2005 +0000
@@ -3296,65 +3296,37 @@
 (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.