X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/233d5cde5b572100f23c42b00fa8210cd6050c40..8d892d7fef218001fa8ef828db4a5a864448f950:/lisp/wid-edit.el

diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index dc43f76700..9c391ab117 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1,6 +1,7 @@
 ;;; 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, 1997, 1999, 2000, 2001, 2002, 2003,
+;;   2004, 2005 Free Software Foundation, Inc.
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Maintainer: FSF
@@ -20,8 +21,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Wishlist items (from widget.texi):
 
@@ -63,9 +64,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 +90,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 +208,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 +219,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 +242,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
@@ -254,7 +268,7 @@ minibuffer."
 	   ;; that corresponds to it.
 	   (save-window-excursion
 	     (let ((buf (get-buffer " widget-choose")))
-	       (display-buffer buf)
+	       (fit-window-to-buffer (display-buffer buf))
 	       (let ((cursor-in-echo-area t)
 		     keys
 		     (char 0)
@@ -262,7 +276,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 ?\s unread-command-events))
 		   (setq keys (read-key-sequence title))
 		   (setq value
 			 (lookup-key overriding-terminal-local-map keys t)
@@ -292,10 +306,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 +334,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 +349,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 +365,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))
 
@@ -358,7 +378,7 @@ new value.")
 	    (end (widget-field-end field)))
 	(when size
 	  (while (and (> end begin)
-		      (eq (char-after (1- end)) ?\ ))
+		      (eq (char-after (1- end)) ?\s))
 	    (setq end (1- end))))
 	(while (< begin end)
 	  (let ((old (char-after begin)))
@@ -370,16 +390,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 +422,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 +430,32 @@ 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
+  '((t :inherit shadow))
   "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 +480,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 +518,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 +578,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 +638,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 +698,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 +709,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 +724,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 +736,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 +786,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)
@@ -750,8 +797,8 @@ The optional ARGS are additional keyword arguments."
 				 &optional button-from button-to
 				 &rest args)
   "Return a widget of type TYPE with endpoint FROM TO.
-Optional ARGS are extra keyword arguments for TYPE.
-and TO will be used as the widgets end points. If optional arguments
+No text will be inserted to the buffer, instead the text between FROM
+and TO will be used as the widgets end points.  If optional arguments
 BUTTON-FROM and BUTTON-TO are given, these will be used as the widgets
 button end points.
 Optional ARGS are extra keyword arguments for TYPE."
@@ -794,6 +841,7 @@ button end points."
 
 ;;; Keymap and Commands.
 
+;;;###autoload
 (defvar widget-keymap
   (let ((map (make-sparse-keymap)))
     (define-key map "\t" 'widget-forward)
@@ -831,7 +879,7 @@ Recommended as a parent keymap for modes using widgets.")
   "Keymap used inside a text field.")
 
 (defun widget-field-activate (pos &optional event)
-  "Invoke the ediable field at point."
+  "Invoke the editable field at point."
   (interactive "@d")
   (let ((field (widget-field-at pos)))
     (if field
@@ -839,28 +887,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,51 +931,59 @@ 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.
-	      (if (memq (event-basic-type event) '(mouse-1 down-mouse-1))
-		  (cond ((setq command	;down event
-			       (lookup-key widget-global-map [down-mouse-1]))
-			 (setq up nil))
-			((setq command	;up event
-			       (lookup-key widget-global-map [mouse-1]))))
+			  (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-2]))
+			     (lookup-key widget-global-map [down-mouse-1]))
 		       (setq up nil))
 		      ((setq command	;up event
-			     (lookup-key widget-global-map [mouse-2])))))
-	      (when up
-		;; Don't execute up events twice.
-		(while (not (widget-button-release-event-p event))
-		  (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)))
+			     (lookup-key widget-global-map [mouse-1]))))
+	      (cond ((setq command	;down event
+			   (lookup-key widget-global-map [down-mouse-2]))
+		     (setq up nil))
+		    ((setq command	;up event
+			   (lookup-key widget-global-map [mouse-2])))))
+	    (when up
+	      ;; Don't execute up events twice.
+	      (while (not (widget-button-release-event-p event))
+		(setq event (read-event))))
+	    (when command
+	      (call-interactively command)))))
     (message "You clicked somewhere weird.")))
 
 (defun widget-button-press (pos &optional event)
@@ -944,19 +1015,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 +1038,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 +1105,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 +1138,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,18 +1169,23 @@ 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)))
-    (and overlay (overlay-buffer overlay))))
+    (cond ((overlayp overlay)
+	   (overlay-buffer overlay))
+	  ((consp overlay)
+	   (marker-buffer (car overlay))))))
 
 (defun widget-field-start (widget)
   "Return the start of WIDGET's editing field."
   (let ((overlay (widget-get widget :field-overlay)))
-    (and overlay (overlay-start overlay))))
+    (if (overlayp overlay)
+	(overlay-start overlay)
+      (car overlay))))
 
 (defun widget-field-end (widget)
   "Return the end of WIDGET's editing field."
@@ -1106,19 +1193,28 @@ When not inside a field, move to the previous button or field."
     ;; Don't subtract one if local-map works at the end of the overlay,
     ;; or if a special `boundary' field has been added after the widget
     ;; field.
-    (and overlay
-	 (if (and (not (eq (get-char-property (overlay-end overlay)
-					      'field
-					      (widget-field-buffer widget))
-			   'boundary))
-		  (or widget-field-add-space
-		      (null (widget-get widget :size))))
-	     (1- (overlay-end overlay))
-	   (overlay-end overlay)))))
+    (if (overlayp overlay)
+	(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))))
+	    (1- (overlay-end overlay))
+	  (overlay-end overlay))
+      (cdr overlay))))
 
 (defun widget-field-find (pos)
   "Return the field at POS.
-Unlike (get-char-property POS 'field) this, works with empty fields too."
+Unlike (get-char-property POS 'field), this works with empty fields too."
   (let ((fields widget-field-list)
 	field found)
     (while fields
@@ -1168,7 +1264,7 @@ Unlike (get-char-property POS 'field) this, works with empty fields too."
 		   ;; Field too small.
 		   (save-excursion
 		     (goto-char end)
-		     (insert-char ?\  (- (+ begin size) end))))
+		     (insert-char ?\s (- (+ begin size) end))))
 		  ((> (- end begin) size)
 		   ;; Field too large and
 		   (if (or (< (point) (+ begin size))
@@ -1179,7 +1275,7 @@ Unlike (get-char-property POS 'field) this, works with empty fields too."
 		     (setq begin (point)))
 		   (save-excursion
 		     (goto-char end)
-		     (while (and (eq (preceding-char) ?\ )
+		     (while (and (eq (preceding-char) ?\s)
 				 (> (point) begin))
 		       (delete-backward-char 1)))))))
 	(widget-specify-secret field))
@@ -1211,6 +1307,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."
@@ -1245,11 +1382,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
@@ -1296,7 +1435,7 @@ If that does not exists, call the value of `widget-complete-field'."
 	       ((eq escape ?n)
 		(when (widget-get widget :indent)
 		  (insert ?\n)
-		  (insert-char ?  (widget-get widget :indent))))
+		  (insert-char ?\s (widget-get widget :indent))))
 	       ((eq escape ?t)
 		(let ((image (widget-get widget :tag-glyph))
 		      (tag (widget-get widget :tag)))
@@ -1360,7 +1499,7 @@ If that does not exists, call the value of `widget-complete-field'."
 	     (when doc-text
 	       (and (eq (preceding-char) ?\n)
 		    (widget-get widget :indent)
-		    (insert-char ?  (widget-get widget :indent)))
+		    (insert-char ?\s (widget-get widget :indent)))
 	       ;; The `*' in the beginning is redundant.
 	       (when (eq (aref doc-text  0) ?*)
 		 (setq doc-text (substring doc-text 1)))
@@ -1403,6 +1542,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
@@ -1461,7 +1601,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)
@@ -1591,6 +1731,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%]")
 
@@ -1602,7 +1743,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.
 
@@ -1611,7 +1752,7 @@ If END is omitted, it defaults to the length of LIST."
   :action 'widget-url-link-action)
 
 (defun widget-url-link-action (widget &optional event)
-  "Open the url specified by WIDGET."
+  "Open the URL specified by WIDGET."
   (browse-url (widget-value widget)))
 
 ;;; The `function-link' Widget.
@@ -1651,15 +1792,15 @@ If END is omitted, it defaults to the length of LIST."
   :action 'widget-emacs-library-link-action)
 
 (defun widget-emacs-library-link-action (widget &optional event)
-  "Find the Emacs Library file specified by WIDGET."
+  "Find the Emacs library file specified by WIDGET."
   (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)))
@@ -1732,7 +1873,7 @@ the earlier input."
     (insert value)
     (and size
 	 (< (length value) size)
-	 (insert-char ?\  (- size (length value))))
+	 (insert-char ?\s (- size (length value))))
     (unless (memq widget widget-field-list)
       (setq widget-field-new (cons widget widget-field-new)))
     (move-marker (cdr overlay) (point))
@@ -1745,9 +1886,10 @@ the earlier input."
 (defun widget-field-value-delete (widget)
   "Remove the widget from the list of active editing fields."
   (setq widget-field-list (delq widget widget-field-list))
+  (setq widget-field-new (delq widget widget-field-new))
   ;; These are nil if the :format string doesn't contain `%v'.
   (let ((overlay (widget-get widget :field-overlay)))
-    (when overlay
+    (when (overlayp overlay)
       (delete-overlay overlay))))
 
 (defun widget-field-value-get (widget)
@@ -1764,7 +1906,7 @@ the earlier input."
 	  (while (and size
 		      (not (zerop size))
 		      (> to from)
-		      (eq (char-after (1- to)) ?\ ))
+		      (eq (char-after (1- to)) ?\s))
 	    (setq to (1- to)))
 	  (let ((result (buffer-substring-no-properties from to)))
 	    (when secret
@@ -1784,22 +1926,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
@@ -1814,13 +1956,14 @@ the earlier input."
 	(args (widget-get widget :args))
 	(explicit (widget-get widget :explicit-choice))
 	current)
-    (if (and explicit (equal value (widget-get widget :explicit-choice-value)))
+    (if explicit
 	(progn
 	  ;; If the user specified the choice for this value,
-	  ;; respect that choice as long as the value is the same.
+	  ;; respect that choice.
 	  (widget-put widget :children (list (widget-create-child-value
 					      widget explicit value)))
-	  (widget-put widget :choice explicit))
+	  (widget-put widget :choice explicit)
+	  (widget-put widget :explicit-choice nil))
       (while args
 	(setq current (car args)
 	      args (cdr args))
@@ -1836,14 +1979,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))))
@@ -1914,16 +2049,11 @@ when he invoked the menu."
 		 (setq this-explicit t)
 		 (widget-choose tag (reverse choices) event))))
     (when current
-      ;; If this was an explicit user choice,
-      ;; record the choice, and the record the value it was made for.
-      ;; widget-choice-value-create will respect this choice,
-      ;; as long as the value is the same.
+      ;; If this was an explicit user choice, record the choice,
+      ;; so that widget-choice-value-create will respect it.
       (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-put widget :explicit-choice 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))
@@ -1968,12 +2098,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.
@@ -1992,15 +2130,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 (make-bool-vector 49 1)
-			  'xbm t :width 7 :height 7
-			  :foreground "grey75" ; like default mode line
-			  :relief -3 :ascent 'center)
+  :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-bool-vector 49 1)
-			   'xbm t :width 7 :height 7
-			   :foreground "grey75"
-			   :relief 3 :ascent 'center)
+  :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)
 
@@ -2018,13 +2160,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
@@ -2044,7 +2185,7 @@ when he invoked the menu."
 If the item is checked, CHOSEN is a cons whose cdr is the value."
   (and (eq (preceding-char) ?\n)
        (widget-get widget :indent)
-       (insert-char ?  (widget-get widget :indent)))
+       (insert-char ?\s (widget-get widget :indent)))
   (widget-specify-insert
    (let* ((children (widget-get widget :children))
 	  (buttons (widget-get widget :buttons))
@@ -2196,12 +2337,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
@@ -2225,7 +2365,7 @@ Return an alist of (TYPE MATCH)."
   ;; (setq type (widget-convert type))
   (and (eq (preceding-char) ?\n)
        (widget-get widget :indent)
-       (insert-char ?  (widget-get widget :indent)))
+       (insert-char ?\s (widget-get widget :indent)))
   (widget-specify-insert
    (let* ((value (widget-get widget :value))
 	  (children (widget-get widget :children))
@@ -2385,13 +2525,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
@@ -2401,16 +2540,16 @@ 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)))
+		(insert-char ?\s (widget-get widget :indent)))
 	   (apply 'widget-create-child-and-convert
 		  widget 'insert-button
 		  (widget-get widget :append-button-args)))
 	  (t
 	   (widget-default-format-handler widget escape)))
-;;;     )
+    ;; )
   )
 
 (defun widget-editable-list-value-create (widget)
@@ -2511,12 +2650,12 @@ 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
        (and (widget-get widget :indent)
-	    (insert-char ?\  (widget-get widget :indent)))
+	    (insert-char ?\s (widget-get widget :indent)))
        (insert (widget-get widget :entry-format)))
      ;; Parse % escapes in format.
      (while (re-search-forward "%\\(.\\)" nil t)
@@ -2537,23 +2676,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.
@@ -2561,9 +2698,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
@@ -2582,7 +2719,7 @@ Return an alist of (TYPE MATCH)."
 	    value (cdr answer))
       (and (eq (preceding-char) ?\n)
 	   (widget-get widget :indent)
-	   (insert-char ?\  (widget-get widget :indent)))
+	   (insert-char ?\s (widget-get widget :indent)))
       (push (cond ((null answer)
 		   (widget-create-child widget arg))
 		  ((widget-get arg :inline)
@@ -2721,7 +2858,7 @@ link for that string."
 	  (narrow-to-region from to)
 	  (goto-char (point-min))
 	  (while (search-forward "\n" nil t)
-	    (insert-char ?\  indent)))))))
+	    (insert-char ?\s indent)))))))
 
 ;;; The `documentation-string' Widget.
 
@@ -2729,7 +2866,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)
@@ -2742,12 +2878,13 @@ link for that string."
 	(let ((before (substring doc 0 (match-beginning 0)))
 	      (after (substring doc (match-beginning 0)))
 	      button)
-	  (insert before ?\ )
+	  (insert before ?\s)
 	  (widget-documentation-link-add widget start (point))
 	  (setq button
 		(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
@@ -2755,7 +2892,7 @@ link for that string."
 	  (when shown
 	    (setq start (point))
 	    (when (and indent (not (zerop indent)))
-	      (insert-char ?\  indent))
+	      (insert-char ?\s indent))
 	    (insert after)
 	    (widget-documentation-link-add widget start (point)))
 	  (widget-put widget :buttons (list button)))
@@ -2821,7 +2958,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)
@@ -2847,7 +2984,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 ()
@@ -2900,6 +3037,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."
@@ -2940,7 +3078,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)
@@ -2950,6 +3088,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"
@@ -2962,7 +3101,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
@@ -2973,7 +3111,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"
@@ -3051,6 +3189,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"
@@ -3109,12 +3249,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"
@@ -3160,13 +3307,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.
@@ -3183,10 +3386,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
@@ -3227,10 +3431,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
@@ -3336,6 +3541,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"
@@ -3352,8 +3558,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."))
@@ -3370,24 +3575,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)
@@ -3395,7 +3593,7 @@ To use this type, you must define :match or :match-alternatives."
       (widget-apply widget :notify widget event))))
 
 (defun widget-color-notify (widget child &optional event)
-  "Update the sample, and notofy the parent."
+  "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))
@@ -3408,11 +3606,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