# HG changeset patch
# User Richard M. Stallman <rms@gnu.org>
# Date 867913870 0
# Node ID f0c2a091d91f5fe07eba4f9c7222b1aafd38d5d0
# Parent  1beba85e8c62d06c3c88dcd624c9feda77c77b92
(color-sample, editable-color): New widget types.

(widget-button-face): Default value widget-button-face.
(widget-default-button-face-get): Use variable widget-button-face.

diff -r 1beba85e8c62 -r f0c2a091d91f lisp/wid-edit.el
--- a/lisp/wid-edit.el	Thu Jul 03 07:09:29 1997 +0000
+++ b/lisp/wid-edit.el	Thu Jul 03 07:11:10 1997 +0000
@@ -157,6 +157,10 @@
   :group 'widget-documentation
   :group 'widget-faces)
 
+(defvar widget-button-face 'widget-button-face
+  "Face used for buttons in widges.
+This exists as a variable so it can be set locally in certain buffers.")
+
 (defface widget-button-face '((t (:bold t)))
   "Face used for widget buttons."
   :group 'widget-faces)
@@ -1533,17 +1537,13 @@
 	   (error "Unknown escape `%c'" escape)))
     (widget-put widget :buttons buttons)))
 
-(defvar widget-button-face nil
-  "Face to use for buttons.
-This is a variable so that it can be buffer-local.")
-
 (defun widget-default-button-face-get (widget)
   ;; Use :button-face or widget-button-face
   (or (widget-get widget :button-face)
       (let ((parent (widget-get widget :parent)))
 	(if parent
 	    (widget-apply parent :button-face-get)
-	  'widget-button-face))))
+	  widget-button-face))))
 
 (defun widget-default-sample-face-get (widget)
   ;; Use :sample-face.
@@ -3389,6 +3389,30 @@
       (widget-setup)
       (widget-apply widget :notify widget event))))
 
+;;; The alternative `editable-color' widget and its subroutine.
+
+(define-widget 'color-sample 'choice-item
+  "A color name (with sample)."
+  :format "(%{sample%})"
+  :sample-face-get 'widget-color-item-button-face-get)
+
+(define-widget 'editable-color 'editable-field
+  "A color name, editable"
+  :tag "Color"
+  :format "%{%t%}: %v"
+  :complete-function 'widget-color-complete
+  :value-create 'widget-editable-color-value-create
+  :prompt-match '(lambda (color) (member color widget-color-choice-list))
+  :prompt-history 'widget-string-prompt-value-history)
+
+(defun widget-editable-color-value-create (widget)
+  (widget-field-value-create widget)
+  (forward-line -1)
+  (end-of-line)
+  (let ((child (widget-create-child-and-convert
+		widget 'color-sample (widget-get widget :value))))
+    (widget-put widget :children (list child))))
+
 ;;; The Help Echo
 
 (defun widget-echo-help-mouse ()