X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/e2896b224bff9ca9359367c1c775754905d7bc6c..df9b6d77fe6880565dbe453c8271803bee39f5b5:/lisp/wid-edit.el

diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 52851524b8..fbd76c6931 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1,6 +1,6 @@
 ;;; wid-edit.el --- Functions for creating and using widgets -*-byte-compile-dynamic: t;-*-
 ;;
-;; Copyright (C) 1996, 1997, 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97,1999,2000,01,02,2003, 2004, 2005  Free Software Foundation, Inc.
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Maintainer: FSF
@@ -63,9 +63,6 @@
   "Character position of the end of event if that exists, or nil."
   (posn-point (event-end event)))
 
-(autoload 'pp-to-string "pp")
-(autoload 'Info-goto-node "info")
-
 (defun widget-button-release-event-p (event)
   "Non-nil if EVENT is a mouse-button-release event object."
   (and (eventp event)
@@ -92,55 +89,72 @@
   :group 'widgets
   :group 'faces)
 
-(defvar widget-documentation-face 'widget-documentation-face
+(defvar widget-documentation-face 'widget-documentation
   "Face used for documentation strings in widgets.
 This exists as a variable so it can be set locally in certain buffers.")
 
-(defface widget-documentation-face '((((class color)
-				       (background dark))
-				      (:foreground "lime green"))
-				     (((class color)
-				       (background light))
-				      (:foreground "dark green"))
-				     (t nil))
+(defface widget-documentation '((((class color)
+				  (background dark))
+				 (:foreground "lime green"))
+				(((class color)
+				  (background light))
+				 (:foreground "dark green"))
+				(t nil))
   "Face used for documentation text."
   :group 'widget-documentation
   :group 'widget-faces)
+;; backward compatibility alias
+(put 'widget-documentation-face 'face-alias 'widget-documentation)
 
-(defvar widget-button-face 'widget-button-face
+(defvar widget-button-face 'widget-button
   "Face used for buttons in widgets.
 This exists as a variable so it can be set locally in certain buffers.")
 
-(defface widget-button-face '((t (:bold t)))
+(defface widget-button '((t (:weight bold)))
   "Face used for widget buttons."
   :group 'widget-faces)
+;; backward compatibility alias
+(put 'widget-button-face 'face-alias 'widget-button)
 
 (defcustom widget-mouse-face 'highlight
   "Face used for widget buttons when the mouse is above them."
   :type 'face
   :group 'widget-faces)
 
-(defface widget-field-face '((((class grayscale color)
-			       (background light))
-			      (:background "gray85"))
-			     (((class grayscale color)
-			       (background dark))
-			      (:background "dim gray"))
-			     (t
-			      (:italic t)))
+;; TTY gets special definitions here and in the next defface, because
+;; the gray colors defined for other displays cause black text on a black
+;; background, at least on light-background TTYs.
+(defface widget-field '((((type tty))
+			 :background "yellow3"
+			 :foreground "black")
+			(((class grayscale color)
+			  (background light))
+			 :background "gray85")
+			(((class grayscale color)
+			  (background dark))
+			 :background "dim gray")
+			(t
+			 :slant italic))
   "Face used for editable fields."
   :group 'widget-faces)
-
-(defface widget-single-line-field-face '((((class grayscale color)
-					   (background light))
-					  (:background "gray85"))
-					 (((class grayscale color)
-					   (background dark))
-					  (:background "dim gray"))
-					 (t
-					  (:italic t)))
+;; backward-compatibility alias
+(put 'widget-field-face 'face-alias 'widget-field)
+
+(defface widget-single-line-field '((((type tty))
+				     :background "green3"
+				     :foreground "black")
+				    (((class grayscale color)
+				      (background light))
+				     :background "gray85")
+				    (((class grayscale color)
+				      (background dark))
+				     :background "dim gray")
+				    (t
+				     :slant italic))
   "Face used for editable fields spanning only a single line."
   :group 'widget-faces)
+;; backward-compatibility alias
+(put 'widget-single-line-field-face 'face-alias 'widget-single-line-field)
 
 ;;; This causes display-table to be loaded, and not usefully.
 ;;;(defvar widget-single-line-display-table
@@ -193,7 +207,7 @@ nil means read a single character."
   "Choose an item from a list.
 
 First argument TITLE is the name of the list.
-Second argument ITEMS is an list whose members are either
+Second argument ITEMS is a list whose members are either
  (NAME . VALUE), to indicate selectable items, or just strings to
  indicate unselectable items.
 Optional third argument EVENT is an input event.
@@ -204,7 +218,7 @@ mouse event, and the number of elements in items is less than
 `widget-menu-max-size', a popup menu will be used, otherwise the
 minibuffer."
   (cond ((and (< (length items) widget-menu-max-size)
-	      event (display-mouse-p))
+	      event (display-popup-menus-p))
 	 ;; Mouse click.
 	 (x-popup-menu event
 		       (list title (cons "" items))))
@@ -227,8 +241,7 @@ minibuffer."
 	   ;; Define SPC as a prefix char to get to this menu.
 	   (define-key overriding-terminal-local-map " "
 	     (setq map (make-sparse-keymap title)))
-	   (save-excursion
-	     (set-buffer (get-buffer-create " widget-choose"))
+	   (with-current-buffer (get-buffer-create " widget-choose")
 	     (erase-buffer)
 	     (insert "Available choices:\n\n")
 	     (while items
@@ -262,7 +275,7 @@ minibuffer."
 		 (while (not (or (and (>= char ?0) (< char next-digit))
 				 (eq value 'keyboard-quit)))
 		   ;; Unread a SPC to lead to our new menu.
-		   (setq unread-command-events (cons ?\ unread-command-events))
+		   (setq unread-command-events (cons ?\  unread-command-events))
 		   (setq keys (read-key-sequence title))
 		   (setq value
 			 (lookup-key overriding-terminal-local-map keys t)
@@ -292,10 +305,11 @@ minibuffer."
     (nreverse result)))
 
 ;;; Widget text specifications.
-;; 
+;;
 ;; These functions are for specifying text properties.
 
-(defvar widget-field-add-space t
+;; We can set it to nil now that get_local_map uses get_pos_property.
+(defconst widget-field-add-space nil
   "Non-nil means add extra space at the end of editable text fields.
 If you don't add the space, it will become impossible to edit a zero
 size field.")
@@ -319,12 +333,13 @@ new value.")
 	   (insert-and-inherit " ")))
     (setq to (point)))
   (let ((keymap (widget-get widget :keymap))
-	(face (or (widget-get widget :value-face) 'widget-field-face))
+	(face (or (widget-get widget :value-face) 'widget-field))
 	(help-echo (widget-get widget :help-echo))
+	(follow-link (widget-get widget :follow-link))
 	(rear-sticky
 	 (or (not widget-field-add-space) (widget-get widget :size))))
     (if (functionp help-echo)
-      (setq help-echo 'widget-mouse-help))    
+      (setq help-echo 'widget-mouse-help))
     (when (= (char-before to) ?\n)
       ;; When the last character in the field is a newline, we want to
       ;; give it a `field' char-property of `boundary', which helps the
@@ -333,10 +348,13 @@ new value.")
       ;; one character.
       (let ((overlay (make-overlay (1- to) to nil t nil)))
 	(overlay-put overlay 'field 'boundary)
+        ;; We need the real field for tabbing.
+	(overlay-put overlay 'real-field widget)
 	;; Use `local-map' here, not `keymap', so that normal editing
 	;; works in the field when, say, Custom uses `suppress-keymap'.
 	(overlay-put overlay 'local-map keymap)
 	(overlay-put overlay 'face face)
+	(overlay-put overlay 'follow-link follow-link)
 	(overlay-put overlay 'help-echo help-echo))
       (setq to (1- to))
       (setq rear-sticky t))
@@ -346,6 +364,7 @@ new value.")
       (overlay-put overlay 'field widget)
       (overlay-put overlay 'local-map keymap)
       (overlay-put overlay 'face face)
+      (overlay-put overlay 'follow-link follow-link)
       (overlay-put overlay 'help-echo help-echo)))
   (widget-specify-secret widget))
 
@@ -370,16 +389,23 @@ new value.")
 (defun widget-specify-button (widget from to)
   "Specify button for WIDGET between FROM and TO."
   (let ((overlay (make-overlay from to nil t nil))
+	(follow-link (widget-get widget :follow-link))
 	(help-echo (widget-get widget :help-echo)))
     (widget-put widget :button-overlay overlay)
     (if (functionp help-echo)
       (setq help-echo 'widget-mouse-help))
     (overlay-put overlay 'button widget)
     (overlay-put overlay 'keymap (widget-get widget :keymap))
+    (overlay-put overlay 'evaporate t)
     ;; We want to avoid the face with image buttons.
     (unless (widget-get widget :suppress-face)
       (overlay-put overlay 'face (widget-apply widget :button-face-get))
-      (overlay-put overlay 'mouse-face widget-mouse-face))
+      ; Text terminals cannot change mouse pointer shape, so use mouse
+      ; face instead.
+      (or (display-graphic-p)
+	  (overlay-put overlay 'mouse-face widget-mouse-face)))
+    (overlay-put overlay 'pointer 'hand)
+    (overlay-put overlay 'follow-link follow-link)
     (overlay-put overlay 'help-echo help-echo)))
 
 (defun widget-mouse-help (window overlay point)
@@ -395,6 +421,7 @@ new value.")
   "Specify sample for WIDGET between FROM and TO."
   (let ((overlay (make-overlay from to nil t nil)))
     (overlay-put overlay 'face (widget-apply widget :sample-face-get))
+    (overlay-put overlay 'evaporate t)
     (widget-put widget :sample-overlay overlay)))
 
 (defun widget-specify-doc (widget from to)
@@ -402,41 +429,38 @@ new value.")
   (let ((overlay (make-overlay from to nil t nil)))
     (overlay-put overlay 'widget-doc widget)
     (overlay-put overlay 'face widget-documentation-face)
+    (overlay-put overlay 'evaporate t)
     (widget-put widget :doc-overlay overlay)))
 
 (defmacro widget-specify-insert (&rest form)
   "Execute FORM without inheriting any text properties."
   `(save-restriction
     (let ((inhibit-read-only t)
-	  (inhibit-modification-hooks t)
-	  result)
-      (insert "<>")
-      (narrow-to-region (- (point) 2) (point))
-      (goto-char (1+ (point-min)))
-      (setq result (progn ,@form))
-      (delete-region (point-min) (1+ (point-min)))
-      (delete-region (1- (point-max)) (point-max))
-      (goto-char (point-max))
-      result)))
-
-(defface widget-inactive-face '((((class grayscale color)
-				  (background dark))
-				 (:foreground "light gray"))
-				(((class grayscale color)
-				  (background light))
-				 (:foreground "dim gray"))
-				(t
-				 (:italic t)))
+	  (inhibit-modification-hooks t))
+      (narrow-to-region (point) (point))
+      (prog1 (progn ,@form)
+	(goto-char (point-max))))))
+
+(defface widget-inactive '((((class grayscale color)
+			     (background dark))
+			    (:foreground "light gray"))
+			   (((class grayscale color)
+			     (background light))
+			    (:foreground "dim gray"))
+			   (t
+			    (:slant italic)))
   "Face used for inactive widgets."
   :group 'widget-faces)
+;; backward-compatibility alias
+(put 'widget-inactive-face 'face-alias 'widget-inactive)
 
 (defun widget-specify-inactive (widget from to)
   "Make WIDGET inactive for user modifications."
   (unless (widget-get widget :inactive)
     (let ((overlay (make-overlay from to nil t nil)))
-      (overlay-put overlay 'face 'widget-inactive-face)
+      (overlay-put overlay 'face 'widget-inactive)
       ;; This is disabled, as it makes the mouse cursor change shape.
-      ;; (overlay-put overlay 'mouse-face 'widget-inactive-face)
+      ;; (overlay-put overlay 'mouse-face 'widget-inactive)
       (overlay-put overlay 'evaporate t)
       (overlay-put overlay 'priority 100)
       (overlay-put overlay 'modification-hooks '(widget-overlay-inactive))
@@ -461,6 +485,15 @@ new value.")
   "Return the type of WIDGET, a symbol."
   (car widget))
 
+;;;###autoload
+(defun widgetp (widget)
+  "Return non-nil iff WIDGET is a widget."
+  (if (symbolp widget)
+      (get widget 'widget-type)
+    (and (consp widget)
+	 (symbolp (car widget))
+	 (get (car widget) 'widget-type))))
+
 (defun widget-get-indirect (widget property)
   "In WIDGET, get the value of PROPERTY.
 If the value is a symbol, return its binding.
@@ -490,9 +523,10 @@ Otherwise, just return the value."
 					 :value-to-internal value)))
 
 (defun widget-default-get (widget)
-  "Extract the default value of WIDGET."
-  (or (widget-get widget :value)
-      (widget-apply widget :default-get)))
+  "Extract the default external value of WIDGET."
+  (widget-apply widget :value-to-external
+		(or (widget-get widget :value)
+		    (widget-apply widget :default-get))))
 
 (defun widget-match-inline (widget vals)
   "In WIDGET, match the start of VALS."
@@ -549,9 +583,8 @@ The arguments MAPARG, and BUFFER default to nil and (current-buffer),
 respectively."
   (let ((cur (point-min))
 	(widget nil)
-	(parent nil)
 	(overlays (if buffer
-		      (save-excursion (set-buffer buffer) (overlay-lists))
+		      (with-current-buffer buffer (overlay-lists))
 		    (overlay-lists))))
     (setq overlays (append (car overlays) (cdr overlays)))
     (while (setq cur (pop overlays))
@@ -610,7 +643,7 @@ extension (xpm, xbm, gif, jpg, or png) located in
 	 ;; Oh well.
 	 nil)))
 
-(defvar widget-button-pressed-face 'widget-button-pressed-face
+(defvar widget-button-pressed-face 'widget-button-pressed
   "Face used for pressed buttons in widgets.
 This exists as a variable so it can be set locally in certain
 buffers.")
@@ -670,7 +703,7 @@ The child is converted, using the keyword arguments ARGS."
 
 (defun widget-create-child (parent type)
   "Create widget of TYPE."
-  (let ((widget (copy-sequence type)))
+  (let ((widget (widget-copy type)))
     (widget-put widget :parent parent)
     (unless (widget-get widget :indent)
       (widget-put widget :indent (+ (or (widget-get parent :indent) 0)
@@ -681,7 +714,7 @@ The child is converted, using the keyword arguments ARGS."
 
 (defun widget-create-child-value (parent type value)
   "Create widget of TYPE with value VALUE."
-  (let ((widget (copy-sequence type)))
+  (let ((widget (widget-copy type)))
     (widget-put widget :value (widget-apply widget :value-to-internal value))
     (widget-put widget :parent parent)
     (unless (widget-get widget :indent)
@@ -696,6 +729,10 @@ The child is converted, using the keyword arguments ARGS."
   "Delete WIDGET."
   (widget-apply widget :delete))
 
+(defun widget-copy (widget)
+  "Make a deep copy of WIDGET."
+  (widget-apply (copy-sequence widget) :copy))
+
 (defun widget-convert (type &rest args)
   "Convert TYPE to a widget without inserting it in the buffer.
 The optional ARGS are additional keyword arguments."
@@ -704,18 +741,32 @@ The optional ARGS are additional keyword arguments."
 		     (list type)
 		   (copy-sequence type)))
 	 (current widget)
+	 done
 	 (keys args))
     ;; First set the :args keyword.
     (while (cdr current)		;Look in the type.
-      (if (keywordp (car (cdr current)))
-	  (setq current (cdr (cdr current)))
+      (if (and (keywordp (cadr current))
+	       ;; If the last element is a keyword,
+	       ;; it is still the :args element,
+	       ;; even though it is a keyword.
+	       (cddr current))
+	  (if (eq (cadr current) :args)
+	      ;; If :args is explicitly specified, obey it.
+	      (setq current nil)
+	    ;; Some other irrelevant keyword.
+	    (setq current (cdr (cdr current))))
 	(setcdr current (list :args (cdr current)))
 	(setq current nil)))
-    (while args				;Look in the args.
-      (if (keywordp (nth 0 args))
-	  (setq args (nthcdr 2 args))
-	(widget-put widget :args args)
-	(setq args nil)))
+    (while (and args (not done))	;Look in ARGS.
+      (cond ((eq (car args) :args)
+	     ;; Handle explicit specification of :args.
+	     (setq args (cadr args)
+		   done t))
+	    ((keywordp (car args))
+	     (setq args (cddr args)))
+	    (t (setq done t))))
+    (when done
+      (widget-put widget :args args))
     ;; Then Convert the widget.
     (setq type widget)
     (while type
@@ -740,6 +791,7 @@ The optional ARGS are additional keyword arguments."
     ;; Return the newly create widget.
     widget))
 
+;;;###autoload
 (defun widget-insert (&rest args)
   "Call `insert' with ARGS even if surrounding text is read only."
   (let ((inhibit-read-only t)
@@ -794,6 +846,7 @@ button end points."
 
 ;;; Keymap and Commands.
 
+;;;###autoload
 (defvar widget-keymap
   (let ((map (make-sparse-keymap)))
     (define-key map "\t" 'widget-forward)
@@ -839,28 +892,43 @@ Recommended as a parent keymap for modes using widgets.")
       (call-interactively
        (lookup-key widget-global-map (this-command-keys))))))
 
-(defface widget-button-pressed-face
-  '((((class color))
+(defface widget-button-pressed
+  '((((min-colors 88) (class color))
+     (:foreground "red1"))
+    (((class color))
      (:foreground "red"))
     (t
-     (:bold t :underline t)))
+     (:weight bold :underline t)))
   "Face used for pressed buttons."
   :group 'widget-faces)
+;; backward-compatibility alias
+(put 'widget-button-pressed-face 'face-alias 'widget-button-pressed)
 
 (defun widget-button-click (event)
   "Invoke the button that the mouse is pointing at."
-  (interactive "@e")
+  (interactive "e")
   (if (widget-event-point event)
-      (save-excursion
-	(mouse-set-point event)
-	(let* ((pos (widget-event-point event))
-	       (button (get-char-property pos 'button)))
-	  (if button
-	      (let* ((overlay (widget-get button :button-overlay))
-		     (face (overlay-get overlay 'face))
-		     (mouse-face (overlay-get overlay 'mouse-face)))
-		(unwind-protect
-		    (let ((track-mouse t))
+      (let* ((pos (widget-event-point event))
+	     (start (event-start event))
+	     (button (get-char-property
+		      pos 'button (and (windowp (posn-window start))
+				       (window-buffer (posn-window start))))))
+	(if button
+	    ;; Mouse click on a widget button.  Do the following
+	    ;; in a save-excursion so that the click on the button
+	    ;; doesn't change point.
+	    (save-selected-window
+	      (select-window (posn-window (event-start event)))
+	      (save-excursion
+		(goto-char (posn-point (event-start event)))
+		(let* ((overlay (widget-get button :button-overlay))
+		       (face (overlay-get overlay 'face))
+		       (mouse-face (overlay-get overlay 'mouse-face)))
+		  (unwind-protect
+		      ;; Read events, including mouse-movement events
+		      ;; until we receive a release event.  Highlight/
+		      ;; unhighlight the button the mouse was initially
+		      ;; on when we move over it.
 		      (save-excursion
 			(when face	; avoid changing around image
 			  (overlay-put overlay
@@ -868,30 +936,42 @@ Recommended as a parent keymap for modes using widgets.")
 			  (overlay-put overlay
 				       'mouse-face widget-button-pressed-face))
 			(unless (widget-apply button :mouse-down-action event)
-			  (while (not (widget-button-release-event-p event))
-			    (setq event (read-event)
-				  pos (widget-event-point event))
-			    (if (and pos
-				     (eq (get-char-property pos 'button)
-					 button))
-				(when face
-				  (overlay-put overlay
-					       'face
-					       widget-button-pressed-face)
-				  (overlay-put overlay
-					       'mouse-face
-					       widget-button-pressed-face))
-			      (overlay-put overlay 'face face)
-			      (overlay-put overlay 'mouse-face mouse-face))))
+			  (let ((track-mouse t))
+			    (while (not (widget-button-release-event-p event))
+			      (setq event (read-event)
+				    pos (widget-event-point event))
+			      (if (and pos
+				       (eq (get-char-property pos 'button)
+					   button))
+				  (when face
+				    (overlay-put overlay
+						 'face
+						 widget-button-pressed-face)
+				    (overlay-put overlay
+						 'mouse-face
+						 widget-button-pressed-face))
+				(overlay-put overlay 'face face)
+				(overlay-put overlay 'mouse-face mouse-face)))))
+
+			;; When mouse is released over the button, run
+			;; its action function.
 			(when (and pos
 				   (eq (get-char-property pos 'button) button))
-			  (widget-apply-action button event))))
-		  (overlay-put overlay 'face face)
-		  (overlay-put overlay 'mouse-face mouse-face)))
-	    (let ((up t)
-		  command)
-	      ;; Find the global command to run, and check whether it
-	      ;; is bound to an up event.
+			  (widget-apply-action button event)))
+		    (overlay-put overlay 'face face)
+		    (overlay-put overlay 'mouse-face mouse-face))))
+
+	      (unless (pos-visible-in-window-p (widget-event-point event))
+		(mouse-set-point event)
+		(beginning-of-line)
+		(recenter))
+	      )
+
+	    (let ((up t) command)
+	      ;; Mouse click not on a widget button.  Find the global
+	      ;; command to run, and check whether it is bound to an
+	      ;; up event.
+	      (mouse-set-point event)
 	      (if (memq (event-basic-type event) '(mouse-1 down-mouse-1))
 		  (cond ((setq command	;down event
 			       (lookup-key widget-global-map [down-mouse-1]))
@@ -909,10 +989,6 @@ Recommended as a parent keymap for modes using widgets.")
 		  (setq event (read-event))))
 	      (when command
 		(call-interactively command)))))
-	  (unless (pos-visible-in-window-p (widget-event-point event))
-	    (mouse-set-point event)
-	    (beginning-of-line)
-	    (recenter)))
     (message "You clicked somewhere weird.")))
 
 (defun widget-button-press (pos &optional event)
@@ -944,19 +1020,19 @@ This is much faster, but doesn't work reliably on Emacs 19.34.")
   "Move point to the ARG next field or button.
 ARG may be negative to move backward."
   (or (bobp) (> arg 0) (backward-char))
-  (let ((pos (point))
+  (let ((wrapped 0)
 	(number arg)
-	(old (widget-tabable-at))
-	new)
+	(old (widget-tabable-at)))
     ;; Forward.
     (while (> arg 0)
       (cond ((eobp)
-	     (goto-char (point-min)))
+	     (goto-char (point-min))
+	     (setq wrapped (1+ wrapped)))
 	    (widget-use-overlay-change
 	     (goto-char (next-overlay-change (point))))
 	    (t
 	     (forward-char 1)))
-      (and (eq pos (point))
+      (and (= wrapped 2)
 	   (eq arg number)
 	   (error "No buttons or fields found"))
       (let ((new (widget-tabable-at)))
@@ -967,12 +1043,13 @@ ARG may be negative to move backward."
     ;; Backward.
     (while (< arg 0)
       (cond ((bobp)
-	     (goto-char (point-max)))
+	     (goto-char (point-max))
+	     (setq wrapped (1+ wrapped)))
 	    (widget-use-overlay-change
 	     (goto-char (previous-overlay-change (point))))
 	    (t
 	     (backward-char 1)))
-      (and (eq pos (point))
+      (and (= wrapped 2)
 	   (eq arg number)
 	   (error "No buttons or fields found"))
       (let ((new (widget-tabable-at)))
@@ -1033,23 +1110,32 @@ the field."
   :type 'function
   :group 'widgets)
 
+(defun widget-narrow-to-field ()
+  "Narrow to field"
+  (interactive)
+  (let ((field (widget-field-find (point))))
+    (if field
+	(narrow-to-region (line-beginning-position) (line-end-position)))))
+
 (defun widget-complete ()
   "Complete content of editable field from point.
 When not inside a field, move to the previous button or field."
   (interactive)
   (let ((field (widget-field-find (point))))
     (if field
-	(widget-apply field :complete)
-      (error "Not in an editable field"))))
+	(save-restriction
+	  (widget-narrow-to-field)
+	  (widget-apply field :complete))
+	  (error "Not in an editable field"))))
 
 ;;; Setting up the buffer.
 
-(defvar widget-field-new nil)
-;; List of all newly created editable fields in the buffer.
+(defvar widget-field-new nil
+  "List of all newly created editable fields in the buffer.")
 (make-variable-buffer-local 'widget-field-new)
 
-(defvar widget-field-list nil)
-;; List of all editable fields in the buffer.
+(defvar widget-field-list nil
+  "List of all editable fields in the buffer.")
 (make-variable-buffer-local 'widget-field-list)
 
 (defun widget-at (&optional pos)
@@ -1057,6 +1143,7 @@ When not inside a field, move to the previous button or field."
   (or (get-char-property (or pos (point)) 'button)
       (widget-field-at pos)))
 
+;;;###autoload
 (defun widget-setup ()
   "Setup current buffer so editing string widgets works."
   (let ((inhibit-read-only t)
@@ -1087,11 +1174,11 @@ When not inside a field, move to the previous button or field."
   "Return the widget field at POS, or nil if none."
   (let ((field (get-char-property (or pos (point)) 'field)))
     (if (eq field 'boundary)
-	nil
+	(get-char-property (or pos (point)) 'real-field)
       field)))
 
 (defun widget-field-buffer (widget)
-  "Return the start of WIDGET's editing field."
+  "Return the buffer of WIDGET's editing field."
   (let ((overlay (widget-get widget :field-overlay)))
     (cond ((overlayp overlay)
 	   (overlay-buffer overlay))
@@ -1112,9 +1199,17 @@ When not inside a field, move to the previous button or field."
     ;; or if a special `boundary' field has been added after the widget
     ;; field.
     (if (overlayp overlay)
-	(if (and (not (eq (get-char-property (overlay-end overlay)
-					     'field
-					     (widget-field-buffer widget))
+	(if (and (not (eq (with-current-buffer
+			      (widget-field-buffer widget)
+			    (save-restriction
+			      ;; `widget-narrow-to-field' can be
+			      ;; active when this function is called
+			      ;; from an change-functions hook. So
+			      ;; temporarily remove field narrowing
+			      ;; before to call `get-char-property'.
+			      (widen)
+			      (get-char-property (overlay-end overlay)
+						 'field)))
 			  'boundary))
 		 (or widget-field-add-space
 		     (null (widget-get widget :size))))
@@ -1217,6 +1312,47 @@ Optional EVENT is the event that triggered the action."
 	    found (widget-apply child :validate)))
     found))
 
+(defun widget-child-value-get (widget)
+  "Get the value of the first member of :children in WIDGET."
+  (widget-value (car (widget-get widget :children))))
+
+(defun widget-child-value-inline (widget)
+  "Get the inline value of the first member of :children in WIDGET."
+  (widget-apply (car (widget-get widget :children)) :value-inline))
+
+(defun widget-child-validate (widget)
+  "The result of validating the first member of :children in WIDGET."
+  (widget-apply (car (widget-get widget :children)) :validate))
+
+(defun widget-type-value-create (widget)
+  "Convert and instantiate the value of the :type attribute of WIDGET.
+Store the newly created widget in the :children attribute.
+
+The value of the :type attribute should be an unconverted widget type."
+  (let ((value (widget-get widget :value))
+	(type (widget-get widget :type)))
+    (widget-put widget :children
+                (list (widget-create-child-value widget
+                                                 (widget-convert type)
+                                                 value)))))
+
+(defun widget-type-default-get (widget)
+  "Get default value from the :type attribute of WIDGET.
+
+The value of the :type attribute should be an unconverted widget type."
+  (widget-default-get (widget-convert (widget-get widget :type))))
+
+(defun widget-type-match (widget value)
+  "Non-nil if the :type value of WIDGET matches VALUE.
+
+The value of the :type attribute should be an unconverted widget type."
+  (widget-apply (widget-convert (widget-get widget :type)) :match value))
+
+(defun widget-types-copy (widget)
+  "Copy :args as widget types in WIDGET."
+  (widget-put widget :args (mapcar 'widget-copy (widget-get widget :args)))
+  widget)
+
 ;; Made defsubst to speed up face editor creation.
 (defsubst widget-types-convert-widget (widget)
   "Convert :args as widget types in WIDGET."
@@ -1251,11 +1387,13 @@ Optional EVENT is the event that triggered the action."
   :indent nil
   :offset 0
   :format-handler 'widget-default-format-handler
-  :button-face-get 'widget-default-button-face-get 
-  :sample-face-get 'widget-default-sample-face-get 
+  :button-face-get 'widget-default-button-face-get
+  :sample-face-get 'widget-default-sample-face-get
   :delete 'widget-default-delete
+  :copy 'identity
   :value-set 'widget-default-value-set
   :value-inline 'widget-default-value-inline
+  :value-delete 'ignore
   :default-get 'widget-default-default-get
   :menu-tag-get 'widget-default-menu-tag-get
   :validate #'ignore
@@ -1409,6 +1547,7 @@ If that does not exists, call the value of `widget-complete-field'."
 	(inhibit-modification-hooks t)
 	(inhibit-read-only t))
     (widget-apply widget :value-delete)
+    (widget-children-value-delete widget)
     (when inactive-overlay
       (delete-overlay inactive-overlay))
     (when button-overlay
@@ -1467,7 +1606,7 @@ If that does not exists, call the value of `widget-complete-field'."
   (or (widget-get widget :always-active)
       (and (not (widget-get widget :inactive))
 	   (let ((parent (widget-get widget :parent)))
-	     (or (null parent) 
+	     (or (null parent)
 		 (widget-apply parent :active))))))
 
 (defun widget-default-deactivate (widget)
@@ -1597,6 +1736,7 @@ If END is omitted, it defaults to the length of LIST."
   "An embedded link."
   :button-prefix 'widget-link-prefix
   :button-suffix 'widget-link-suffix
+  :follow-link "\C-m"
   :help-echo "Follow the link."
   :format "%[%t%]")
 
@@ -1608,7 +1748,7 @@ If END is omitted, it defaults to the length of LIST."
 
 (defun widget-info-link-action (widget &optional event)
   "Open the info node specified by WIDGET."
-  (Info-goto-node (widget-value widget)))
+  (info (widget-value widget)))
 
 ;;; The `url-link' Widget.
 
@@ -1661,11 +1801,11 @@ If END is omitted, it defaults to the length of LIST."
   (find-file (locate-library (widget-value widget))))
 
 ;;; The `emacs-commentary-link' Widget.
-    
+
 (define-widget 'emacs-commentary-link 'link
   "A link to Commentary in an Emacs Lisp library file."
   :action 'widget-emacs-commentary-link-action)
-    
+
 (defun widget-emacs-commentary-link-action (widget &optional event)
   "Find the Commentary section of the Emacs file specified by WIDGET."
   (finder-commentary (widget-value widget)))
@@ -1791,22 +1931,22 @@ the earlier input."
 ;;; The `text' Widget.
 
 (define-widget 'text 'editable-field
-  :keymap widget-text-keymap
-  "A multiline text area.")
+  "A multiline text area."
+  :keymap widget-text-keymap)
 
 ;;; The `menu-choice' Widget.
 
 (define-widget 'menu-choice 'default
   "A menu of options."
   :convert-widget  'widget-types-convert-widget
+  :copy 'widget-types-copy
   :format "%[%t%]: %v"
   :case-fold t
   :tag "choice"
   :void '(item :format "invalid (%t)\n")
   :value-create 'widget-choice-value-create
-  :value-delete 'widget-children-value-delete
-  :value-get 'widget-choice-value-get
-  :value-inline 'widget-choice-value-inline
+  :value-get 'widget-child-value-get
+  :value-inline 'widget-child-value-inline
   :default-get 'widget-choice-default-get
   :mouse-down-action 'widget-choice-mouse-down-action
   :action 'widget-choice-action
@@ -1843,14 +1983,6 @@ the earlier input."
 					      widget void :value value)))
 	  (widget-put widget :choice void))))))
 
-(defun widget-choice-value-get (widget)
-  ;; Get value of the child widget.
-  (widget-value (car (widget-get widget :children))))
-
-(defun widget-choice-value-inline (widget)
-  ;; Get value of the child widget.
-  (widget-apply (car (widget-get widget :children)) :value-inline))
-
 (defun widget-choice-default-get (widget)
   ;; Get default for the first choice.
   (widget-default-get (car (widget-get widget :args))))
@@ -1928,9 +2060,7 @@ when he invoked the menu."
       (when this-explicit
 	(widget-put widget :explicit-choice current)
 	(widget-put widget :explicit-choice-value (widget-get widget :value)))
-      (widget-value-set
-       widget (widget-apply current
-			    :value-to-external (widget-default-get current)))
+      (widget-value-set widget (widget-default-get current))
       (widget-setup)
       (widget-apply widget :notify widget event)))
   (run-hook-with-args 'widget-edit-functions widget))
@@ -1975,12 +2105,20 @@ when he invoked the menu."
 (defun widget-toggle-value-create (widget)
   "Insert text representing the `on' and `off' states."
   (if (widget-value widget)
-      (widget-image-insert widget
-			   (widget-get widget :on)
-			   (widget-get widget :on-glyph))
-    (widget-image-insert widget
-			 (widget-get widget :off)
-			 (widget-get widget :off-glyph))))
+      (let ((image (widget-get widget :on-glyph)))
+	(and (display-graphic-p)
+	     (listp image)
+	     (not (eq (car image) 'image))
+	     (widget-put widget :on-glyph (setq image (eval image))))
+	(widget-image-insert widget
+			     (widget-get widget :on)
+			     image))
+    (let ((image (widget-get widget :off-glyph)))
+      (and (display-graphic-p)
+	   (listp image)
+	   (not (eq (car image) 'image))
+	   (widget-put widget :off-glyph (setq image (eval image))))
+      (widget-image-insert widget (widget-get widget :off) image))))
 
 (defun widget-toggle-action (widget &optional event)
   ;; Toggle value.
@@ -1999,18 +2137,19 @@ when he invoked the menu."
   ;; We could probably do the same job as the images using single
   ;; space characters in a boxed face with a stretch specification to
   ;; make them square.
-  :on-glyph (create-image "\377\311\301\343\301\311\377"  ; this is an `X'
-			  'xbm t :width 7 :height 7
-			  :foreground "grey75" ; like default mode line
-			  :background "black"
-			  :relief -3
-			  :ascent 'center)
-  :off "[ ]"
-  :off-glyph (create-image (make-bool-vector 49 1)
-			   'xbm t :width 7 :height 7
-			   :foreground "grey75"
-			   :relief 3
+  :on-glyph '(create-image "\300\300\141\143\067\076\034\030"
+			   'xbm t :width 8 :height 8
+			   :background "grey75"	; like default mode line
+			   :foreground "black"
+			   :relief -2
 			   :ascent 'center)
+  :off "[ ]"
+  :off-glyph '(create-image (make-string 8 0)
+			    'xbm t :width 8 :height 8
+			    :background "grey75"
+			    :foreground "black"
+			    :relief -2
+			    :ascent 'center)
   :help-echo "Toggle this item."
   :action 'widget-checkbox-action)
 
@@ -2028,13 +2167,12 @@ when he invoked the menu."
 (define-widget 'checklist 'default
   "A multiple choice widget."
   :convert-widget 'widget-types-convert-widget
+  :copy 'widget-types-copy
   :format "%v"
   :offset 4
   :entry-format "%b %v"
-  :menu-tag "checklist"
   :greedy nil
   :value-create 'widget-checklist-value-create
-  :value-delete 'widget-children-value-delete
   :value-get 'widget-checklist-value-get
   :validate 'widget-checklist-validate
   :match 'widget-checklist-match
@@ -2206,12 +2344,11 @@ Return an alist of (TYPE MATCH)."
 (define-widget 'radio-button-choice 'default
   "Select one of multiple options."
   :convert-widget 'widget-types-convert-widget
+  :copy 'widget-types-copy
   :offset 4
   :format "%v"
   :entry-format "%b %v"
-  :menu-tag "radio"
   :value-create 'widget-radio-value-create
-  :value-delete 'widget-children-value-delete
   :value-get 'widget-radio-value-get
   :value-inline 'widget-radio-value-inline
   :value-set 'widget-radio-value-set
@@ -2395,13 +2532,12 @@ Return an alist of (TYPE MATCH)."
 (define-widget 'editable-list 'default
   "A variable list of widgets of the same type."
   :convert-widget 'widget-types-convert-widget
+  :copy 'widget-types-copy
   :offset 12
   :format "%v%i\n"
   :format-handler 'widget-editable-list-format-handler
   :entry-format "%i %d %v"
-  :menu-tag "editable-list"
   :value-create 'widget-editable-list-value-create
-  :value-delete 'widget-children-value-delete
   :value-get 'widget-editable-list-value-get
   :validate 'widget-children-validate
   :match 'widget-editable-list-match
@@ -2411,7 +2547,7 @@ Return an alist of (TYPE MATCH)."
 
 (defun widget-editable-list-format-handler (widget escape)
   ;; We recognize the insert button.
-;;;   (let ((widget-push-button-gui widget-editable-list-gui))
+    ;; (let ((widget-push-button-gui widget-editable-list-gui))
     (cond ((eq escape ?i)
 	   (and (widget-get widget :indent)
 		(insert-char ?\  (widget-get widget :indent)))
@@ -2420,7 +2556,7 @@ Return an alist of (TYPE MATCH)."
 		  (widget-get widget :append-button-args)))
 	  (t
 	   (widget-default-format-handler widget escape)))
-;;;     )
+    ;; )
   )
 
 (defun widget-editable-list-value-create (widget)
@@ -2521,7 +2657,7 @@ Return an alist of (TYPE MATCH)."
 (defun widget-editable-list-entry-create (widget value conv)
   ;; Create a new entry to the list.
   (let ((type (nth 0 (widget-get widget :args)))
-;;; 	(widget-push-button-gui widget-editable-list-gui)
+	;; (widget-push-button-gui widget-editable-list-gui)
 	child delete insert)
     (widget-specify-insert
      (save-excursion
@@ -2547,23 +2683,21 @@ Return an alist of (TYPE MATCH)."
 		    (setq child (widget-create-child-value
 				 widget type value))
 		  (setq child (widget-create-child-value
-			       widget type
-			       (widget-apply type :value-to-external
-					     (widget-default-get type))))))
+			       widget type (widget-default-get type)))))
 	       (t
 		(error "Unknown escape `%c'" escape)))))
-     (widget-put widget
-		 :buttons (cons delete
-				(cons insert
-				      (widget-get widget :buttons))))
+     (let ((buttons (widget-get widget :buttons)))
+       (if insert (push insert buttons))
+       (if delete (push delete buttons))
+       (widget-put widget :buttons buttons))
      (let ((entry-from (point-min-marker))
 	   (entry-to (point-max-marker)))
        (set-marker-insertion-type entry-from t)
        (set-marker-insertion-type entry-to nil)
        (widget-put child :entry-from entry-from)
        (widget-put child :entry-to entry-to)))
-    (widget-put insert :widget child)
-    (widget-put delete :widget child)
+    (if insert (widget-put insert :widget child))
+    (if delete (widget-put delete :widget child))
     child))
 
 ;;; The `group' Widget.
@@ -2571,9 +2705,9 @@ Return an alist of (TYPE MATCH)."
 (define-widget 'group 'default
   "A widget which groups other widgets inside."
   :convert-widget 'widget-types-convert-widget
+  :copy 'widget-types-copy
   :format "%v"
   :value-create 'widget-group-value-create
-  :value-delete 'widget-children-value-delete
   :value-get 'widget-editable-list-value-get
   :default-get 'widget-group-default-get
   :validate 'widget-children-validate
@@ -2739,7 +2873,6 @@ link for that string."
   "A documentation string."
   :format "%v"
   :action 'widget-documentation-string-action
-  :value-delete 'widget-children-value-delete
   :value-create 'widget-documentation-string-value-create)
 
 (defun widget-documentation-string-value-create (widget)
@@ -2758,6 +2891,7 @@ link for that string."
 		(widget-create-child-and-convert
 		 widget 'visibility
 		 :help-echo "Show or hide rest of the documentation."
+		 :on "Hide Rest"
 		 :off "More"
 		 :always-active t
 		 :action 'widget-parent-action
@@ -2831,7 +2965,7 @@ as the value."
   :match 'widget-regexp-match
   :validate 'widget-regexp-validate
   ;; Doesn't work well with terminating newline.
-  ;; :value-face 'widget-single-line-field-face
+  ;; :value-face 'widget-single-line-field
   :tag "Regexp")
 
 (defun widget-regexp-match (widget value)
@@ -2857,7 +2991,7 @@ It will read a file name from the minibuffer when invoked."
   :prompt-value 'widget-file-prompt-value
   :format "%{%t%}: %v"
   ;; Doesn't work well with terminating newline.
-  ;; :value-face 'widget-single-line-field-face
+  ;; :value-face 'widget-single-line-field
   :tag "File")
 
 (defun widget-file-complete ()
@@ -2910,6 +3044,7 @@ It will read a file name from the minibuffer when invoked."
 ;;;    (widget-setup)
 ;;;    (widget-apply widget :notify widget event)))
 
+;; Fixme: use file-name-as-directory.
 (define-widget 'directory 'file
   "A directory widget.
 It will read a directory name from the minibuffer when invoked."
@@ -2950,7 +3085,7 @@ It will read a directory name from the minibuffer when invoked."
 (defvar widget-function-prompt-value-history nil
   "History of input to `widget-function-prompt-value'.")
 
-(define-widget 'function 'sexp
+(define-widget 'function 'restricted-sexp
   "A Lisp function."
   :complete-function (lambda ()
 		       (interactive)
@@ -2960,6 +3095,7 @@ It will read a directory name from the minibuffer when invoked."
   :prompt-match 'fboundp
   :prompt-history 'widget-function-prompt-value-history
   :action 'widget-field-action
+  :match-alternatives '(functionp)
   :validate (lambda (widget)
 	      (unless (functionp (widget-value widget))
 		(widget-put widget :error (format "Invalid function: %S"
@@ -2972,7 +3108,6 @@ It will read a directory name from the minibuffer when invoked."
   "History of input to `widget-variable-prompt-value'.")
 
 (define-widget 'variable 'symbol
-  ;; Should complete on variables.
   "A Lisp variable."
   :prompt-match 'boundp
   :prompt-history 'widget-variable-prompt-value-history
@@ -2983,7 +3118,7 @@ It will read a directory name from the minibuffer when invoked."
 
 (defvar widget-coding-system-prompt-value-history nil
   "History of input to `widget-coding-system-prompt-value'.")
-  
+
 (define-widget 'coding-system 'symbol
   "A MULE coding-system."
   :format "%{%t%}: %v"
@@ -3061,6 +3196,8 @@ It will read a directory name from the minibuffer when invoked."
 		(setq err "Empty sexp -- use `nil'?")
 	      (unless (widget-apply widget :match (read (current-buffer)))
 		(setq err (widget-get widget :type-error))))
+	    ;; Allow whitespace after expression.
+	    (skip-syntax-forward "\\s-")
 	    (if (and (not (eobp))
 		     (not err))
 		(setq err (format "Junk at end of expression: %s"
@@ -3119,12 +3256,19 @@ To use this type, you must define :match or :match-alternatives."
   :match-alternatives '(integerp))
 
 (define-widget 'number 'restricted-sexp
-  "A floating point number."
+  "A number (floating point or integer)."
   :tag "Number"
   :value 0.0
-  :type-error "This field should contain a number"
+  :type-error "This field should contain a number (floating point or integer)"
   :match-alternatives '(numberp))
 
+(define-widget 'float 'restricted-sexp
+  "A floating point number."
+  :tag "Floating point number"
+  :value 0.0
+  :type-error "This field should contain a floating point number"
+  :match-alternatives '(floatp))
+
 (define-widget 'character 'editable-field
   "A character."
   :tag "Character"
@@ -3170,13 +3314,69 @@ To use this type, you must define :match or :match-alternatives."
   :value-to-internal (lambda (widget value)
 		       (list (car value) (cdr value)))
   :value-to-external (lambda (widget value)
-		       (cons (nth 0 value) (nth 1 value))))
+		       (apply 'cons value)))
 
 (defun widget-cons-match (widget value)
   (and (consp value)
        (widget-group-match widget
 			   (widget-apply widget :value-to-internal value))))
 
+;;; The `lazy' Widget.
+;;
+;; Recursive datatypes.
+
+(define-widget 'lazy 'default
+  "Base widget for recursive datastructures.
+
+The `lazy' widget will, when instantiated, contain a single inferior
+widget, of the widget type specified by the :type parameter.  The
+value of the `lazy' widget is the same as the value of the inferior
+widget.  When deriving a new widget from the 'lazy' widget, the :type
+parameter is allowed to refer to the widget currently being defined,
+thus allowing recursive datastructures to be described.
+
+The :type parameter takes the same arguments as the defcustom
+parameter with the same name.
+
+Most composite widgets, i.e. widgets containing other widgets, does
+not allow recursion.  That is, when you define a new widget type, none
+of the inferior widgets may be of the same type you are currently
+defining.
+
+In Lisp, however, it is custom to define datastructures in terms of
+themselves.  A list, for example, is defined as either nil, or a cons
+cell whose cdr itself is a list.  The obvious way to translate this
+into a widget type would be
+
+  (define-widget 'my-list 'choice
+    \"A list of sexps.\"
+    :tag \"Sexp list\"
+    :args '((const nil) (cons :value (nil) sexp my-list)))
+
+Here we attempt to define my-list as a choice of either the constant
+nil, or a cons-cell containing a sexp and my-lisp.  This will not work
+because the `choice' widget does not allow recursion.
+
+Using the `lazy' widget you can overcome this problem, as in this
+example:
+
+  (define-widget 'sexp-list 'lazy
+    \"A list of sexps.\"
+    :tag \"Sexp list\"
+    :type '(choice (const nil) (cons :value (nil) sexp sexp-list)))"
+  :format "%{%t%}: %v"
+  ;; We don't convert :type because we want to allow recursive
+  ;; datastructures.  This is slow, so we should not create speed
+  ;; critical widgets by deriving from this.
+  :convert-widget 'widget-value-convert-widget
+  :value-create 'widget-type-value-create
+  :value-get 'widget-child-value-get
+  :value-inline 'widget-child-value-inline
+  :default-get 'widget-type-default-get
+  :match 'widget-type-match
+  :validate 'widget-child-validate)
+
+
 ;;; The `plist' Widget.
 ;;
 ;; Property lists.
@@ -3193,10 +3393,11 @@ To use this type, you must define :match or :match-alternatives."
 (defun widget-plist-convert-widget (widget)
   ;; Handle `:options'.
   (let* ((options (widget-get widget :options))
+	 (widget-plist-value-type (widget-get widget :value-type))
 	 (other `(editable-list :inline t
 				(group :inline t
 				       ,(widget-get widget :key-type)
-				       ,(widget-get widget :value-type))))
+				       ,widget-plist-value-type)))
 	 (args (if options
 		   (list `(checklist :inline t
 				     :greedy t
@@ -3237,10 +3438,11 @@ To use this type, you must define :match or :match-alternatives."
 (defun widget-alist-convert-widget (widget)
   ;; Handle `:options'.
   (let* ((options (widget-get widget :options))
+	 (widget-alist-value-type (widget-get widget :value-type))
 	 (other `(editable-list :inline t
 				(cons :format "%v"
 				      ,(widget-get widget :key-type)
-				      ,(widget-get widget :value-type))))
+				      ,widget-alist-value-type)))
 	 (args (if options
 		   (list `(checklist :inline t
 				     :greedy t
@@ -3346,6 +3548,7 @@ To use this type, you must define :match or :match-alternatives."
 
 ;;; The `color' Widget.
 
+;; Fixme: match
 (define-widget 'color 'editable-field
   "Choose a color name (with sample)."
   :format "%t: %v (%{sample%})\n"
@@ -3362,8 +3565,7 @@ To use this type, you must define :match or :match-alternatives."
   (require 'facemenu)			; for facemenu-color-alist
   (let* ((prefix (buffer-substring-no-properties (widget-field-start widget)
 						 (point)))
-	 (list (or facemenu-color-alist
-		   (mapcar 'list (defined-colors))))
+	 (list (or facemenu-color-alist (defined-colors)))
 	 (completion (try-completion prefix list)))
     (cond ((eq completion t)
 	   (message "Exact match."))
@@ -3380,24 +3582,17 @@ To use this type, you must define :match or :match-alternatives."
 (defun widget-color-sample-face-get (widget)
   (let* ((value (condition-case nil
 		    (widget-value widget)
-		  (error (widget-get widget :value))))
-	 (symbol (intern (concat "fg:" value))))
-    (condition-case nil
-	(facemenu-get-face symbol)
-      (error 'default))))
+		  (error (widget-get widget :value)))))
+    (if (color-defined-p value)
+	(list (cons 'foreground-color value))
+      'default)))
 
 (defun widget-color-action (widget &optional event)
-  ;; Prompt for a color.
+  "Prompt for a color."
   (let* ((tag (widget-apply widget :menu-tag-get))
 	 (prompt (concat tag ": "))
 	 (value (widget-value widget))
 	 (start (widget-field-start widget))
-	 (pos (cond ((< (point) start)
-		     0)
-		    ((> (point) (+ start (length value)))
-		     (length value))
-		    (t
-		     (- (point) start))))
 	 (answer (facemenu-read-color prompt)))
     (unless (zerop (length answer))
       (widget-value-set widget answer)
@@ -3418,11 +3613,11 @@ To use this type, you must define :match or :match-alternatives."
 	 (help-echo (and widget (widget-get widget :help-echo))))
     (if (functionp help-echo)
 	(setq help-echo (funcall help-echo widget)))
-    (if (stringp help-echo)
-	(message "%s" help-echo))))
+    (if help-echo (message "%s" (eval help-echo)))))
 
 ;;; The End:
 
 (provide 'wid-edit)
 
+;;; arch-tag: a076e75e-18a1-4b46-8be5-3f317bcbc707
 ;;; wid-edit.el ends here