Add a provide statement.

[gnu-emacs] / lisp / wid-edit.el

diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 232c2f8deb0bf0f17210adf335b36c2a3b8d27d2..f659518ee0298d4700086f0a74d410039987ff5d 100644 (file)
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1,11 +1,10 @@
-;;; wid-edit.el --- Functions for creating and using widgets.
+;;; wid-edit.el --- Functions for creating and using widgets -*-byte-compile-dynamic: t;-*-

 ;;
 ;;

-;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97,1999,2000,01,02,2003, 2004  Free Software Foundation, Inc.

 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>

+;; Maintainer: FSF

 ;; Keywords: extensions
 ;; Keywords: extensions

-;; Version: 1.9951
-;; X-URL: http://www.dina.kvl.dk/~abraham/custom/

 
 ;; This file is part of GNU Emacs.
 
 
 ;; This file is part of GNU Emacs.
 


@@ -24,56 +23,58 @@
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 

+;;; Wishlist items (from widget.texi):
+
+;; * The `menu-choice' tag should be prettier, something like the
+;;   abbreviated menus in Open Look.
+
+;; * Finish `:tab-order'.
+
+;; * Make indentation work with glyphs and proportional fonts.
+
+;; * Add commands to show overview of object and class hierarchies to
+;;   the browser.
+
+;; * Find a way to disable mouse highlight for inactive widgets.
+
+;; * Find a way to make glyphs look inactive.
+
+;; * Add `key-binding' widget.
+
+;; * Add `widget' widget for editing widget specifications.
+
+;; * Find clean way to implement variable length list.  See
+;;   `TeX-printer-list' for an explanation.
+
+;; * `C-h' in `widget-prompt-value' should give type specific help.
+
+;; * A mailto widget. [This should work OK as a url-link if with
+;;   browse-url-browser-function' set up appropriately.]
+

 ;;; Commentary:
 ;;
 ;; See `widget.el'.
 
 ;;; Code:
 
 ;;; Commentary:
 ;;
 ;; See `widget.el'.
 
 ;;; Code:
 

-(require 'widget)
-(eval-when-compile (require 'cl))
-

 ;;; Compatibility.
 ;;; Compatibility.

-  
+

 (defun widget-event-point (event)
   "Character position of the end of event if that exists, or nil."
   (posn-point (event-end event)))
 
 (defun widget-event-point (event)
   "Character position of the end of event if that exists, or nil."
   (posn-point (event-end event)))
 

-(defalias 'widget-read-event 'read-event)
-
-(eval-and-compile
-  (autoload 'pp-to-string "pp")
-  (autoload 'Info-goto-node "info")
-  (autoload 'finder-commentary "finder" nil t)
-
-  (unless (and (featurep 'custom) (fboundp 'custom-declare-variable))
-    ;; We have the old custom-library, hack around it!
-    (defmacro defgroup (&rest args) nil)
-    (defmacro defcustom (var value doc &rest args) 
-      (` (defvar (, var) (, value) (, doc))))
-    (defmacro defface (&rest args) nil)
-    (define-widget-keywords :prefix :tag :load :link :options :type :group)
-    (when (fboundp 'copy-face)
-      (copy-face 'default 'widget-documentation-face)
-      (copy-face 'bold 'widget-button-face)
-      (copy-face 'italic 'widget-field-face)))
-
-  (unless (fboundp 'button-release-event-p)
-    ;; XEmacs function missing from Emacs.
-    (defun button-release-event-p (event)
-      "Non-nil if EVENT is a mouse-button-release event object."
-      (and (eventp event)
-          (memq (event-basic-type event) '(mouse-1 mouse-2 mouse-3))
-          (or (memq 'click (event-modifiers event))
-              (memq  'drag (event-modifiers event)))))))
+(defun widget-button-release-event-p (event)
+  "Non-nil if EVENT is a mouse-button-release event object."
+  (and (eventp event)
+       (memq (event-basic-type event) '(mouse-1 mouse-2 mouse-3))
+       (or (memq 'click (event-modifiers event))
+          (memq  'drag (event-modifiers event)))))

 
 ;;; Customization.
 
 (defgroup widgets nil
   "Customization support for the Widget Library."
   :link '(custom-manual "(widget)Top")
 
 ;;; Customization.
 
 (defgroup widgets nil
   "Customization support for the Widget Library."
   :link '(custom-manual "(widget)Top")

-  :link '(url-link :tag "Development Page" 
-                  "http://www.dina.kvl.dk/~abraham/custom/")

   :link '(emacs-library-link :tag "Lisp File" "widget.el")
   :prefix "widget-"
   :group 'extensions
   :link '(emacs-library-link :tag "Lisp File" "widget.el")
   :prefix "widget-"
   :group 'extensions


@@ -89,7 +90,7 @@
   :group 'faces)
 
 (defvar widget-documentation-face 'widget-documentation-face
   :group 'faces)
 
 (defvar widget-documentation-face 'widget-documentation-face

-  "Face used for documentation strings in widges.
+  "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)
 This exists as a variable so it can be set locally in certain buffers.")
 
 (defface widget-documentation-face '((((class color)


@@ -104,10 +105,10 @@ This exists as a variable so it can be set locally in certain buffers.")
   :group 'widget-faces)
 
 (defvar widget-button-face 'widget-button-face
   :group 'widget-faces)
 
 (defvar widget-button-face 'widget-button-face

-  "Face used for buttons in widges.
+  "Face used for buttons in widgets.

 This exists as a variable so it can be set locally in certain buffers.")
 
 This exists as a variable so it can be set locally in certain buffers.")
 

-(defface widget-button-face '((t (:bold t)))
+(defface widget-button-face '((t (:weight bold)))

   "Face used for widget buttons."
   :group 'widget-faces)
 
   "Face used for widget buttons."
   :group 'widget-faces)
 


@@ -116,25 +117,34 @@ This exists as a variable so it can be set locally in certain buffers.")
   :type 'face
   :group 'widget-faces)
 
   :type 'face
   :group 'widget-faces)
 

-(defface widget-field-face '((((class grayscale color)
+;; 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-face '((((type tty))
+                             :background "yellow3"
+                             :foreground "black")
+                            (((class grayscale color)

                               (background light))
                               (background light))

-                             (:background "gray85"))
+                             :background "gray85")

                             (((class grayscale color)
                               (background dark))
                             (((class grayscale color)
                               (background dark))

-                             (:background "dim gray"))
-                            (t 
-                             (:italic t)))
+                             :background "dim gray")
+                            (t
+                             :slant italic))

   "Face used for editable fields."
   :group 'widget-faces)
 
   "Face used for editable fields."
   :group 'widget-faces)
 

-(defface widget-single-line-field-face '((((class grayscale color)
+(defface widget-single-line-field-face '((((type tty))
+                                         :background "green3"
+                                         :foreground "black")
+                                        (((class grayscale color)

                                           (background light))
                                           (background light))

-                                         (:background "gray85"))
+                                         :background "gray85")

                                         (((class grayscale color)
                                           (background dark))
                                         (((class grayscale color)
                                           (background dark))

-                                         (:background "dim gray"))
-                                        (t 
-                                         (:italic t)))
+                                         :background "dim gray")
+                                        (t
+                                         :slant italic))

   "Face used for editable fields spanning only a single line."
   :group 'widget-faces)
 
   "Face used for editable fields spanning only a single line."
   :group 'widget-faces)
 


@@ -155,15 +165,11 @@ This exists as a variable so it can be set locally in certain buffers.")
 ;; These are not really widget specific.
 
 (defun widget-princ-to-string (object)
 ;; These are not really widget specific.
 
 (defun widget-princ-to-string (object)

-  ;; Return string representation of OBJECT, any Lisp object.
-  ;; No quoting characters are used; no delimiters are printed around
-  ;; the contents of strings.
-  (save-excursion
-    (set-buffer (get-buffer-create " *widget-tmp*"))
-    (erase-buffer)
-    (let ((standard-output (current-buffer)))
-      (princ object))
-    (buffer-string)))
+  "Return string representation of OBJECT, any Lisp object.
+No quoting characters are used; no delimiters are printed around
+the contents of strings."
+  (with-output-to-string
+      (princ object)))

 
 (defun widget-clear-undo ()
   "Clear all undo information."
 
 (defun widget-clear-undo ()
   "Clear all undo information."


@@ -193,7 +199,7 @@ nil means read a single character."
   "Choose an item from a list.
 
 First argument TITLE is the name of the list.
   "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.
  (NAME . VALUE), to indicate selectable items, or just strings to
  indicate unselectable items.
 Optional third argument EVENT is an input event.


@@ -204,8 +210,8 @@ 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)
 `widget-menu-max-size', a popup menu will be used, otherwise the
 minibuffer."
   (cond ((and (< (length items) widget-menu-max-size)

-             event (fboundp 'x-popup-menu) window-system)
-        ;; We are in Emacs-19, pressed by the mouse
+             event (display-popup-menus-p))
+        ;; Mouse click.

         (x-popup-menu event
                       (list title (cons "" items))))
        ((or widget-menu-minibuffer-flag
         (x-popup-menu event
                       (list title (cons "" items))))
        ((or widget-menu-minibuffer-flag


@@ -217,21 +223,17 @@ minibuffer."
               (let ((try (try-completion val items)))
                 (when (stringp try)
                   (setq val try))
               (let ((try (try-completion val items)))
                 (when (stringp try)
                   (setq val try))

-                (cdr (assoc val items)))
-            nil)))
+                (cdr (assoc val items))))))

        (t
         ;; Construct a menu of the choices
         ;; and then use it for prompting for a single character.
        (t
         ;; Construct a menu of the choices
         ;; and then use it for prompting for a single character.

-        (let* ((overriding-terminal-local-map
-                (make-sparse-keymap))
-               map choice (next-digit ?0)
-               some-choice-enabled
-               value)
+        (let* ((overriding-terminal-local-map (make-sparse-keymap))
+               (next-digit ?0)
+               map choice some-choice-enabled value)

           ;; Define SPC as a prefix char to get to this menu.
           (define-key overriding-terminal-local-map " "
             (setq map (make-sparse-keymap title)))
           ;; 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
             (erase-buffer)
             (insert "Available choices:\n\n")
             (while items


@@ -257,7 +259,7 @@ minibuffer."
           ;; that corresponds to it.
           (save-window-excursion
             (let ((buf (get-buffer " widget-choose")))
           ;; 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)
               (let ((cursor-in-echo-area t)
                     keys
                     (char 0)


@@ -265,14 +267,17 @@ minibuffer."
                 (while (not (or (and (>= char ?0) (< char next-digit))
                                 (eq value 'keyboard-quit)))
                   ;; Unread a SPC to lead to our new menu.
                 (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 keys (read-key-sequence title))

-                  (setq value (lookup-key overriding-terminal-local-map keys t)
+                  (setq value
+                        (lookup-key overriding-terminal-local-map keys t)

                         char (string-to-char (substring keys 1)))
                   (cond ((eq value 'scroll-other-window)
                         char (string-to-char (substring keys 1)))
                   (cond ((eq value 'scroll-other-window)

-                         (let ((minibuffer-scroll-window (get-buffer-window buf)))
+                         (let ((minibuffer-scroll-window
+                                (get-buffer-window buf)))

                            (if (> 0 arg)
                            (if (> 0 arg)

-                               (scroll-other-window-down (window-height minibuffer-scroll-window))
+                               (scroll-other-window-down
+                                (window-height minibuffer-scroll-window))

                              (scroll-other-window))
                            (setq arg 1)))
                         ((eq value 'negative-argument)
                              (scroll-other-window))
                            (setq arg 1)))
                         ((eq value 'negative-argument)


@@ -292,32 +297,20 @@ minibuffer."
     (nreverse result)))
 
 ;;; Widget text specifications.
     (nreverse result)))
 
 ;;; Widget text specifications.

-;; 
-;; These functions are for specifying text properties. 
-
-(defcustom widget-field-add-space 
-  (or (< emacs-major-version 20)
-      (and (eq emacs-major-version 20)
-          (< emacs-minor-version 3))
-      (not (string-match "XEmacs" emacs-version)))
-  "Non-nil means add extra space at the end of editable text fields.
+;;
+;; These functions are for specifying text properties.

 
 

-This is needed on all versions of Emacs, and on XEmacs before 20.3.  
+;; 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
 If you don't add the space, it will become impossible to edit a zero

-size field."
-  :type 'boolean
-  :group 'widgets)
+size field.")

 
 

-(defcustom widget-field-use-before-change
-  (and (or (> emacs-minor-version 34)
-          (> emacs-major-version 19))
-       (not (string-match "XEmacs" emacs-version)))
+(defvar widget-field-use-before-change t

   "Non-nil means use `before-change-functions' to track editable fields.
   "Non-nil means use `before-change-functions' to track editable fields.

-This enables the use of undo, but doesn't work on Emacs 19.34 and earlier. 
+This enables the use of undo, but doesn't work on Emacs 19.34 and earlier.

 Using before hooks also means that the :notify function can't know the
 Using before hooks also means that the :notify function can't know the

-new value."
-  :type 'boolean
-  :group 'widgets)
+new value.")

 
 (defun widget-specify-field (widget from to)
   "Specify editable button for WIDGET between FROM and TO."
 
 (defun widget-specify-field (widget from to)
   "Specify editable button for WIDGET between FROM and TO."


@@ -331,22 +324,35 @@ new value."
          (widget-field-add-space
           (insert-and-inherit " ")))
     (setq to (point)))
          (widget-field-add-space
           (insert-and-inherit " ")))
     (setq to (point)))

-  (let ((map (widget-get widget :keymap))
+  (let ((keymap (widget-get widget :keymap))

        (face (or (widget-get widget :value-face) 'widget-field-face))
        (help-echo (widget-get widget :help-echo))
        (face (or (widget-get widget :value-face) 'widget-field-face))
        (help-echo (widget-get widget :help-echo))

-       (overlay (make-overlay from to nil 
-                              nil (or (not widget-field-add-space)
-                                      (widget-get widget :size)))))
-    (unless (or (stringp help-echo) (null help-echo))
-      (setq help-echo 'widget-mouse-help))    
-    (widget-put widget :field-overlay overlay)
-    (overlay-put overlay 'detachable nil)
-    (overlay-put overlay 'field widget)
-    (overlay-put overlay 'local-map map)
-    (overlay-put overlay 'keymap map)
-    (overlay-put overlay 'face face)
-    (overlay-put overlay 'balloon-help help-echo)
-    (overlay-put overlay 'help-echo help-echo))
+       (rear-sticky
+        (or (not widget-field-add-space) (widget-get widget :size))))
+    (if (functionp help-echo)
+      (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
+      ;; C-n/C-p act more naturally when entering/leaving the field.  We
+     ;; do this by making a small secondary overlay to contain just that
+      ;; one character.
+      (let ((overlay (make-overlay (1- to) to nil t nil)))
+       (overlay-put overlay 'field 'boundary)
+       ;; 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 'help-echo help-echo))
+      (setq to (1- to))
+      (setq rear-sticky t))
+    (let ((overlay (make-overlay from to nil nil rear-sticky)))
+      (widget-put widget :field-overlay overlay)
+      ;;(overlay-put overlay 'detachable nil)
+      (overlay-put overlay 'field widget)
+      (overlay-put overlay 'local-map keymap)
+      (overlay-put overlay 'face face)
+      (overlay-put overlay 'help-echo help-echo)))

   (widget-specify-secret widget))
 
 (defun widget-specify-secret (field)
   (widget-specify-secret widget))
 
 (defun widget-specify-secret (field)


@@ -356,7 +362,7 @@ new value."
     (when secret
       (let ((begin (widget-field-start field))
            (end (widget-field-end field)))
     (when secret
       (let ((begin (widget-field-start field))
            (end (widget-field-end field)))

-       (when size 
+       (when size

          (while (and (> end begin)
                      (eq (char-after (1- end)) ?\ ))
            (setq end (1- end))))
          (while (and (> end begin)
                      (eq (char-after (1- end)) ?\ ))
            (setq end (1- end))))


@@ -369,60 +375,52 @@ new value."
 
 (defun widget-specify-button (widget from to)
   "Specify button for WIDGET between FROM and TO."
 
 (defun widget-specify-button (widget from to)
   "Specify button for WIDGET between FROM and TO."

-  (let ((face (widget-apply widget :button-face-get))
-       (help-echo (widget-get widget :help-echo))
-       (overlay (make-overlay from to nil t nil)))
+  (let ((overlay (make-overlay from to nil t nil))
+       (help-echo (widget-get widget :help-echo)))

     (widget-put widget :button-overlay overlay)
     (widget-put widget :button-overlay overlay)

-    (unless (or (null help-echo) (stringp help-echo))
+    (if (functionp help-echo)

       (setq help-echo 'widget-mouse-help))
     (overlay-put overlay 'button widget)
       (setq help-echo 'widget-mouse-help))
     (overlay-put overlay 'button widget)

-    (overlay-put overlay 'mouse-face widget-mouse-face)
-    (overlay-put overlay 'balloon-help help-echo)
-    (overlay-put overlay 'help-echo help-echo)
-    (overlay-put overlay 'face face)))
-
-(defun widget-mouse-help (extent)
-  "Find mouse help string for button in extent."
-  (let* ((widget (widget-at (extent-start-position extent)))
-        (help-echo (and widget (widget-get widget :help-echo))))
-    (cond ((stringp help-echo)
-          help-echo)
-         ((and (symbolp help-echo) (fboundp help-echo)
-               (stringp (setq help-echo (funcall help-echo widget))))
-          help-echo)
-         (t
-          (format "(widget %S :help-echo %S)" widget help-echo)))))
+    (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 'pointer 'hand)
+    (overlay-put overlay 'help-echo help-echo)))
+
+(defun widget-mouse-help (window overlay point)
+  "Help-echo callback for widgets whose :help-echo is a function."
+  (with-current-buffer (overlay-buffer overlay)
+    (let* ((widget (widget-at (overlay-start overlay)))
+          (help-echo (if widget (widget-get widget :help-echo))))
+      (if (functionp help-echo)
+         (funcall help-echo widget)
+       help-echo))))

 
 (defun widget-specify-sample (widget from to)
 
 (defun widget-specify-sample (widget from to)

-  ;; Specify sample for WIDGET between FROM and TO.
-  (let ((face (widget-apply widget :sample-face-get))
-       (overlay (make-overlay from to nil t nil)))
-    (overlay-put overlay 'face face)
+  "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)
     (widget-put widget :sample-overlay overlay)))
 
 (defun widget-specify-doc (widget from to)

-  ;; Specify documentation for WIDGET between FROM and TO.
+  "Specify documentation for WIDGET between FROM and TO."

   (let ((overlay (make-overlay from to nil t nil)))
     (overlay-put overlay 'widget-doc widget)
     (overlay-put overlay 'face widget-documentation-face)
   (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)
     (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)
-          result
-          before-change-functions
-          after-change-functions)
-       (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))))
+  "Execute FORM without inheriting any text properties."
+  `(save-restriction
+    (let ((inhibit-read-only t)
+         (inhibit-modification-hooks t))
+      (narrow-to-region (point) (point))
+      (prog1 (progn ,@form)
+       (goto-char (point-max))))))

 
 (defface widget-inactive-face '((((class grayscale color)
                                  (background dark))
 
 (defface widget-inactive-face '((((class grayscale color)
                                  (background dark))


@@ -430,8 +428,8 @@ new value."
                                (((class grayscale color)
                                  (background light))
                                 (:foreground "dim gray"))
                                (((class grayscale color)
                                  (background light))
                                 (:foreground "dim gray"))

-                               (t 
-                                (:italic t)))
+                               (t
+                                (:slant italic)))

   "Face used for inactive widgets."
   :group 'widget-faces)
 
   "Face used for inactive widgets."
   :group 'widget-faces)
 


@@ -444,15 +442,13 @@ new value."
       ;; (overlay-put overlay 'mouse-face 'widget-inactive-face)
       (overlay-put overlay 'evaporate t)
       (overlay-put overlay 'priority 100)
       ;; (overlay-put overlay 'mouse-face 'widget-inactive-face)
       (overlay-put overlay 'evaporate t)
       (overlay-put overlay 'priority 100)

-      (overlay-put overlay (if (string-match "XEmacs" emacs-version)
-                              'read-only
-                            'modification-hooks) '(widget-overlay-inactive))
+      (overlay-put overlay 'modification-hooks '(widget-overlay-inactive))

       (widget-put widget :inactive overlay))))
 
 (defun widget-overlay-inactive (&rest junk)
   "Ignoring the arguments, signal an error."
   (unless inhibit-read-only
       (widget-put widget :inactive overlay))))
 
 (defun widget-overlay-inactive (&rest junk)
   "Ignoring the arguments, signal an error."
   (unless inhibit-read-only

-    (error "Attempt to modify inactive widget")))
+    (error "The widget here is not active")))

 
 
 (defun widget-specify-active (widget)
 
 
 (defun widget-specify-active (widget)


@@ -468,9 +464,18 @@ new value."
   "Return the type of WIDGET, a symbol."
   (car widget))
 
   "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.
 (defun widget-get-indirect (widget property)
   "In WIDGET, get the value of PROPERTY.

-If the value is a symbol, return its binding.  
+If the value is a symbol, return its binding.

 Otherwise, just return the value."
   (let ((value (widget-get widget property)))
     (if (symbolp value)
 Otherwise, just return the value."
   (let ((value (widget-get widget property)))
     (if (symbolp value)


@@ -479,7 +484,7 @@ Otherwise, just return the value."
 
 (defun widget-member (widget property)
   "Non-nil iff there is a definition in WIDGET for PROPERTY."
 
 (defun widget-member (widget property)
   "Non-nil iff there is a definition in WIDGET for PROPERTY."

-  (cond ((widget-plist-member (cdr widget) property)
+  (cond ((plist-member (cdr widget) property)

         t)
        ((car widget)
         (widget-member (get (car widget) 'widget-type) property))
         t)
        ((car widget)
         (widget-member (get (car widget) 'widget-type) property))


@@ -497,15 +502,16 @@ Otherwise, just return the value."
                                         :value-to-internal value)))
 
 (defun widget-default-get (widget)
                                         :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)
 
 (defun widget-match-inline (widget vals)

-  ;; In WIDGET, match the start of VALS.
+  "In WIDGET, match the start of VALS."

   (cond ((widget-get widget :inline)
         (widget-apply widget :match-inline vals))
   (cond ((widget-get widget :inline)
         (widget-apply widget :match-inline vals))

-       ((and vals
+       ((and (listp vals)

              (widget-apply widget :match (car vals)))
         (cons (list (car vals)) (cdr vals)))
        (t nil)))
              (widget-apply widget :match (car vals)))
         (cons (list (car vals)) (cdr vals)))
        (t nil)))


@@ -530,14 +536,13 @@ The current value is assumed to be VALUE, unless UNBOUND is non-nil."
   (setq widget (widget-convert widget))
   (let ((answer (widget-apply widget :prompt-value prompt value unbound)))
     (unless (widget-apply widget :match answer)
   (setq widget (widget-convert widget))
   (let ((answer (widget-apply widget :prompt-value prompt value unbound)))
     (unless (widget-apply widget :match answer)

-      (error "Value does not match %S type." (car widget)))
+      (error "Value does not match %S type" (car widget)))

     answer))
 
 (defun widget-get-sibling (widget)
   "Get the item WIDGET is assumed to toggle.
 This is only meaningful for radio buttons or checkboxes in a list."
     answer))
 
 (defun widget-get-sibling (widget)
   "Get the item WIDGET is assumed to toggle.
 This is only meaningful for radio buttons or checkboxes in a list."

-  (let* ((parent (widget-get widget :parent))
-        (children (widget-get parent :children))
+  (let* ((children (widget-get (widget-get widget :parent) :children))

         child)
     (catch 'child
       (while children
         child)
     (catch 'child
       (while children


@@ -557,9 +562,8 @@ The arguments MAPARG, and BUFFER default to nil and (current-buffer),
 respectively."
   (let ((cur (point-min))
        (widget nil)
 respectively."
   (let ((cur (point-min))
        (widget nil)

-       (parent nil)

        (overlays (if buffer
        (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))
                    (overlay-lists))))
     (setq overlays (append (car overlays) (cdr overlays)))
     (while (setq cur (pop overlays))


@@ -567,17 +571,19 @@ respectively."
       (if (and widget (funcall function widget maparg))
          (setq overlays nil)))))
 
       (if (and widget (funcall function widget maparg))
          (setq overlays nil)))))
 

-;;; Glyphs.
+;;; Images.

 
 

-(defcustom widget-glyph-directory (concat data-directory "custom/")
-  "Where widget glyphs are located.
+(defcustom widget-image-directory (file-name-as-directory
+                                  (expand-file-name "custom" data-directory))
+  "Where widget button images are located.

 If this variable is nil, widget will try to locate the directory
 automatically."
   :group 'widgets
   :type 'directory)
 
 If this variable is nil, widget will try to locate the directory
 automatically."
   :group 'widgets
   :type 'directory)
 

-(defcustom widget-glyph-enable t
-  "If non nil, use glyphs in images when available."
+(defcustom widget-image-enable t
+  "If non nil, use image buttons in widgets when available."
+  :version "21.1"

   :group 'widgets
   :type 'boolean)
 
   :group 'widgets
   :type 'boolean)
 


@@ -591,104 +597,50 @@ automatically."
                       (repeat :tag "Suffixes"
                               (string :format "%v")))))
 
                       (repeat :tag "Suffixes"
                               (string :format "%v")))))
 

-(defun widget-glyph-find (image tag)
-  "Create a glyph corresponding to IMAGE with string TAG as fallback.
-IMAGE should either already be a glyph, or be a file name sans
+(defun widget-image-find (image)
+  "Create a graphical button from IMAGE.
+IMAGE should either already be an image, or be a file name sans

 extension (xpm, xbm, gif, jpg, or png) located in
 extension (xpm, xbm, gif, jpg, or png) located in

-`widget-glyph-directory'." 
-  (cond ((not (and image 
-                  (string-match "XEmacs" emacs-version)
-                  widget-glyph-enable
-                  (fboundp 'make-glyph)
-                  (fboundp 'locate-file)
-                  image))
-        ;; We don't want or can't use glyphs.
+`widget-image-directory' or otherwise where `find-image' will find it."
+  (cond ((not (and image widget-image-enable (display-graphic-p)))
+        ;; We don't want or can't use images.

         nil)
         nil)

-       ((and (fboundp 'glyphp)
-             (glyphp image))
-        ;; Already a glyph.  Use it.
+       ((and (consp image)
+             (eq 'image (car image)))
+        ;; Already an image spec.  Use it.

         image)
        ((stringp image)
         ;; A string.  Look it up in relevant directories.
         image)
        ((stringp image)
         ;; A string.  Look it up in relevant directories.

-        (let* ((dirlist (list (or widget-glyph-directory
-                                  (concat data-directory
-                                          "custom/"))
-                              data-directory))
-               (formats widget-image-conversion)
-               file)
-          (while (and formats (not file))
-            (when (valid-image-instantiator-format-p (car (car formats)))
-              (setq file (locate-file image dirlist
-                                      (mapconcat 'identity
-                                                 (cdr (car formats))
-                                                 ":"))))
-            (unless file
-              (setq formats (cdr formats))))
-          (and file
-               ;; We create a glyph with the file as the default image
-               ;; instantiator, and the TAG fallback
-               (make-glyph (list (vector (car (car formats)) ':file file)
-                                 (vector 'string ':data tag))))))
-       ((valid-instantiator-p image 'image)
-        ;; A valid image instantiator (e.g. [gif :file "somefile"] etc.)
-        (make-glyph (list image
-                          (vector 'string ':data tag))))
-       ((consp image)
-        ;; This could be virtually anything.  Let `make-glyph' sort it out.
-        (make-glyph image))
+        (let* ((load-path (cons widget-image-directory load-path))
+               specs)
+          (dolist (elt widget-image-conversion)
+            (dolist (ext (cdr elt))
+              (push (list :type (car elt) :file (concat image ext)) specs)))
+          (setq specs (nreverse specs))
+          (find-image specs)))

        (t
         ;; Oh well.
         nil)))
 
        (t
         ;; Oh well.
         nil)))
 

-(defun widget-glyph-insert (widget tag image &optional down inactive)
+(defvar widget-button-pressed-face 'widget-button-pressed-face
+  "Face used for pressed buttons in widgets.
+This exists as a variable so it can be set locally in certain
+buffers.")
+
+(defun widget-image-insert (widget tag image &optional down inactive)

   "In WIDGET, insert the text TAG or, if supported, IMAGE.
   "In WIDGET, insert the text TAG or, if supported, IMAGE.

-IMAGE should either be a glyph, an image instantiator, or an image file
-name sans extension (xpm, xbm, gif, jpg, or png) located in
-`widget-glyph-directory'.
-
-Optional arguments DOWN and INACTIVE is used instead of IMAGE when the
-glyph is pressed or inactive, respectively. 
-
-WARNING: If you call this with a glyph, and you want the user to be
-able to invoke the glyph, make sure it is unique.  If you use the
-same glyph for multiple widgets, invoking any of the glyphs will
-cause the last created widget to be invoked.
-
-Instead of an instantiator, you can also use a list of instantiators,
-or whatever `make-glyph' will accept.  However, in that case you must
-provide the fallback TAG as a part of the instantiator yourself."
-  (let ((glyph (widget-glyph-find image tag)))
-    (if glyph 
-       (widget-glyph-insert-glyph widget 
-                                  glyph
-                                  (widget-glyph-find down tag)
-                                  (widget-glyph-find inactive tag))
-      (insert tag))))
-
-(defun widget-glyph-insert-glyph (widget glyph &optional down inactive)
-  "In WIDGET, insert GLYPH.
-If optional arguments DOWN and INACTIVE are given, they should be
-glyphs used when the widget is pushed and inactive, respectively."
-  (when widget
-    (set-glyph-property glyph 'widget widget)
-    (when down
-      (set-glyph-property down 'widget widget))
-    (when inactive
-      (set-glyph-property inactive 'widget widget)))
-  (insert "*")
-  (let ((ext (make-extent (point) (1- (point))))
-       (help-echo (and widget (widget-get widget :help-echo))))
-    (set-extent-property ext 'invisible t)
-    (set-extent-property ext 'start-open t)
-    (set-extent-property ext 'end-open t)
-    (set-extent-end-glyph ext glyph)
-    (when help-echo
-      (set-extent-property ext 'balloon-help help-echo)
-      (set-extent-property ext 'help-echo help-echo)))
-  (when widget
-    (widget-put widget :glyph-up glyph)
-    (when down (widget-put widget :glyph-down down))
-    (when inactive (widget-put widget :glyph-inactive inactive))))
+IMAGE should either be an image or an image file name sans extension
+\(xpm, xbm, gif, jpg, or png) located in `widget-image-directory'.
+
+Optional arguments DOWN and INACTIVE are used instead of IMAGE when the
+button is pressed or inactive, respectively.  These are currently ignored."
+  (if (and (display-graphic-p)
+          (setq image (widget-image-find image)))
+      (progn (widget-put widget :suppress-face t)
+            (insert-image image
+                          (propertize
+                           tag 'mouse-face widget-button-pressed-face)))
+    (insert tag)))

 
 ;;; Buttons.
 
 
 ;;; Buttons.
 


@@ -710,7 +662,7 @@ glyphs used when the widget is pushed and inactive, respectively."
 
 ;;;###autoload
 (defun widget-create (type &rest args)
 
 ;;;###autoload
 (defun widget-create (type &rest args)

-  "Create widget of TYPE.  
+  "Create widget of TYPE.

 The optional ARGS are additional keyword arguments."
   (let ((widget (apply 'widget-convert type args)))
     (widget-apply widget :create)
 The optional ARGS are additional keyword arguments."
   (let ((widget (apply 'widget-convert type args)))
     (widget-apply widget :create)


@@ -730,7 +682,7 @@ The child is converted, using the keyword arguments ARGS."
 
 (defun widget-create-child (parent type)
   "Create widget of TYPE."
 
 (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)
     (widget-put widget :parent parent)
     (unless (widget-get widget :indent)
       (widget-put widget :indent (+ (or (widget-get parent :indent) 0)


@@ -741,7 +693,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."
 
 (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)
     (widget-put widget :value (widget-apply widget :value-to-internal value))
     (widget-put widget :parent parent)
     (unless (widget-get widget :indent)


@@ -756,28 +708,44 @@ The child is converted, using the keyword arguments ARGS."
   "Delete WIDGET."
   (widget-apply widget :delete))
 
   "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)
 (defun widget-convert (type &rest args)

-  "Convert TYPE to a widget without inserting it in the buffer. 
+  "Convert TYPE to a widget without inserting it in the buffer.

 The optional ARGS are additional keyword arguments."
   ;; Don't touch the type.
 The optional ARGS are additional keyword arguments."
   ;; Don't touch the type.

-  (let* ((widget (if (symbolp type) 
+  (let* ((widget (if (symbolp type)

                     (list type)
                   (copy-sequence type)))
         (current widget)
                     (list type)
                   (copy-sequence type)))
         (current widget)

+        done

         (keys args))
     ;; First set the :args keyword.
     (while (cdr current)               ;Look in the type.
         (keys args))
     ;; First set the :args keyword.
     (while (cdr current)               ;Look in the type.

-      (let ((next (car (cdr current))))
-       (if (and (symbolp next) (eq (aref (symbol-name next) 0) ?:))
-           (setq current (cdr (cdr current)))
-         (setcdr current (list :args (cdr current)))
-         (setq current nil))))
-    (while args                                ;Look in the args.
-      (let ((next (nth 0 args)))
-       (if (and (symbolp next) (eq (aref (symbol-name next) 0) ?:))
-           (setq args (nthcdr 2 args))
-         (widget-put widget :args args)
-         (setq args nil))))
+      (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 (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
     ;; Then Convert the widget.
     (setq type widget)
     (while type


@@ -786,27 +754,27 @@ The optional ARGS are additional keyword arguments."
            (setq widget (funcall convert-widget widget))))
       (setq type (get (car type) 'widget-type)))
     ;; Finally set the keyword args.
            (setq widget (funcall convert-widget widget))))
       (setq type (get (car type) 'widget-type)))
     ;; Finally set the keyword args.

-    (while keys 
+    (while keys

       (let ((next (nth 0 keys)))
       (let ((next (nth 0 keys)))

-       (if (and (symbolp next) (eq (aref (symbol-name next) 0) ?:))
-           (progn 
+       (if (keywordp next)
+           (progn

              (widget-put widget next (nth 1 keys))
              (setq keys (nthcdr 2 keys)))
          (setq keys nil))))
     ;; Convert the :value to internal format.
     (if (widget-member widget :value)
              (widget-put widget next (nth 1 keys))
              (setq keys (nthcdr 2 keys)))
          (setq keys nil))))
     ;; Convert the :value to internal format.
     (if (widget-member widget :value)

-       (let ((value (widget-get widget :value)))
-         (widget-put widget
-                     :value (widget-apply widget :value-to-internal value))))
+       (widget-put widget
+                   :value (widget-apply widget
+                                        :value-to-internal
+                                        (widget-get widget :value))))

     ;; Return the newly create widget.
     widget))
 
     ;; Return the newly create widget.
     widget))
 

+;;;###autoload

 (defun widget-insert (&rest args)
 (defun widget-insert (&rest args)

-  "Call `insert' with ARGS and make the text read only."
+  "Call `insert' with ARGS even if surrounding text is read only."

   (let ((inhibit-read-only t)
   (let ((inhibit-read-only t)

-       before-change-functions
-       after-change-functions
-       (from (point)))
+       (inhibit-modification-hooks t))

     (apply 'insert args)))
 
 (defun widget-convert-text (type from to
     (apply 'insert args)))
 
 (defun widget-convert-text (type from to


@@ -839,15 +807,12 @@ button end points."
 
 (defun widget-leave-text (widget)
   "Remove markers and overlays from WIDGET and its children."
 
 (defun widget-leave-text (widget)
   "Remove markers and overlays from WIDGET and its children."

-  (let ((from (widget-get widget :from))
-       (to (widget-get widget :to))
-       (button (widget-get widget :button-overlay))
+  (let ((button (widget-get widget :button-overlay))

        (sample (widget-get widget :sample-overlay))
        (doc (widget-get widget :doc-overlay))
        (sample (widget-get widget :sample-overlay))
        (doc (widget-get widget :doc-overlay))

-       (field (widget-get widget :field-overlay))
-       (children (widget-get widget :children)))
-    (set-marker from nil)
-    (set-marker to nil)
+       (field (widget-get widget :field-overlay)))
+    (set-marker (widget-get widget :from) nil)
+    (set-marker (widget-get widget :to) nil)

     (when button
       (delete-overlay button))
     (when sample
     (when button
       (delete-overlay button))
     (when sample


@@ -856,171 +821,150 @@ button end points."
       (delete-overlay doc))
     (when field
       (delete-overlay field))
       (delete-overlay doc))
     (when field
       (delete-overlay field))

-    (mapcar 'widget-leave-text children)))
+    (mapc 'widget-leave-text (widget-get widget :children))))

 
 ;;; Keymap and Commands.
 
 
 ;;; Keymap and Commands.
 

-(defvar widget-keymap nil
+;;;###autoload
+(defvar widget-keymap
+  (let ((map (make-sparse-keymap)))
+    (define-key map "\t" 'widget-forward)
+    (define-key map [(shift tab)] 'widget-backward)
+    (define-key map [backtab] 'widget-backward)
+    (define-key map [down-mouse-2] 'widget-button-click)
+    (define-key map "\C-m" 'widget-button-press)
+    map)

   "Keymap containing useful binding for buffers containing widgets.
 Recommended as a parent keymap for modes using widgets.")
 
   "Keymap containing useful binding for buffers containing widgets.
 Recommended as a parent keymap for modes using widgets.")
 

-(unless widget-keymap 
-  (setq widget-keymap (make-sparse-keymap))
-  (define-key widget-keymap "\t" 'widget-forward)
-  (define-key widget-keymap [(shift tab)] 'widget-backward)
-  (define-key widget-keymap [backtab] 'widget-backward)
-  (if (string-match "XEmacs" emacs-version)
-      (progn 
-       ;;Glyph support.
-       (define-key widget-keymap [button1] 'widget-button1-click) 
-       (define-key widget-keymap [button2] 'widget-button-click))
-    (define-key widget-keymap [down-mouse-2] 'widget-button-click))
-  (define-key widget-keymap "\C-m" 'widget-button-press))
-

 (defvar widget-global-map global-map
 (defvar widget-global-map global-map

-  "Keymap used for events the widget does not handle themselves.")
+  "Keymap used for events a widget does not handle itself.")

 (make-variable-buffer-local 'widget-global-map)
 
 (make-variable-buffer-local 'widget-global-map)
 

-(defvar widget-field-keymap nil
+(defvar widget-field-keymap
+  (let ((map (copy-keymap widget-keymap)))
+    (define-key map "\C-k" 'widget-kill-line)
+    (define-key map "\M-\t" 'widget-complete)
+    (define-key map "\C-m" 'widget-field-activate)
+    ;; Since the widget code uses a `field' property to identify fields,
+    ;; ordinary beginning-of-line does the right thing.
+    ;;  (define-key map "\C-a" 'widget-beginning-of-line)
+    (define-key map "\C-e" 'widget-end-of-line)
+    map)

   "Keymap used inside an editable field.")
 
   "Keymap used inside an editable field.")
 

-(unless widget-field-keymap 
-  (setq widget-field-keymap (copy-keymap widget-keymap))
-  (unless (string-match "XEmacs" (emacs-version))
-    (define-key widget-field-keymap [menu-bar] 'nil))
-  (define-key widget-field-keymap "\C-k" 'widget-kill-line)
-  (define-key widget-field-keymap "\M-\t" 'widget-complete)
-  (define-key widget-field-keymap "\C-m" 'widget-field-activate)
-  (define-key widget-field-keymap "\C-a" 'widget-beginning-of-line)
-  (define-key widget-field-keymap "\C-e" 'widget-end-of-line)
-  (set-keymap-parent widget-field-keymap global-map))
-
-(defvar widget-text-keymap nil
+(defvar widget-text-keymap
+  (let ((map (copy-keymap widget-keymap)))
+    ;; Since the widget code uses a `field' property to identify fields,
+    ;; ordinary beginning-of-line does the right thing.
+    ;;  (define-key map "\C-a" 'widget-beginning-of-line)
+    (define-key map "\C-e" 'widget-end-of-line)
+    map)

   "Keymap used inside a text field.")
 
   "Keymap used inside a text field.")
 

-(unless widget-text-keymap 
-  (setq widget-text-keymap (copy-keymap widget-keymap))
-  (unless (string-match "XEmacs" (emacs-version))
-    (define-key widget-text-keymap [menu-bar] 'nil))
-  (define-key widget-text-keymap "\C-a" 'widget-beginning-of-line)
-  (define-key widget-text-keymap "\C-e" 'widget-end-of-line)
-  (set-keymap-parent widget-text-keymap global-map))
-

 (defun widget-field-activate (pos &optional event)
 (defun widget-field-activate (pos &optional event)

-  "Invoke the ediable field at point."
+  "Invoke the editable field at point."

   (interactive "@d")
   (interactive "@d")

-  (let ((field (get-char-property pos 'field)))
+  (let ((field (widget-field-at pos)))

     (if field
        (widget-apply-action field event)
       (call-interactively
        (lookup-key widget-global-map (this-command-keys))))))
 
     (if field
        (widget-apply-action field event)
       (call-interactively
        (lookup-key widget-global-map (this-command-keys))))))
 

-(defface widget-button-pressed-face 
+(defface widget-button-pressed-face

   '((((class color))
      (:foreground "red"))
     (t
   '((((class color))
      (:foreground "red"))
     (t

-     (:bold t :underline t)))
+     (:weight bold :underline t)))

   "Face used for pressed buttons."
   :group 'widget-faces)
 
 (defun widget-button-click (event)
   "Face used for pressed buttons."
   :group 'widget-faces)
 
 (defun widget-button-click (event)

-  "Invoke the button that the mouse is pointing at, and move there."
-  (interactive "@e")
-  (mouse-set-point event)
-  (cond ((and (fboundp 'event-glyph)
-             (event-glyph event))
-        (widget-glyph-click event))
-       ((widget-event-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))
-                      (overlay-put overlay
-                                   'face 'widget-button-pressed-face)
-                      (overlay-put overlay 
-                                   'mouse-face 'widget-button-pressed-face)
-                      (unless (widget-apply button :mouse-down-action event)
-                        (while (not (button-release-event-p event))
-                          (setq event (widget-read-event)
-                                pos (widget-event-point event))
-                          (if (and pos
-                                   (eq (get-char-property pos 'button)
-                                       button))
-                              (progn 
-                                (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 (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.
-              (cond ((setq command     ;down event
-                           (lookup-key widget-global-map [ button2 ]))
-                     (setq up nil))
-                    ((setq command     ;down event
-                           (lookup-key widget-global-map [ down-mouse-2 ]))
-                     (setq up nil))
-                    ((setq command     ;up event
-                           (lookup-key widget-global-map [ button2up ])))
-                    ((setq command     ;up event
-                           (lookup-key widget-global-map [ mouse-2]))))
-              (when up
-                ;; Don't execute up events twice.
-                (while (not (button-release-event-p event))
-                  (setq event (widget-read-event))))
-              (when command
-                (call-interactively command))))))
-       (t
-        (message "You clicked somewhere weird."))))
-
-(defun widget-button1-click (event)
-  "Invoke glyph below mouse pointer."
-  (interactive "@e")
-  (if (and (fboundp 'event-glyph)
-          (event-glyph event))
-      (widget-glyph-click event)
-    (call-interactively (lookup-key widget-global-map (this-command-keys)))))
-
-(defun widget-glyph-click (event)
-  "Handle click on a glyph."
-  (let* ((glyph (event-glyph event))
-        (widget (glyph-property glyph 'widget))
-        (extent (event-glyph-extent event))
-        (down-glyph (or (and widget (widget-get widget :glyph-down)) glyph))
-        (up-glyph (or (and widget (widget-get widget :glyph-up)) glyph))
-        (last event))
-    ;; Wait for the release.
-    (while (not (button-release-event-p last))
-      (if (eq extent (event-glyph-extent last))
-         (set-extent-property extent 'end-glyph down-glyph)
-       (set-extent-property extent 'end-glyph up-glyph))
-      (setq last (read-event event)))
-    ;; Release glyph.
-    (when down-glyph
-      (set-extent-property extent 'end-glyph up-glyph))
-    ;; Apply widget action.
-    (when (eq extent (event-glyph-extent last))
-      (let ((widget (glyph-property (event-glyph event) 'widget)))
-       (cond ((null widget)
-              (message "You clicked on a glyph."))
-             ((not (widget-apply widget :active))
-              (message "This glyph is inactive."))
-             (t
-              (widget-apply-action widget event)))))))
+  "Invoke the button that the mouse is pointing at."
+  (interactive "e")
+  (if (widget-event-point event)
+      (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.
+                     (let ((track-mouse t))
+                       (save-excursion
+                         (when face    ; avoid changing around image
+                           (overlay-put overlay
+                                        'face widget-button-pressed-face)
+                           (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))))
+
+                         ;; 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))))
+
+             (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]))
+                        (setq up nil))
+                       ((setq command  ;up event
+                              (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)
   "Invoke button at POS."
 
 (defun widget-button-press (pos &optional event)
   "Invoke button at POS."


@@ -1035,42 +979,35 @@ Recommended as a parent keymap for modes using widgets.")
 (defun widget-tabable-at (&optional pos)
   "Return the tabable widget at POS, or nil.
 POS defaults to the value of (point)."
 (defun widget-tabable-at (&optional pos)
   "Return the tabable widget at POS, or nil.
 POS defaults to the value of (point)."

-  (unless pos
-    (setq pos (point)))
-  (let ((widget (or (get-char-property (point) 'button)
-                   (get-char-property (point) 'field))))
+  (let ((widget (widget-at pos)))

     (if widget
        (let ((order (widget-get widget :tab-order)))
          (if order
              (if (>= order 0)
     (if widget
        (let ((order (widget-get widget :tab-order)))
          (if order
              (if (>= order 0)

-                 widget
-               nil)
-           widget))
-      nil)))
+                 widget)
+           widget)))))

 
 

-(defcustom widget-use-overlay-change (string-match "XEmacs" emacs-version)
+(defvar widget-use-overlay-change t

   "If non-nil, use overlay change functions to tab around in the buffer.
   "If non-nil, use overlay change functions to tab around in the buffer.

-This is much faster, but doesn't work reliably on Emacs 19.34."
-  :type 'boolean
-  :group 'widgets)
+This is much faster, but doesn't work reliably on Emacs 19.34.")

 
 (defun widget-move (arg)
   "Move point to the ARG next field or button.
 ARG may be negative to move backward."
   (or (bobp) (> arg 0) (backward-char))
 
 (defun widget-move (arg)
   "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)
        (number arg)

-       (old (widget-tabable-at))
-       new)
+       (old (widget-tabable-at)))

     ;; Forward.
     (while (> arg 0)
       (cond ((eobp)
     ;; 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)))
            (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)))
           (eq arg number)
           (error "No buttons or fields found"))
       (let ((new (widget-tabable-at)))


@@ -1081,12 +1018,13 @@ ARG may be negative to move backward."
     ;; Backward.
     (while (< arg 0)
       (cond ((bobp)
     ;; 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)))
            (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)))
           (eq arg number)
           (error "No buttons or fields found"))
       (let ((new (widget-tabable-at)))


@@ -1114,37 +1052,30 @@ With optional ARG, move across that many fields."
   (run-hooks 'widget-backward-hook)
   (widget-move (- arg)))
 
   (run-hooks 'widget-backward-hook)
   (widget-move (- arg)))
 

-(defun widget-beginning-of-line ()
-  "Go to beginning of field or beginning of line, whichever is first."
-  (interactive)
-  (let* ((field (widget-field-find (point)))
-        (start (and field (widget-field-start field)))
-         (bol (save-excursion
-                (beginning-of-line)
-                (point))))
-    (goto-char (if start
-                   (max start bol)
-                 bol))))
+;; Since the widget code uses a `field' property to identify fields,
+;; ordinary beginning-of-line does the right thing.
+(defalias 'widget-beginning-of-line 'beginning-of-line)

 
 (defun widget-end-of-line ()
 
 (defun widget-end-of-line ()

-  "Go to end of field or end of line, whichever is first."
+  "Go to end of field or end of line, whichever is first.
+Trailing spaces at the end of padded fields are not considered part of
+the field."

   (interactive)
   (interactive)

-  (let* ((field (widget-field-find (point)))
-        (end (and field (widget-field-end field)))
-         (eol (save-excursion
-                (end-of-line)
-                (point))))
-    (goto-char (if end
-                   (min end eol)
-                 eol))))
+  ;; Ordinary end-of-line does the right thing, because we're inside
+  ;; text with a `field' property.
+  (end-of-line)
+  (unless (eolp)
+    ;; ... except that we want to ignore trailing spaces in fields that
+    ;; aren't terminated by a newline, because they are used as padding,
+    ;; and ignored when extracting the entered value of the field.
+    (skip-chars-backward " " (field-beginning (1- (point))))))

 
 (defun widget-kill-line ()
   "Kill to end of field or end of line, whichever is first."
   (interactive)
   (let* ((field (widget-field-find (point)))
 
 (defun widget-kill-line ()
   "Kill to end of field or end of line, whichever is first."
   (interactive)
   (let* ((field (widget-field-find (point)))

-        (newline (save-excursion (forward-line 1) (point)))

         (end (and field (widget-field-end field))))
         (end (and field (widget-field-end field))))

-    (if (and field (> newline end))
+    (if (and field (> (line-beginning-position 2) end))

        (kill-region (point) end)
       (call-interactively 'kill-line))))
 
        (kill-region (point) end)
       (call-interactively 'kill-line))))
 


@@ -1154,30 +1085,44 @@ With optional ARG, move across that many fields."
   :type 'function
   :group 'widgets)
 
   :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
 (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.
 
 
 ;;; 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)
 
 (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)
 
 (make-variable-buffer-local 'widget-field-list)
 

+(defun widget-at (&optional pos)
+  "The button or field at POS (default, point)."
+  (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)
 (defun widget-setup ()
   "Setup current buffer so editing string widgets works."
   (let ((inhibit-read-only t)

-       (after-change-functions nil)
-       before-change-functions
+       (inhibit-modification-hooks t)

        field)
     (while widget-field-new
       (setq field (car widget-field-new)
        field)
     (while widget-field-new
       (setq field (car widget-field-new)


@@ -1185,7 +1130,7 @@ When not inside a field, move to the previous button or field."
            widget-field-list (cons field widget-field-list))
       (let ((from (car (widget-get field :field-overlay)))
            (to (cdr (widget-get field :field-overlay))))
            widget-field-list (cons field widget-field-list))
       (let ((from (car (widget-get field :field-overlay)))
            (to (cdr (widget-get field :field-overlay))))

-       (widget-specify-field field 
+       (widget-specify-field field

                              (marker-position from) (marker-position to))
        (set-marker from nil)
        (set-marker to nil))))
                              (marker-position from) (marker-position to))
        (set-marker from nil)
        (set-marker to nil))))


@@ -1200,24 +1145,44 @@ When not inside a field, move to the previous button or field."
 ;; The widget data before the change.
 (make-variable-buffer-local 'widget-field-was)
 
 ;; The widget data before the change.
 (make-variable-buffer-local 'widget-field-was)
 

+(defun widget-field-at (pos)
+  "Return the widget field at POS, or nil if none."
+  (let ((field (get-char-property (or pos (point)) 'field)))
+    (if (eq field 'boundary)
+       nil
+      field)))
+

 (defun widget-field-buffer (widget)
 (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)))
   (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)))
 
 (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."
   (let ((overlay (widget-get widget :field-overlay)))
 
 (defun widget-field-end (widget)
   "Return the end of WIDGET's editing field."
   (let ((overlay (widget-get widget :field-overlay)))

-    ;; Don't subtract one if local-map works at the end of the overlay.
-    (and overlay (if (or widget-field-add-space
-                        (null (widget-get widget :size)))
-                    (1- (overlay-end overlay))
-                  (overlay-end overlay)))))
+    ;; 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.
+    (if (overlayp 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))
+      (cdr overlay))))

 
 (defun widget-field-find (pos)
   "Return the field at POS.
 
 (defun widget-field-find (pos)
   "Return the field at POS.


@@ -1227,12 +1192,11 @@ Unlike (get-char-property POS 'field) this, works with empty fields too."
     (while fields
       (setq field (car fields)
            fields (cdr fields))
     (while fields
       (setq field (car fields)
            fields (cdr fields))

-      (let ((start (widget-field-start field))
-           (end (widget-field-end field)))
-       (when (and (<= start pos) (<= pos end))
-         (when found
-           (debug "Overlapping fields"))
-         (setq found field))))
+      (when (and (<= (widget-field-start field) pos)
+                (<= pos (widget-field-end field)))
+       (when found
+         (error "Overlapping fields"))
+       (setq found field)))

     found))
 
 (defun widget-before-change (from to)
     found))
 
 (defun widget-before-change (from to)


@@ -1243,60 +1207,55 @@ Unlike (get-char-property POS 'field) this, works with empty fields too."
          (to-field (widget-field-find to)))
       (cond ((not (eq from-field to-field))
             (add-hook 'post-command-hook 'widget-add-change nil t)
          (to-field (widget-field-find to)))
       (cond ((not (eq from-field to-field))
             (add-hook 'post-command-hook 'widget-add-change nil t)

-            (error "Change should be restricted to a single field"))
+            (signal 'text-read-only
+                    '("Change should be restricted to a single field")))

            ((null from-field)
             (add-hook 'post-command-hook 'widget-add-change nil t)
            ((null from-field)
             (add-hook 'post-command-hook 'widget-add-change nil t)

-            (error "Attempt to change text outside editable field"))
+            (signal 'text-read-only
+                    '("Attempt to change text outside editable field")))

            (widget-field-use-before-change
            (widget-field-use-before-change

-            (condition-case nil
-                (widget-apply from-field :notify from-field)
-              (error (debug "Before Change"))))))))
+            (widget-apply from-field :notify from-field))))))

 
 (defun widget-add-change ()
 
 (defun widget-add-change ()

-  (make-local-hook 'post-command-hook)

   (remove-hook 'post-command-hook 'widget-add-change t)
   (remove-hook 'post-command-hook 'widget-add-change t)

-  (make-local-hook 'before-change-functions)

   (add-hook 'before-change-functions 'widget-before-change nil t)
   (add-hook 'before-change-functions 'widget-before-change nil t)

-  (make-local-hook 'after-change-functions)

   (add-hook 'after-change-functions 'widget-after-change nil t))
 
 (defun widget-after-change (from to old)
   (add-hook 'after-change-functions 'widget-after-change nil t))
 
 (defun widget-after-change (from to old)

-  ;; Adjust field size and text properties.
-  (condition-case nil
-      (let ((field (widget-field-find from))
-           (other (widget-field-find to)))
-       (when field
-         (unless (eq field other)
-           (debug "Change in different fields"))
-         (let ((size (widget-get field :size)))
-           (when size 
-             (let ((begin (widget-field-start field))
-                   (end (widget-field-end field)))
-               (cond ((< (- end begin) size)
-                      ;; Field too small.
-                      (save-excursion
-                        (goto-char end)
-                        (insert-char ?\  (- (+ begin size) end))))
-                     ((> (- end begin) size)
-                      ;; Field too large and
-                      (if (or (< (point) (+ begin size))
-                              (> (point) end))
-                          ;; Point is outside extra space.
-                          (setq begin (+ begin size))
-                        ;; Point is within the extra space.
-                        (setq begin (point)))
-                      (save-excursion
-                        (goto-char end)
-                        (while (and (eq (preceding-char) ?\ )
-                                    (> (point) begin))
-                          (delete-backward-char 1)))))))
-           (widget-specify-secret field))
-         (widget-apply field :notify field)))
-    (error (debug "After Change"))))
+  "Adjust field size and text properties."
+  (let ((field (widget-field-find from))
+       (other (widget-field-find to)))
+    (when field
+      (unless (eq field other)
+       (error "Change in different fields"))
+      (let ((size (widget-get field :size)))
+       (when size
+         (let ((begin (widget-field-start field))
+               (end (widget-field-end field)))
+           (cond ((< (- end begin) size)
+                  ;; Field too small.
+                  (save-excursion
+                    (goto-char end)
+                    (insert-char ?\  (- (+ begin size) end))))
+                 ((> (- end begin) size)
+                  ;; Field too large and
+                  (if (or (< (point) (+ begin size))
+                          (> (point) end))
+                      ;; Point is outside extra space.
+                      (setq begin (+ begin size))
+                    ;; Point is within the extra space.
+                    (setq begin (point)))
+                  (save-excursion
+                    (goto-char end)
+                    (while (and (eq (preceding-char) ?\ )
+                                (> (point) begin))
+                      (delete-backward-char 1)))))))
+       (widget-specify-secret field))
+      (widget-apply field :notify field))))

 
 ;;; Widget Functions
 ;;
 
 ;;; Widget Functions
 ;;

-;; These functions are used in the definition of multiple widgets. 
+;; These functions are used in the definition of multiple widgets.

 
 (defun widget-parent-action (widget &optional event)
   "Tell :parent of WIDGET to handle the :action.
 
 (defun widget-parent-action (widget &optional event)
   "Tell :parent of WIDGET to handle the :action.


@@ -1305,9 +1264,9 @@ Optional EVENT is the event that triggered the action."
 
 (defun widget-children-value-delete (widget)
   "Delete all :children and :buttons in WIDGET."
 
 (defun widget-children-value-delete (widget)
   "Delete all :children and :buttons in WIDGET."

-  (mapcar 'widget-delete (widget-get widget :children))
+  (mapc 'widget-delete (widget-get widget :children))

   (widget-put widget :children nil)
   (widget-put widget :children nil)

-  (mapcar 'widget-delete (widget-get widget :buttons))
+  (mapc 'widget-delete (widget-get widget :buttons))

   (widget-put widget :buttons nil))
 
 (defun widget-children-validate (widget)
   (widget-put widget :buttons nil))
 
 (defun widget-children-validate (widget)


@@ -1320,7 +1279,49 @@ Optional EVENT is the event that triggered the action."
            found (widget-apply child :validate)))
     found))
 
            found (widget-apply child :validate)))
     found))
 

-(defun widget-types-convert-widget (widget)
+(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."
   (widget-put widget :args (mapcar 'widget-convert (widget-get widget :args)))
   widget)
   "Convert :args as widget types in WIDGET."
   (widget-put widget :args (mapcar 'widget-convert (widget-get widget :args)))
   widget)


@@ -1328,7 +1329,7 @@ Optional EVENT is the event that triggered the action."
 (defun widget-value-convert-widget (widget)
   "Initialize :value from :args in WIDGET."
   (let ((args (widget-get widget :args)))
 (defun widget-value-convert-widget (widget)
   "Initialize :value from :args in WIDGET."
   (let ((args (widget-get widget :args)))

-    (when args 
+    (when args

       (widget-put widget :value (car args))
       ;; Don't convert :value here, as this is done in `widget-convert'.
       ;; (widget-put widget :value (widget-apply widget
       (widget-put widget :value (car args))
       ;; Don't convert :value here, as this is done in `widget-convert'.
       ;; (widget-put widget :value (widget-apply widget


@@ -1348,23 +1349,25 @@ Optional EVENT is the event that triggered the action."
   :value-to-external (lambda (widget value) value)
   :button-prefix 'widget-button-prefix
   :button-suffix 'widget-button-suffix
   :value-to-external (lambda (widget value) value)
   :button-prefix 'widget-button-prefix
   :button-suffix 'widget-button-suffix

-  :complete 'widget-default-complete                                  
+  :complete 'widget-default-complete

   :create 'widget-default-create
   :indent nil
   :offset 0
   :format-handler 'widget-default-format-handler
   :create 'widget-default-create
   :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
   :delete 'widget-default-delete

+  :copy 'identity

   :value-set 'widget-default-value-set
   :value-inline 'widget-default-value-inline
   :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
   :default-get 'widget-default-default-get
   :menu-tag-get 'widget-default-menu-tag-get

-  :validate (lambda (widget) nil)
+  :validate #'ignore

   :active 'widget-default-active
   :activate 'widget-specify-active
   :deactivate 'widget-default-deactivate
   :active 'widget-default-active
   :activate 'widget-specify-active
   :deactivate 'widget-default-deactivate

-  :mouse-down-action (lambda (widget event) nil)
+  :mouse-down-action #'ignore

   :action 'widget-default-action
   :notify 'widget-default-notify
   :prompt-value 'widget-default-prompt-value)
   :action 'widget-default-action
   :notify 'widget-default-notify
   :prompt-value 'widget-default-prompt-value)


@@ -1372,8 +1375,8 @@ Optional EVENT is the event that triggered the action."
 (defun widget-default-complete (widget)
   "Call the value of the :complete-function property of WIDGET.
 If that does not exists, call the value of `widget-complete-field'."
 (defun widget-default-complete (widget)
   "Call the value of the :complete-function property of WIDGET.
 If that does not exists, call the value of `widget-complete-field'."

-  (let ((fun (widget-get widget :complete-function)))
-    (call-interactively (or fun widget-complete-field))))
+  (call-interactively (or (widget-get widget :complete-function)
+                         widget-complete-field)))

 
 (defun widget-default-create (widget)
   "Create WIDGET at point in the current buffer."
 
 (defun widget-default-create (widget)
   "Create WIDGET at point in the current buffer."


@@ -1387,10 +1390,10 @@ If that does not exists, call the value of `widget-complete-field'."
      (goto-char from)
      ;; Parse escapes in format.
      (while (re-search-forward "%\\(.\\)" nil t)
      (goto-char from)
      ;; Parse escapes in format.
      (while (re-search-forward "%\\(.\\)" nil t)

-       (let ((escape (aref (match-string 1) 0)))
-        (replace-match "" t t)
+       (let ((escape (char-after (match-beginning 1))))
+        (delete-backward-char 2)

         (cond ((eq escape ?%)
         (cond ((eq escape ?%)

-               (insert "%"))
+               (insert ?%))

               ((eq escape ?\[)
                (setq button-begin (point))
                (insert (widget-get-indirect widget :button-prefix)))
               ((eq escape ?\[)
                (setq button-begin (point))
                (insert (widget-get-indirect widget :button-prefix)))


@@ -1403,18 +1406,18 @@ If that does not exists, call the value of `widget-complete-field'."
                (setq sample-end (point)))
               ((eq escape ?n)
                (when (widget-get widget :indent)
                (setq sample-end (point)))
               ((eq escape ?n)
                (when (widget-get widget :indent)

-                 (insert "\n")
+                 (insert ?\n)

                  (insert-char ?  (widget-get widget :indent))))
               ((eq escape ?t)
                  (insert-char ?  (widget-get widget :indent))))
               ((eq escape ?t)

-               (let ((glyph (widget-get widget :tag-glyph))
+               (let ((image (widget-get widget :tag-glyph))

                      (tag (widget-get widget :tag)))
                      (tag (widget-get widget :tag)))

-                 (cond (glyph 
-                        (widget-glyph-insert widget (or tag "image") glyph))
+                 (cond (image
+                        (widget-image-insert widget (or tag "image") image))

                        (tag
                         (insert tag))
                        (t
                        (tag
                         (insert tag))
                        (t

-                        (let ((standard-output (current-buffer)))
-                          (princ (widget-get widget :value)))))))
+                        (princ (widget-get widget :value)
+                               (current-buffer))))))

               ((eq escape ?d)
                (let ((doc (widget-get widget :doc)))
                  (when doc
               ((eq escape ?d)
                (let ((doc (widget-get widget :doc)))
                  (when doc


@@ -1422,13 +1425,13 @@ If that does not exists, call the value of `widget-complete-field'."
                    (insert doc)
                    (while (eq (preceding-char) ?\n)
                      (delete-backward-char 1))
                    (insert doc)
                    (while (eq (preceding-char) ?\n)
                      (delete-backward-char 1))

-                   (insert "\n")
+                   (insert ?\n)

                    (setq doc-end (point)))))
               ((eq escape ?v)
                (if (and button-begin (not button-end))
                    (widget-apply widget :value-create)
                  (setq value-pos (point))))
                    (setq doc-end (point)))))
               ((eq escape ?v)
                (if (and button-begin (not button-end))
                    (widget-apply widget :value-create)
                  (setq value-pos (point))))

-              (t 
+              (t

                (widget-apply widget :format-handler escape)))))
      ;; Specify button, sample, and doc, and insert value.
      (and button-begin button-end
                (widget-apply widget :format-handler escape)))))
      ;; Specify button, sample, and doc, and insert value.
      (and button-begin button-end


@@ -1440,8 +1443,8 @@ If that does not exists, call the value of `widget-complete-field'."
      (when value-pos
        (goto-char value-pos)
        (widget-apply widget :value-create)))
      (when value-pos
        (goto-char value-pos)
        (widget-apply widget :value-create)))

-   (let ((from (copy-marker (point-min)))
-        (to (copy-marker (point-max))))
+   (let ((from (point-min-marker))
+        (to (point-max-marker)))

      (set-marker-insertion-type from t)
      (set-marker-insertion-type to nil)
      (widget-put widget :from from)
      (set-marker-insertion-type from t)
      (set-marker-insertion-type to nil)
      (widget-put widget :from from)


@@ -1454,13 +1457,13 @@ If that does not exists, call the value of `widget-complete-field'."
     (cond ((eq escape ?h)
           (let* ((doc-property (widget-get widget :documentation-property))
                  (doc-try (cond ((widget-get widget :doc))
     (cond ((eq escape ?h)
           (let* ((doc-property (widget-get widget :documentation-property))
                  (doc-try (cond ((widget-get widget :doc))

+                                ((functionp doc-property)
+                                 (funcall doc-property
+                                          (widget-get widget :value)))

                                 ((symbolp doc-property)
                                 ((symbolp doc-property)

-                                 (documentation-property 
+                                 (documentation-property

                                   (widget-get widget :value)
                                   (widget-get widget :value)

-                                  doc-property))
-                                (t
-                                 (funcall doc-property
-                                          (widget-get widget :value)))))
+                                  doc-property))))

                  (doc-text (and (stringp doc-try)
                                 (> (length doc-try) 1)
                                 doc-try))
                  (doc-text (and (stringp doc-try)
                                 (> (length doc-try) 1)
                                 doc-try))


@@ -1484,7 +1487,7 @@ If that does not exists, call the value of `widget-complete-field'."
                                    (t 0))
                      doc-text)
                     buttons))))
                                    (t 0))
                      doc-text)
                     buttons))))

-         (t 
+         (t

           (error "Unknown escape `%c'" escape)))
     (widget-put widget :buttons buttons)))
 
           (error "Unknown escape `%c'" escape)))
     (widget-put widget :buttons buttons)))
 


@@ -1501,17 +1504,17 @@ If that does not exists, call the value of `widget-complete-field'."
   (widget-get widget :sample-face))
 
 (defun widget-default-delete (widget)
   (widget-get widget :sample-face))
 
 (defun widget-default-delete (widget)

-  ;; Remove widget from the buffer.
+  "Remove widget from the buffer."

   (let ((from (widget-get widget :from))
        (to (widget-get widget :to))
        (inactive-overlay (widget-get widget :inactive))
        (button-overlay (widget-get widget :button-overlay))
        (sample-overlay (widget-get widget :sample-overlay))
        (doc-overlay (widget-get widget :doc-overlay))
   (let ((from (widget-get widget :from))
        (to (widget-get widget :to))
        (inactive-overlay (widget-get widget :inactive))
        (button-overlay (widget-get widget :button-overlay))
        (sample-overlay (widget-get widget :sample-overlay))
        (doc-overlay (widget-get widget :doc-overlay))

-       before-change-functions
-       after-change-functions
+       (inhibit-modification-hooks t)

        (inhibit-read-only t))
     (widget-apply widget :value-delete)
        (inhibit-read-only t))
     (widget-apply widget :value-delete)

+    (widget-children-value-delete widget)

     (when inactive-overlay
       (delete-overlay inactive-overlay))
     (when button-overlay
     (when inactive-overlay
       (delete-overlay inactive-overlay))
     (when button-overlay


@@ -1528,7 +1531,7 @@ If that does not exists, call the value of `widget-complete-field'."
   (widget-clear-undo))
 
 (defun widget-default-value-set (widget value)
   (widget-clear-undo))
 
 (defun widget-default-value-set (widget value)

-  ;; Recreate widget with new value.
+  "Recreate widget with new value."

   (let* ((old-pos (point))
         (from (copy-marker (widget-get widget :from)))
         (to (copy-marker (widget-get widget :to)))
   (let* ((old-pos (point))
         (from (copy-marker (widget-get widget :from)))
         (to (copy-marker (widget-get widget :to)))


@@ -1537,7 +1540,7 @@ If that does not exists, call the value of `widget-complete-field'."
                         (- old-pos to 1)
                       (- old-pos from)))))
     ;;??? Bug: this ought to insert the new value before deleting the old one,
                         (- old-pos to 1)
                       (- old-pos from)))))
     ;;??? Bug: this ought to insert the new value before deleting the old one,

-    ;; so that markers on either side of the value automatically 
+    ;; so that markers on either side of the value automatically

     ;; stay on the same side.  -- rms.
     (save-excursion
       (goto-char (widget-get widget :from))
     ;; stay on the same side.  -- rms.
     (save-excursion
       (goto-char (widget-get widget :from))


@@ -1550,27 +1553,28 @@ If that does not exists, call the value of `widget-complete-field'."
          (goto-char (min (+ from offset) (1- (widget-get widget :to))))))))
 
 (defun widget-default-value-inline (widget)
          (goto-char (min (+ from offset) (1- (widget-get widget :to))))))))
 
 (defun widget-default-value-inline (widget)

-  ;; Wrap value in a list unless it is inline.
+  "Wrap value in a list unless it is inline."

   (if (widget-get widget :inline)
       (widget-value widget)
     (list (widget-value widget))))
 
 (defun widget-default-default-get (widget)
   (if (widget-get widget :inline)
       (widget-value widget)
     (list (widget-value widget))))
 
 (defun widget-default-default-get (widget)

-  ;; Get `:value'.
+  "Get `:value'."

   (widget-get widget :value))
 
 (defun widget-default-menu-tag-get (widget)
   (widget-get widget :value))
 
 (defun widget-default-menu-tag-get (widget)

-  ;; Use tag or value for menus.
+  "Use tag or value for menus."

   (or (widget-get widget :menu-tag)
       (widget-get widget :tag)
       (widget-princ-to-string (widget-get widget :value))))
 
 (defun widget-default-active (widget)
   "Return t iff this widget active (user modifiable)."
   (or (widget-get widget :menu-tag)
       (widget-get widget :tag)
       (widget-princ-to-string (widget-get widget :value))))
 
 (defun widget-default-active (widget)
   "Return t iff this widget active (user modifiable)."

-  (and (not (widget-get widget :inactive))
-       (let ((parent (widget-get widget :parent)))
-        (or (null parent) 
-            (widget-apply parent :active)))))
+  (or (widget-get widget :always-active)
+      (and (not (widget-get widget :inactive))
+          (let ((parent (widget-get widget :parent)))
+            (or (null parent)
+                (widget-apply parent :active))))))

 
 (defun widget-default-deactivate (widget)
   "Make WIDGET inactive for user modifications."
 
 (defun widget-default-deactivate (widget)
   "Make WIDGET inactive for user modifications."


@@ -1579,22 +1583,22 @@ If that does not exists, call the value of `widget-complete-field'."
                           (widget-get widget :to)))
 
 (defun widget-default-action (widget &optional event)
                           (widget-get widget :to)))
 
 (defun widget-default-action (widget &optional event)

-  ;; Notify the parent when a widget change
+  "Notify the parent when a widget changes."

   (let ((parent (widget-get widget :parent)))
     (when parent
       (widget-apply parent :notify widget event))))
 
 (defun widget-default-notify (widget child &optional event)
   (let ((parent (widget-get widget :parent)))
     (when parent
       (widget-apply parent :notify widget event))))
 
 (defun widget-default-notify (widget child &optional event)

-  ;; Pass notification to parent.
+  "Pass notification to parent."

   (widget-default-action widget event))
 
 (defun widget-default-prompt-value (widget prompt value unbound)
   (widget-default-action widget event))
 
 (defun widget-default-prompt-value (widget prompt value unbound)

-  ;; Read an arbitrary value.  Stolen from `set-variable'.
-;;  (let ((initial (if unbound
-;;                  nil
-;;                ;; It would be nice if we could do a `(cons val 1)' here.
-;;                (prin1-to-string (custom-quote value))))))
-  (eval-minibuffer prompt ))
+  "Read an arbitrary value.  Stolen from `set-variable'."
+;; (let ((initial (if unbound
+;; nil
+;; It would be nice if we could do a `(cons val 1)' here.
+;; (prin1-to-string (custom-quote value))))))
+  (eval-minibuffer prompt))

 
 ;;; The `item' Widget.
 
 
 ;;; The `item' Widget.
 


@@ -1610,9 +1614,8 @@ If that does not exists, call the value of `widget-complete-field'."
   :format "%t\n")
 
 (defun widget-item-value-create (widget)
   :format "%t\n")
 
 (defun widget-item-value-create (widget)

-  ;; Insert the printed representation of the value.
-  (let ((standard-output (current-buffer)))
-    (princ (widget-get widget :value))))
+  "Insert the printed representation of the value."
+  (princ (widget-get widget :value) (current-buffer)))

 
 (defun widget-item-match (widget value)
   ;; Match if the value is the same.
 
 (defun widget-item-match (widget value)
   ;; Match if the value is the same.


@@ -1632,8 +1635,7 @@ If that does not exists, call the value of `widget-complete-field'."
 If END is omitted, it defaults to the length of LIST."
   (if (> start 0) (setq list (nthcdr start list)))
   (if end
 If END is omitted, it defaults to the length of LIST."
   (if (> start 0) (setq list (nthcdr start list)))
   (if end

-      (if (<= end start)
-         nil
+      (unless (<= end start)

        (setq list (copy-sequence list))
        (setcdr (nthcdr (- end start 1) list) nil)
        list)
        (setq list (copy-sequence list))
        (setcdr (nthcdr (- end start 1) list) nil)
        list)


@@ -1645,13 +1647,13 @@ If END is omitted, it defaults to the length of LIST."
 
 ;;; The `push-button' Widget.
 
 
 ;;; The `push-button' Widget.
 

-(defcustom widget-push-button-gui t
-  "If non nil, use GUI push buttons when available."
-  :group 'widgets
-  :type 'boolean)
+;; (defcustom widget-push-button-gui t
+;;   "If non nil, use GUI push buttons when available."
+;;   :group 'widgets
+;;   :type 'boolean)

 
 ;; Cache already created GUI objects.
 
 ;; Cache already created GUI objects.

-(defvar widget-push-button-cache nil)
+;; (defvar widget-push-button-cache nil)

 
 (defcustom widget-push-button-prefix "["
   "String used as prefix for buttons."
 
 (defcustom widget-push-button-prefix "["
   "String used as prefix for buttons."


@@ -1671,40 +1673,19 @@ If END is omitted, it defaults to the length of LIST."
   :format "%[%v%]")
 
 (defun widget-push-button-value-create (widget)
   :format "%[%v%]")
 
 (defun widget-push-button-value-create (widget)

-  ;; Insert text representing the `on' and `off' states.
+  "Insert text representing the `on' and `off' states."

   (let* ((tag (or (widget-get widget :tag)
                  (widget-get widget :value)))
         (tag-glyph (widget-get widget :tag-glyph))
         (text (concat widget-push-button-prefix
   (let* ((tag (or (widget-get widget :tag)
                  (widget-get widget :value)))
         (tag-glyph (widget-get widget :tag-glyph))
         (text (concat widget-push-button-prefix

-                      tag widget-push-button-suffix))
-        (gui (cdr (assoc tag widget-push-button-cache))))
-    (cond (tag-glyph
-          (widget-glyph-insert widget text tag-glyph))
-         ((and (fboundp 'make-gui-button)
-            (fboundp 'make-glyph)
-            widget-push-button-gui
-            (fboundp 'device-on-window-system-p)
-            (device-on-window-system-p)
-            (string-match "XEmacs" emacs-version))
-          (unless gui
-            (setq gui (make-gui-button tag 'widget-gui-action widget))
-            (push (cons tag gui) widget-push-button-cache))
-          (widget-glyph-insert-glyph widget
-                                     (make-glyph
-                                      (list (nth 0 (aref gui 1))
-                                            (vector 'string ':data text)))
-                                     (make-glyph
-                                      (list (nth 1 (aref gui 1))
-                                            (vector 'string ':data text)))
-                                     (make-glyph
-                                      (list (nth 2 (aref gui 1))
-                                            (vector 'string ':data text)))))
-         (t
-          (insert text)))))
+                      tag widget-push-button-suffix)))
+    (if tag-glyph
+       (widget-image-insert widget text tag-glyph)
+      (insert text))))

 
 

-(defun widget-gui-action (widget)
-  "Apply :action for WIDGET."
-  (widget-apply-action widget (this-command-keys)))
+;; (defun widget-gui-action (widget)
+;;   "Apply :action for WIDGET."
+;;   (widget-apply-action widget (this-command-keys)))

 
 ;;; The `link' Widget.
 
 
 ;;; The `link' Widget.
 


@@ -1733,7 +1714,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."
 
 (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.
 
 
 ;;; The `url-link' Widget.
 


@@ -1786,11 +1767,11 @@ If END is omitted, it defaults to the length of LIST."
   (find-file (locate-library (widget-value widget))))
 
 ;;; The `emacs-commentary-link' 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)
 (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)))
 (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)))


@@ -1802,6 +1783,7 @@ If END is omitted, it defaults to the length of LIST."
   :convert-widget 'widget-value-convert-widget
   :keymap widget-field-keymap
   :format "%v"
   :convert-widget 'widget-value-convert-widget
   :keymap widget-field-keymap
   :format "%v"

+  :help-echo "M-TAB: complete field; RET: enter value"

   :value ""
   :prompt-internal 'widget-field-prompt-internal
   :prompt-history 'widget-field-history
   :value ""
   :prompt-internal 'widget-field-prompt-internal
   :prompt-history 'widget-field-history


@@ -1809,7 +1791,7 @@ If END is omitted, it defaults to the length of LIST."
   :action 'widget-field-action
   :validate 'widget-field-validate
   :valid-regexp ""
   :action 'widget-field-action
   :validate 'widget-field-validate
   :valid-regexp ""

-  :error "No match"
+  :error "Field's value doesn't match allowed forms"

   :value-create 'widget-field-value-create
   :value-delete 'widget-field-value-delete
   :value-get 'widget-field-value-get
   :value-create 'widget-field-value-create
   :value-delete 'widget-field-value-delete
   :value-get 'widget-field-value-get


@@ -1819,46 +1801,44 @@ If END is omitted, it defaults to the length of LIST."
   "History of field minibuffer edits.")
 
 (defun widget-field-prompt-internal (widget prompt initial history)
   "History of field minibuffer edits.")
 
 (defun widget-field-prompt-internal (widget prompt initial history)

-  ;; Read string for WIDGET promptinhg with PROMPT.
-  ;; INITIAL is the initial input and HISTORY is a symbol containing
-  ;; the earlier input.
+  "Read string for WIDGET promptinhg with PROMPT.
+INITIAL is the initial input and HISTORY is a symbol containing
+the earlier input."

   (read-string prompt initial history))
 
 (defun widget-field-prompt-value (widget prompt value unbound)
   (read-string prompt initial history))
 
 (defun widget-field-prompt-value (widget prompt value unbound)

-  ;; Prompt for a string.
-  (let ((initial (if unbound
-                    nil
-                  (cons (widget-apply widget :value-to-internal
-                                      value) 0)))
-       (history (widget-get widget :prompt-history)))
-    (let ((answer (widget-apply widget
-                               :prompt-internal prompt initial history)))
-      (widget-apply widget :value-to-external answer))))
+  "Prompt for a string."
+  (widget-apply widget
+               :value-to-external
+               (widget-apply widget
+                             :prompt-internal prompt
+                             (unless unbound
+                               (cons (widget-apply widget
+                                                   :value-to-internal value)
+                                     0))
+                             (widget-get widget :prompt-history))))

 
 (defvar widget-edit-functions nil)
 
 (defun widget-field-action (widget &optional event)
 
 (defvar widget-edit-functions nil)
 
 (defun widget-field-action (widget &optional event)

-  ;; Move to next field.
+  "Move to next field."

   (widget-forward 1)
   (run-hook-with-args 'widget-edit-functions widget))
 
 (defun widget-field-validate (widget)
   (widget-forward 1)
   (run-hook-with-args 'widget-edit-functions widget))
 
 (defun widget-field-validate (widget)

-  ;; Valid if the content matches `:valid-regexp'.
-  (save-excursion
-    (let ((value (widget-apply widget :value-get))
-         (regexp (widget-get widget :valid-regexp)))
-      (if (string-match regexp value)
-         nil
-       widget))))
+  "Valid if the content matches `:valid-regexp'."
+  (unless (string-match (widget-get widget :valid-regexp)
+                       (widget-apply widget :value-get))
+    widget))

 
 (defun widget-field-value-create (widget)
 
 (defun widget-field-value-create (widget)

-  ;; Create an editable text field.
+  "Create an editable text field."

   (let ((size (widget-get widget :size))
        (value (widget-get widget :value))
        (from (point))
        ;; This is changed to a real overlay in `widget-setup'.  We
        ;; need the end points to behave differently until
   (let ((size (widget-get widget :size))
        (value (widget-get widget :value))
        (from (point))
        ;; This is changed to a real overlay in `widget-setup'.  We
        ;; need the end points to behave differently until

-       ;; `widget-setup' is called.   
+       ;; `widget-setup' is called.

        (overlay (cons (make-marker) (make-marker))))
     (widget-put widget :field-overlay overlay)
     (insert value)
        (overlay (cons (make-marker) (make-marker))))
     (widget-put widget :field-overlay overlay)
     (insert value)


@@ -1875,15 +1855,16 @@ If END is omitted, it defaults to the length of LIST."
     (set-marker-insertion-type (car overlay) t)))
 
 (defun widget-field-value-delete (widget)
     (set-marker-insertion-type (car overlay) t)))
 
 (defun widget-field-value-delete (widget)

-  ;; Remove the widget from the list of active editing fields.
+  "Remove the widget from the list of active editing fields."

   (setq widget-field-list (delq widget widget-field-list))
   (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)))
   ;; 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)
       (delete-overlay overlay))))
 
 (defun widget-field-value-get (widget)

-  ;; Return current text in editing field.
+  "Return current text in editing field."

   (let ((from (widget-field-start widget))
        (to (widget-field-end widget))
        (buffer (widget-field-buffer widget))
   (let ((from (widget-field-start widget))
        (to (widget-field-end widget))
        (buffer (widget-field-buffer widget))


@@ -1891,7 +1872,7 @@ If END is omitted, it defaults to the length of LIST."
        (secret (widget-get widget :secret))
        (old (current-buffer)))
     (if (and from to)
        (secret (widget-get widget :secret))
        (old (current-buffer)))
     (if (and from to)

-       (progn 
+       (progn

          (set-buffer buffer)
          (while (and size
                      (not (zerop size))
          (set-buffer buffer)
          (while (and size
                      (not (zerop size))


@@ -1916,22 +1897,22 @@ If END is omitted, it defaults to the length of LIST."
 ;;; The `text' Widget.
 
 (define-widget 'text 'editable-field
 ;;; 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
 
 ;;; 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
   :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
   :default-get 'widget-choice-default-get
   :mouse-down-action 'widget-choice-mouse-down-action
   :action 'widget-choice-action


@@ -1941,13 +1922,12 @@ If END is omitted, it defaults to the length of LIST."
   :match-inline 'widget-choice-match-inline)
 
 (defun widget-choice-value-create (widget)
   :match-inline 'widget-choice-match-inline)
 
 (defun widget-choice-value-create (widget)

-  ;; Insert the first choice that matches the value.
+  "Insert the first choice that matches the value."

   (let ((value (widget-get widget :value))
        (args (widget-get widget :args))
        (explicit (widget-get widget :explicit-choice))
   (let ((value (widget-get widget :value))
        (args (widget-get widget :args))
        (explicit (widget-get widget :explicit-choice))

-       (explicit-value (widget-get widget :explicit-choice-value))

        current)
        current)

-    (if (and explicit (eq value explicit-value))
+    (if (and explicit (equal value (widget-get widget :explicit-choice-value)))

        (progn
          ;; If the user specified the choice for this value,
          ;; respect that choice as long as the value is the same.
        (progn
          ;; If the user specified the choice for this value,
          ;; respect that choice as long as the value is the same.


@@ -1969,14 +1949,6 @@ If END is omitted, it defaults to the length of LIST."
                                              widget void :value value)))
          (widget-put widget :choice void))))))
 
                                              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))))
 (defun widget-choice-default-get (widget)
   ;; Get default for the first choice.
   (widget-default-get (car (widget-get widget :args))))


@@ -1992,12 +1964,9 @@ when he invoked the menu."
   ;; Return non-nil if we need a menu.
   (let ((args (widget-get widget :args))
        (old (widget-get widget :choice)))
   ;; Return non-nil if we need a menu.
   (let ((args (widget-get widget :args))
        (old (widget-get widget :choice)))

-    (cond ((not window-system)
+    (cond ((not (display-popup-menus-p))

           ;; No place to pop up a menu.
           nil)
           ;; No place to pop up a menu.
           nil)

-         ((not (or (fboundp 'x-popup-menu) (fboundp 'popup-menu)))
-          ;; No way to pop up a menu.
-          nil)

          ((< (length args) 2)
           ;; Empty or singleton list, just return the value.
           nil)
          ((< (length args) 2)
           ;; Empty or singleton list, just return the value.
           nil)


@@ -2057,21 +2026,16 @@ when he invoked the menu."
       (when this-explicit
        (widget-put widget :explicit-choice current)
        (widget-put widget :explicit-choice-value (widget-get widget :value)))
       (when this-explicit
        (widget-put widget :explicit-choice current)
        (widget-put widget :explicit-choice-value (widget-get widget :value)))

-      (let ((value (widget-default-get current)))
-       (widget-value-set widget 
-                         (widget-apply current :value-to-external value)))
+      (widget-value-set widget (widget-default-get current))

       (widget-setup)
       (widget-apply widget :notify widget event)))
   (run-hook-with-args 'widget-edit-functions widget))
 
 (defun widget-choice-validate (widget)
   ;; Valid if we have made a valid choice.
       (widget-setup)
       (widget-apply widget :notify widget event)))
   (run-hook-with-args 'widget-edit-functions widget))
 
 (defun widget-choice-validate (widget)
   ;; Valid if we have made a valid choice.

-  (let ((void (widget-get widget :void))
-       (choice (widget-get widget :choice))
-       (child (car (widget-get widget :children))))
-    (if (eq void choice)
-       widget
-      (widget-apply child :validate))))
+  (if (eq (widget-get widget :void) (widget-get widget :choice))
+      widget
+    (widget-apply (car (widget-get widget :children)) :validate)))

 
 (defun widget-choice-match (widget value)
   ;; Matches if one of the choices matches.
 
 (defun widget-choice-match (widget value)
   ;; Matches if one of the choices matches.


@@ -2105,14 +2069,22 @@ when he invoked the menu."
   :off "off")
 
 (defun widget-toggle-value-create (widget)
   :off "off")
 
 (defun widget-toggle-value-create (widget)

-  ;; Insert text representing the `on' and `off' states.
+  "Insert text representing the `on' and `off' states."

   (if (widget-value widget)
   (if (widget-value widget)

-      (widget-glyph-insert widget 
-                          (widget-get widget :on) 
-                          (widget-get widget :on-glyph))
-    (widget-glyph-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.
 
 (defun widget-toggle-action (widget &optional event)
   ;; Toggle value.


@@ -2128,9 +2100,23 @@ when he invoked the menu."
   :button-prefix ""
   :format "%[%v%]"
   :on "[X]"
   :button-prefix ""
   :format "%[%v%]"
   :on "[X]"

-  :on-glyph "check1"
+  ;; 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 "\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 "[ ]"

-  :off-glyph "check0"
+  :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)
 
 (defun widget-checkbox-action (widget &optional event)
   :action 'widget-checkbox-action)
 
 (defun widget-checkbox-action (widget &optional event)


@@ -2147,13 +2133,12 @@ when he invoked the menu."
 (define-widget 'checklist 'default
   "A multiple choice widget."
   :convert-widget 'widget-types-convert-widget
 (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"
   :format "%v"
   :offset 4
   :entry-format "%b %v"

-  :menu-tag "checklist"

   :greedy nil
   :value-create 'widget-checklist-value-create
   :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
   :value-get 'widget-checklist-value-get
   :validate 'widget-checklist-validate
   :match 'widget-checklist-match


@@ -2163,18 +2148,18 @@ when he invoked the menu."
   ;; Insert all values
   (let ((alist (widget-checklist-match-find widget (widget-get widget :value)))
        (args (widget-get widget :args)))
   ;; Insert all values
   (let ((alist (widget-checklist-match-find widget (widget-get widget :value)))
        (args (widget-get widget :args)))

-    (while args 
+    (while args

       (widget-checklist-add-item widget (car args) (assq (car args) alist))
       (setq args (cdr args)))
     (widget-put widget :children (nreverse (widget-get widget :children)))))
 
 (defun widget-checklist-add-item (widget type chosen)
       (widget-checklist-add-item widget (car args) (assq (car args) alist))
       (setq args (cdr args)))
     (widget-put widget :children (nreverse (widget-get widget :children)))))
 
 (defun widget-checklist-add-item (widget type chosen)

-  ;; Create checklist item in WIDGET of type TYPE.
-  ;; If the item is checked, CHOSEN is a cons whose cdr is the value.
+  "Create checklist item in WIDGET of type TYPE.
+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)))
   (and (eq (preceding-char) ?\n)
        (widget-get widget :indent)
        (insert-char ?  (widget-get widget :indent)))

-  (widget-specify-insert 
+  (widget-specify-insert

    (let* ((children (widget-get widget :children))
          (buttons (widget-get widget :buttons))
          (button-args (or (widget-get type :sibling-args)
    (let* ((children (widget-get widget :children))
          (buttons (widget-get widget :buttons))
          (button-args (or (widget-get type :sibling-args)


@@ -2185,10 +2170,10 @@ when he invoked the menu."
      (goto-char from)
      ;; Parse % escapes in format.
      (while (re-search-forward "%\\([bv%]\\)" nil t)
      (goto-char from)
      ;; Parse % escapes in format.
      (while (re-search-forward "%\\([bv%]\\)" nil t)

-       (let ((escape (aref (match-string 1) 0)))
-        (replace-match "" t t)
+       (let ((escape (char-after (match-beginning 1))))
+        (delete-backward-char 2)

         (cond ((eq escape ?%)
         (cond ((eq escape ?%)

-               (insert "%"))
+               (insert ?%))

               ((eq escape ?b)
                (setq button (apply 'widget-create-child-and-convert
                                    widget 'checkbox
               ((eq escape ?b)
                (setq button (apply 'widget-create-child-and-convert
                                    widget 'checkbox


@@ -2206,7 +2191,7 @@ when he invoked the menu."
                            (t
                             (widget-create-child-value
                              widget type (car (cdr chosen)))))))
                            (t
                             (widget-create-child-value
                              widget type (car (cdr chosen)))))))

-              (t 
+              (t

                (error "Unknown escape `%c'" escape)))))
      ;; Update properties.
      (and button child (widget-put child :button button))
                (error "Unknown escape `%c'" escape)))))
      ;; Update properties.
      (and button child (widget-put child :button button))


@@ -2225,7 +2210,7 @@ when he invoked the menu."
        found rest)
     (while values
       (let ((answer (widget-checklist-match-up args values)))
        found rest)
     (while values
       (let ((answer (widget-checklist-match-up args values)))

-       (cond (answer 
+       (cond (answer

               (let ((vals (widget-match-inline answer values)))
                 (setq found (append found (car vals))
                       values (cdr vals)
               (let ((vals (widget-match-inline answer values)))
                 (setq found (append found (car vals))
                       values (cdr vals)


@@ -2233,46 +2218,45 @@ when he invoked the menu."
              (greedy
               (setq rest (append rest (list (car values)))
                     values (cdr values)))
              (greedy
               (setq rest (append rest (list (car values)))
                     values (cdr values)))

-             (t 
+             (t

               (setq rest (append rest values)
                     values nil)))))
     (cons found rest)))
 
 (defun widget-checklist-match-find (widget vals)
               (setq rest (append rest values)
                     values nil)))))
     (cons found rest)))
 
 (defun widget-checklist-match-find (widget vals)

-  ;; Find the vals which match a type in the checklist.
-  ;; Return an alist of (TYPE MATCH).
+  "Find the vals which match a type in the checklist.
+Return an alist of (TYPE MATCH)."

   (let ((greedy (widget-get widget :greedy))
        (args (copy-sequence (widget-get widget :args)))
        found)
     (while vals
       (let ((answer (widget-checklist-match-up args vals)))
   (let ((greedy (widget-get widget :greedy))
        (args (copy-sequence (widget-get widget :args)))
        found)
     (while vals
       (let ((answer (widget-checklist-match-up args vals)))

-       (cond (answer 
+       (cond (answer

               (let ((match (widget-match-inline answer vals)))
                 (setq found (cons (cons answer (car match)) found)
                       vals (cdr match)
                       args (delq answer args))))
              (greedy
               (setq vals (cdr vals)))
               (let ((match (widget-match-inline answer vals)))
                 (setq found (cons (cons answer (car match)) found)
                       vals (cdr match)
                       args (delq answer args))))
              (greedy
               (setq vals (cdr vals)))

-             (t 
+             (t

               (setq vals nil)))))
     found))
 
 (defun widget-checklist-match-up (args vals)
               (setq vals nil)))))
     found))
 
 (defun widget-checklist-match-up (args vals)

-  ;; Rerturn the first type from ARGS that matches VALS.
+  "Return the first type from ARGS that matches VALS."

   (let (current found)
     (while (and args (null found))
       (setq current (car args)
            args (cdr args)
            found (widget-match-inline current vals)))
     (if found
   (let (current found)
     (while (and args (null found))
       (setq current (car args)
            args (cdr args)
            found (widget-match-inline current vals)))
     (if found

-       current
-      nil)))
+       current)))

 
 (defun widget-checklist-value-get (widget)
   ;; The values of all selected items.
   (let ((children (widget-get widget :children))
        child result)
 
 (defun widget-checklist-value-get (widget)
   ;; The values of all selected items.
   (let ((children (widget-get widget :children))
        child result)

-    (while children 
+    (while children

       (setq child (car children)
            children (cdr children))
       (if (widget-value (widget-get child :button))
       (setq child (car children)
            children (cdr children))
       (if (widget-value (widget-get child :button))


@@ -2326,12 +2310,11 @@ when he invoked the menu."
 (define-widget 'radio-button-choice 'default
   "Select one of multiple options."
   :convert-widget 'widget-types-convert-widget
 (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"
   :offset 4
   :format "%v"
   :entry-format "%b %v"

-  :menu-tag "radio"

   :value-create 'widget-radio-value-create
   :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
   :value-get 'widget-radio-value-get
   :value-inline 'widget-radio-value-inline
   :value-set 'widget-radio-value-set


@@ -2345,7 +2328,7 @@ when he invoked the menu."
   ;; Insert all values
   (let ((args (widget-get widget :args))
        arg)
   ;; Insert all values
   (let ((args (widget-get widget :args))
        arg)

-    (while args 
+    (while args

       (setq arg (car args)
            args (cdr args))
       (widget-radio-add-item widget arg))))
       (setq arg (car args)
            args (cdr args))
       (widget-radio-add-item widget arg))))


@@ -2356,7 +2339,7 @@ when he invoked the menu."
   (and (eq (preceding-char) ?\n)
        (widget-get widget :indent)
        (insert-char ?  (widget-get widget :indent)))
   (and (eq (preceding-char) ?\n)
        (widget-get widget :indent)
        (insert-char ?  (widget-get widget :indent)))

-  (widget-specify-insert 
+  (widget-specify-insert

    (let* ((value (widget-get widget :value))
          (children (widget-get widget :children))
          (buttons (widget-get widget :buttons))
    (let* ((value (widget-get widget :value))
          (children (widget-get widget :children))
          (buttons (widget-get widget :buttons))


@@ -2370,13 +2353,13 @@ when he invoked the menu."
      (goto-char from)
      ;; Parse % escapes in format.
      (while (re-search-forward "%\\([bv%]\\)" nil t)
      (goto-char from)
      ;; Parse % escapes in format.
      (while (re-search-forward "%\\([bv%]\\)" nil t)

-       (let ((escape (aref (match-string 1) 0)))
-        (replace-match "" t t)
+       (let ((escape (char-after (match-beginning 1))))
+        (delete-backward-char 2)

         (cond ((eq escape ?%)
         (cond ((eq escape ?%)

-               (insert "%"))
+               (insert ?%))

               ((eq escape ?b)
                (setq button (apply 'widget-create-child-and-convert
               ((eq escape ?b)
                (setq button (apply 'widget-create-child-and-convert

-                                   widget 'radio-button 
+                                   widget 'radio-button

                                    :value (not (null chosen))
                                    button-args)))
               ((eq escape ?v)
                                    :value (not (null chosen))
                                    button-args)))
               ((eq escape ?v)


@@ -2384,14 +2367,14 @@ when he invoked the menu."
                                (widget-create-child-value
                                 widget type value)
                              (widget-create-child widget type)))
                                (widget-create-child-value
                                 widget type value)
                              (widget-create-child widget type)))

-               (unless chosen 
+               (unless chosen

                  (widget-apply child :deactivate)))
                  (widget-apply child :deactivate)))

-              (t 
+              (t

                (error "Unknown escape `%c'" escape)))))
      ;; Update properties.
      (when chosen
        (widget-put widget :choice type))
                (error "Unknown escape `%c'" escape)))))
      ;; Update properties.
      (when chosen
        (widget-put widget :choice type))

-     (when button 
+     (when button

        (widget-put child :button button)
        (widget-put widget :buttons (nconc buttons (list button))))
      (when child
        (widget-put child :button button)
        (widget-put widget :buttons (nconc buttons (list button))))
      (when child


@@ -2410,11 +2393,9 @@ when he invoked the menu."
     (while children
       (setq current (car children)
            children (cdr children))
     (while children
       (setq current (car children)
            children (cdr children))

-      (let* ((button (widget-get current :button))
-            (value (widget-apply button :value-get)))
-       (when value
-         (setq found current
-               children nil))))
+      (when (widget-apply (widget-get current :button) :value-get)
+       (setq found current
+             children nil)))

     found))
 
 (defun widget-radio-value-inline (widget)
     found))
 
 (defun widget-radio-value-inline (widget)


@@ -2424,11 +2405,9 @@ when he invoked the menu."
     (while children
       (setq current (car children)
            children (cdr children))
     (while children
       (setq current (car children)
            children (cdr children))

-      (let* ((button (widget-get current :button))
-            (value (widget-apply button :value-get)))
-       (when value
-         (setq found (widget-apply current :value-inline)
-               children nil))))
+      (when (widget-apply (widget-get current :button) :value-get)
+       (setq found (widget-apply current :value-inline)
+             children nil)))

     found))
 
 (defun widget-radio-value-set (widget value)
     found))
 
 (defun widget-radio-value-set (widget value)


@@ -2444,8 +2423,8 @@ when he invoked the menu."
             (match (and (not found)
                         (widget-apply current :match value))))
        (widget-value-set button match)
             (match (and (not found)
                         (widget-apply current :match value))))
        (widget-value-set button match)

-       (if match 
-           (progn 
+       (if match
+           (progn

              (widget-value-set current value)
              (widget-apply current :activate))
          (widget-apply current :deactivate))
              (widget-value-set current value)
              (widget-apply current :activate))
          (widget-apply current :deactivate))


@@ -2493,7 +2472,7 @@ when he invoked the menu."
 
 (defun widget-insert-button-action (widget &optional event)
   ;; Ask the parent to insert a new item.
 
 (defun widget-insert-button-action (widget &optional event)
   ;; Ask the parent to insert a new item.

-  (widget-apply (widget-get widget :parent) 
+  (widget-apply (widget-get widget :parent)

                :insert-before (widget-get widget :widget)))
 
 ;;; The `delete-button' Widget.
                :insert-before (widget-get widget :widget)))
 
 ;;; The `delete-button' Widget.


@@ -2506,26 +2485,25 @@ when he invoked the menu."
 
 (defun widget-delete-button-action (widget &optional event)
   ;; Ask the parent to insert a new item.
 
 (defun widget-delete-button-action (widget &optional event)
   ;; Ask the parent to insert a new item.

-  (widget-apply (widget-get widget :parent) 
+  (widget-apply (widget-get widget :parent)

                :delete-at (widget-get widget :widget)))
 
 ;;; The `editable-list' Widget.
 
                :delete-at (widget-get widget :widget)))
 
 ;;; The `editable-list' Widget.
 

-(defcustom widget-editable-list-gui nil
-  "If non nil, use GUI push-buttons in editable list when available."
-  :type 'boolean
-  :group 'widgets)
+;; (defcustom widget-editable-list-gui nil
+;;   "If non nil, use GUI push-buttons in editable list when available."
+;;   :type 'boolean
+;;   :group 'widgets)

 
 (define-widget 'editable-list 'default
   "A variable list of widgets of the same type."
   :convert-widget 'widget-types-convert-widget
 
 (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"
   :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-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
   :value-get 'widget-editable-list-value-get
   :validate 'widget-children-validate
   :match 'widget-editable-list-match


@@ -2535,21 +2513,22 @@ when he invoked the menu."
 
 (defun widget-editable-list-format-handler (widget escape)
   ;; We recognize the insert button.
 
 (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)
     (cond ((eq escape ?i)
           (and (widget-get widget :indent)

-               (insert-char ?  (widget-get widget :indent)))
-          (apply 'widget-create-child-and-convert 
+               (insert-char ?\  (widget-get widget :indent)))
+          (apply 'widget-create-child-and-convert

                  widget 'insert-button
                  (widget-get widget :append-button-args)))
                  widget 'insert-button
                  (widget-get widget :append-button-args)))

-         (t 
-          (widget-default-format-handler widget escape)))))
+         (t
+          (widget-default-format-handler widget escape)))
+    ;; )
+  )

 
 (defun widget-editable-list-value-create (widget)
   ;; Insert all values
   (let* ((value (widget-get widget :value))
         (type (nth 0 (widget-get widget :args)))
 
 (defun widget-editable-list-value-create (widget)
   ;; Insert all values
   (let* ((value (widget-get widget :value))
         (type (nth 0 (widget-get widget :args)))

-        (inlinep (widget-get type :inline))

         children)
     (widget-put widget :value-pos (copy-marker (point)))
     (set-marker-insertion-type (widget-get widget :value-pos) t)
         children)
     (widget-put widget :value-pos (copy-marker (point)))
     (set-marker-insertion-type (widget-get widget :value-pos) t)


@@ -2558,7 +2537,7 @@ when he invoked the menu."
        (if answer
            (setq children (cons (widget-editable-list-entry-create
                                  widget
        (if answer
            (setq children (cons (widget-editable-list-entry-create
                                  widget

-                                 (if inlinep
+                                 (if (widget-get type :inline)

                                      (car answer)
                                    (car (car answer)))
                                  t)
                                      (car answer)
                                    (car (car answer)))
                                  t)


@@ -2583,7 +2562,7 @@ when he invoked the menu."
        found)
     (while (and value ok)
       (let ((answer (widget-match-inline type value)))
        found)
     (while (and value ok)
       (let ((answer (widget-match-inline type value)))

-       (if answer 
+       (if answer

            (setq found (append found (car answer))
                  value (cdr answer))
          (setq ok nil))))
            (setq found (append found (car answer))
                  value (cdr answer))
          (setq ok nil))))


@@ -2596,11 +2575,11 @@ when he invoked the menu."
          (inhibit-read-only t)
          before-change-functions
          after-change-functions)
          (inhibit-read-only t)
          before-change-functions
          after-change-functions)

-      (cond (before 
+      (cond (before

             (goto-char (widget-get before :entry-from)))
            (t
             (goto-char (widget-get widget :value-pos))))
             (goto-char (widget-get before :entry-from)))
            (t
             (goto-char (widget-get widget :value-pos))))

-      (let ((child (widget-editable-list-entry-create 
+      (let ((child (widget-editable-list-entry-create

                    widget nil nil)))
        (when (< (widget-get child :entry-from) (widget-get widget :from))
          (set-marker (widget-get widget :from)
                    widget nil nil)))
        (when (< (widget-get child :entry-from) (widget-get widget :from))
          (set-marker (widget-get widget :from)


@@ -2644,19 +2623,19 @@ when he invoked the menu."
 (defun widget-editable-list-entry-create (widget value conv)
   ;; Create a new entry to the list.
   (let ((type (nth 0 (widget-get widget :args)))
 (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)
        child delete insert)

-    (widget-specify-insert 
+    (widget-specify-insert

      (save-excursion
        (and (widget-get widget :indent)
      (save-excursion
        (and (widget-get widget :indent)

-           (insert-char ?  (widget-get widget :indent)))
+           (insert-char ?\  (widget-get widget :indent)))

        (insert (widget-get widget :entry-format)))
      ;; Parse % escapes in format.
      (while (re-search-forward "%\\(.\\)" nil t)
        (insert (widget-get widget :entry-format)))
      ;; Parse % escapes in format.
      (while (re-search-forward "%\\(.\\)" nil t)

-       (let ((escape (aref (match-string 1) 0)))
-        (replace-match "" t t)
+       (let ((escape (char-after (match-beginning 1))))
+        (delete-backward-char 2)

         (cond ((eq escape ?%)
         (cond ((eq escape ?%)

-               (insert "%"))
+               (insert ?%))

               ((eq escape ?i)
                (setq insert (apply 'widget-create-child-and-convert
                                    widget 'insert-button
               ((eq escape ?i)
                (setq insert (apply 'widget-create-child-and-convert
                                    widget 'insert-button


@@ -2667,36 +2646,34 @@ when he invoked the menu."
                                    (widget-get widget :delete-button-args))))
               ((eq escape ?v)
                (if conv
                                    (widget-get widget :delete-button-args))))
               ((eq escape ?v)
                (if conv

-                   (setq child (widget-create-child-value 
+                   (setq child (widget-create-child-value

                                 widget type value))
                                 widget type value))

-                 (setq child (widget-create-child-value 
-                              widget type
-                              (widget-apply type :value-to-external
-                                            (widget-default-get type))))))
-              (t 
+                 (setq child (widget-create-child-value
+                              widget type (widget-default-get type)))))
+              (t

                (error "Unknown escape `%c'" escape)))))
                (error "Unknown escape `%c'" escape)))))

-     (widget-put widget 
-                :buttons (cons delete 
-                               (cons insert
-                                     (widget-get widget :buttons))))
-     (let ((entry-from (copy-marker (point-min)))
-          (entry-to (copy-marker (point-max))))
+     (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)))
        (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.
 
 (define-widget 'group 'default
     child))
 
 ;;; The `group' Widget.
 
 (define-widget 'group 'default

-  "A widget which group other widgets inside."
+  "A widget which groups other widgets inside."

   :convert-widget 'widget-types-convert-widget
   :convert-widget 'widget-types-convert-widget

+  :copy 'widget-types-copy

   :format "%v"
   :value-create 'widget-group-value-create
   :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
   :value-get 'widget-editable-list-value-get
   :default-get 'widget-group-default-get
   :validate 'widget-children-validate


@@ -2715,13 +2692,13 @@ when he invoked the menu."
            value (cdr answer))
       (and (eq (preceding-char) ?\n)
           (widget-get widget :indent)
            value (cdr answer))
       (and (eq (preceding-char) ?\n)
           (widget-get widget :indent)

-          (insert-char ?  (widget-get widget :indent)))
+          (insert-char ?\  (widget-get widget :indent)))

       (push (cond ((null answer)
                   (widget-create-child widget arg))
                  ((widget-get arg :inline)
       (push (cond ((null answer)
                   (widget-create-child widget arg))
                  ((widget-get arg :inline)

-                  (widget-create-child-value widget arg  (car answer)))
+                  (widget-create-child-value widget arg (car answer)))

                  (t
                  (t

-                  (widget-create-child-value widget arg  (car (car answer)))))
+                  (widget-create-child-value widget arg (car (car answer)))))

            children))
     (widget-put widget :children (nreverse children))))
 
            children))
     (widget-put widget :children (nreverse children))))
 


@@ -2743,14 +2720,13 @@ when he invoked the menu."
       (setq argument (car args)
            args (cdr args)
            answer (widget-match-inline argument vals))
       (setq argument (car args)
            args (cdr args)
            answer (widget-match-inline argument vals))

-      (if answer 
+      (if answer

          (setq vals (cdr answer)
                found (append found (car answer)))
        (setq vals nil
              args nil)))
     (if answer
          (setq vals (cdr answer)
                found (append found (car answer)))
        (setq vals nil
              args nil)))
     (if answer

-       (cons found vals)
-      nil)))
+       (cons found vals))))

 
 ;;; The `visibility' Widget.
 
 
 ;;; The `visibility' Widget.
 


@@ -2780,8 +2756,8 @@ when he invoked the menu."
                          widget-push-button-suffix))
       (setq off ""))
     (if (widget-value widget)
                          widget-push-button-suffix))
       (setq off ""))
     (if (widget-value widget)

-       (widget-glyph-insert widget on "down" "down-pushed")
-      (widget-glyph-insert widget off "right" "right-pushed"))))
+       (widget-image-insert widget on "down" "down-pushed")
+      (widget-image-insert widget off "right" "right-pushed"))))

 
 ;;; The `documentation-link' Widget.
 ;;
 
 ;;; The `documentation-link' Widget.
 ;;


@@ -2790,13 +2766,9 @@ when he invoked the menu."
 (define-widget 'documentation-link 'link
   "Link type used in documentation strings."
   :tab-order -1
 (define-widget 'documentation-link 'link
   "Link type used in documentation strings."
   :tab-order -1

-  :help-echo 'widget-documentation-link-echo-help
+  :help-echo "Describe this symbol"

   :action 'widget-documentation-link-action)
 
   :action 'widget-documentation-link-action)
 

-(defun widget-documentation-link-echo-help (widget)
-  "Tell what this link will describe."
-  (concat "Describe the `" (widget-get widget :value) "' symbol."))
-

 (defun widget-documentation-link-action (widget &optional event)
   "Display documentation for WIDGET's value.  Ignore optional argument EVENT."
   (let* ((string (widget-get widget :value))
 (defun widget-documentation-link-action (widget &optional event)
   "Display documentation for WIDGET's value.  Ignore optional argument EVENT."
   (let* ((string (widget-get widget :value))


@@ -2837,22 +2809,24 @@ link for that string."
   (widget-specify-doc widget from to)
   (when widget-documentation-links
     (let ((regexp widget-documentation-link-regexp)
   (widget-specify-doc widget from to)
   (when widget-documentation-links
     (let ((regexp widget-documentation-link-regexp)

-         (predicate widget-documentation-link-p)
-         (type widget-documentation-link-type)
-         (buttons (widget-get widget :buttons)))
+         (buttons (widget-get widget :buttons))
+         (widget-mouse-face (default-value 'widget-mouse-face))
+         (widget-button-face widget-documentation-face)
+         (widget-button-pressed-face widget-documentation-face))

       (save-excursion
        (goto-char from)
        (while (re-search-forward regexp to t)
          (let ((name (match-string 1))
                (begin (match-beginning 1))
                (end (match-end 1)))
       (save-excursion
        (goto-char from)
        (while (re-search-forward regexp to t)
          (let ((name (match-string 1))
                (begin (match-beginning 1))
                (end (match-end 1)))

-           (when (funcall predicate name)
-             (push (widget-convert-button type begin end :value name)
+           (when (funcall widget-documentation-link-p name)
+             (push (widget-convert-button widget-documentation-link-type
+                                          begin end :value name)

                    buttons)))))
       (widget-put widget :buttons buttons)))
   (let ((indent (widget-get widget :indent)))
     (when (and indent (not (zerop indent)))
                    buttons)))))
       (widget-put widget :buttons buttons)))
   (let ((indent (widget-get widget :indent)))
     (when (and indent (not (zerop indent)))

-      (save-excursion 
+      (save-excursion

        (save-restriction
          (narrow-to-region from to)
          (goto-char (point-min))
        (save-restriction
          (narrow-to-region from to)
          (goto-char (point-min))


@@ -2865,7 +2839,6 @@ link for that string."
   "A documentation string."
   :format "%v"
   :action 'widget-documentation-string-action
   "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)
   :value-create 'widget-documentation-string-value-create)
 
 (defun widget-documentation-string-value-create (widget)


@@ -2877,31 +2850,33 @@ link for that string."
     (if (string-match "\n" doc)
        (let ((before (substring doc 0 (match-beginning 0)))
              (after (substring doc (match-beginning 0)))
     (if (string-match "\n" doc)
        (let ((before (substring doc 0 (match-beginning 0)))
              (after (substring doc (match-beginning 0)))

-             buttons)
-         (insert before " ")
+             button)
+         (insert before ?\ )

          (widget-documentation-link-add widget start (point))
          (widget-documentation-link-add widget start (point))

-         (push (widget-create-child-and-convert
+         (setq button
+               (widget-create-child-and-convert

                 widget 'visibility
                 :help-echo "Show or hide rest of the documentation."
                 widget 'visibility
                 :help-echo "Show or hide rest of the documentation."

+                :on "Hide Rest"

                 :off "More"
                 :off "More"

+                :always-active t

                 :action 'widget-parent-action
                 :action 'widget-parent-action

-                shown)
-               buttons)
+                shown))

          (when shown
            (setq start (point))
            (when (and indent (not (zerop indent)))
              (insert-char ?\  indent))
            (insert after)
            (widget-documentation-link-add widget start (point)))
          (when shown
            (setq start (point))
            (when (and indent (not (zerop indent)))
              (insert-char ?\  indent))
            (insert after)
            (widget-documentation-link-add widget start (point)))

-         (widget-put widget :buttons buttons))
+         (widget-put widget :buttons (list button)))

       (insert doc)
       (widget-documentation-link-add widget start (point))))
       (insert doc)
       (widget-documentation-link-add widget start (point))))

-  (insert "\n"))
+  (insert ?\n))

 
 (defun widget-documentation-string-action (widget &rest ignore)
   ;; Toggle documentation.
   (let ((parent (widget-get widget :parent)))
 
 (defun widget-documentation-string-action (widget &rest ignore)
   ;; Toggle documentation.
   (let ((parent (widget-get widget :parent)))

-    (widget-put parent :documentation-shown 
+    (widget-put parent :documentation-shown

                (not (widget-get parent :documentation-shown))))
   ;; Redraw.
   (widget-value-set widget (widget-value widget)))
                (not (widget-get parent :documentation-shown))))
   ;; Redraw.
   (widget-value-set widget (widget-value widget)))


@@ -2969,15 +2944,14 @@ as the value."
 
 (defun widget-regexp-validate (widget)
   "Check that the value of WIDGET is a valid regexp."
 
 (defun widget-regexp-validate (widget)
   "Check that the value of WIDGET is a valid regexp."

-  (let ((val (widget-value widget)))
-    (condition-case data
-       (prog1 nil
-         (string-match val ""))
-      (error (widget-put widget :error (error-message-string data))
-            widget))))
+  (condition-case data
+      (prog1 nil
+       (string-match (widget-value widget) ""))
+    (error (widget-put widget :error (error-message-string data))
+          widget)))

 
 (define-widget 'file 'string
 
 (define-widget 'file 'string

-  "A file widget.  
+  "A file widget.

 It will read a file name from the minibuffer when invoked."
   :complete-function 'widget-file-complete
   :prompt-value 'widget-file-prompt-value
 It will read a file name from the minibuffer when invoked."
   :complete-function 'widget-file-complete
   :prompt-value 'widget-file-prompt-value


@@ -3006,10 +2980,10 @@ It will read a file name from the minibuffer when invoked."
           (insert (expand-file-name completion directory)))
          (t
           (message "Making completion list...")
           (insert (expand-file-name completion directory)))
          (t
           (message "Making completion list...")

-          (let ((list (file-name-all-completions name-part directory)))
-            (setq list (sort list 'string<))
-            (with-output-to-temp-buffer "*Completions*"
-              (display-completion-list list)))
+          (with-output-to-temp-buffer "*Completions*"
+            (display-completion-list
+             (sort (file-name-all-completions name-part directory)
+                   'string<)))

           (message "Making completion list...%s" "done")))))
 
 (defun widget-file-prompt-value (widget prompt value unbound)
           (message "Making completion list...%s" "done")))))
 
 (defun widget-file-prompt-value (widget prompt value unbound)


@@ -3036,8 +3010,9 @@ It will read a file name from the minibuffer when invoked."
 ;;;    (widget-setup)
 ;;;    (widget-apply widget :notify widget event)))
 
 ;;;    (widget-setup)
 ;;;    (widget-apply widget :notify widget event)))
 

+;; Fixme: use file-name-as-directory.

 (define-widget 'directory 'file
 (define-widget 'directory 'file

-  "A directory widget.  
+  "A directory widget.

 It will read a directory name from the minibuffer when invoked."
   :tag "Directory")
 
 It will read a directory name from the minibuffer when invoked."
   :tag "Directory")
 


@@ -3065,7 +3040,7 @@ It will read a directory name from the minibuffer when invoked."
 
 (defun widget-symbol-prompt-internal (widget prompt initial history)
   ;; Read file from minibuffer.
 
 (defun widget-symbol-prompt-internal (widget prompt initial history)
   ;; Read file from minibuffer.

-  (let ((answer (completing-read prompt obarray 
+  (let ((answer (completing-read prompt obarray

                                 (widget-get widget :prompt-match)
                                 nil initial history)))
     (if (and (stringp answer)
                                 (widget-get widget :prompt-match)
                                 nil initial history)))
     (if (and (stringp answer)


@@ -3078,47 +3053,67 @@ It will read a directory name from the minibuffer when invoked."
 
 (define-widget 'function 'sexp
   "A Lisp function."
 
 (define-widget 'function 'sexp
   "A Lisp function."

-  :complete-function 'lisp-complete-symbol
+  :complete-function (lambda ()
+                      (interactive)
+                      (lisp-complete-symbol 'fboundp))

   :prompt-value 'widget-field-prompt-value
   :prompt-internal 'widget-symbol-prompt-internal
   :prompt-match 'fboundp
   :prompt-history 'widget-function-prompt-value-history
   :action 'widget-field-action
   :prompt-value 'widget-field-prompt-value
   :prompt-internal 'widget-symbol-prompt-internal
   :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"
+                                                 (widget-value widget)))
+               widget))
+  :value 'ignore

   :tag "Function")
 
 (defvar widget-variable-prompt-value-history nil
   "History of input to `widget-variable-prompt-value'.")
 
 (define-widget 'variable 'symbol
   :tag "Function")
 
 (defvar widget-variable-prompt-value-history nil
   "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
   "A Lisp variable."
   :prompt-match 'boundp
   :prompt-history 'widget-variable-prompt-value-history

+  :complete-function (lambda ()
+                      (interactive)
+                      (lisp-complete-symbol 'boundp))

   :tag "Variable")
 
 (defvar widget-coding-system-prompt-value-history nil
   "History of input to `widget-coding-system-prompt-value'.")
   :tag "Variable")
 
 (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"
   :tag "Coding system"
 (define-widget 'coding-system 'symbol
   "A MULE coding-system."
   :format "%{%t%}: %v"
   :tag "Coding system"

+  :base-only nil

   :prompt-history 'widget-coding-system-prompt-value-history
   :prompt-value 'widget-coding-system-prompt-value
   :prompt-history 'widget-coding-system-prompt-value-history
   :prompt-value 'widget-coding-system-prompt-value

-  :action 'widget-coding-system-action)
-  
+  :action 'widget-coding-system-action
+  :complete-function (lambda ()
+                      (interactive)
+                      (lisp-complete-symbol 'coding-system-p))
+  :validate (lambda (widget)
+             (unless (coding-system-p (widget-value widget))
+               (widget-put widget :error (format "Invalid coding system: %S"
+                                                 (widget-value widget)))
+               widget))
+  :value 'undecided
+  :prompt-match 'coding-system-p)
+

 (defun widget-coding-system-prompt-value (widget prompt value unbound)
 (defun widget-coding-system-prompt-value (widget prompt value unbound)

-  ;; Read coding-system from minibuffer.
-  (intern
-   (completing-read (format "%s (default %s) " prompt value)
-                   (mapcar (function
-                            (lambda (sym)
-                              (list (symbol-name sym))
-                              ))
-                           (coding-system-list)))))
+  "Read coding-system from minibuffer."
+  (if (widget-get widget :base-only)
+      (intern
+       (completing-read (format "%s (default %s) " prompt value)
+                       (mapcar #'list (coding-system-list t)) nil nil nil
+                       coding-system-history))
+      (read-coding-system (format "%s (default %s) " prompt value) value)))

 
 (defun widget-coding-system-action (widget &optional event)
 
 (defun widget-coding-system-action (widget &optional event)

-  ;; Read a file name from the minibuffer.

   (let ((answer
         (widget-coding-system-prompt-value
          widget
   (let ((answer
         (widget-coding-system-prompt-value
          widget


@@ -3155,25 +3150,32 @@ It will read a directory name from the minibuffer when invoked."
 
 (defun widget-sexp-validate (widget)
   ;; Valid if we can read the string and there is no junk left after it.
 
 (defun widget-sexp-validate (widget)
   ;; Valid if we can read the string and there is no junk left after it.

-  (save-excursion
-    (let ((buffer (set-buffer (get-buffer-create " *Widget Scratch*"))))
-      (erase-buffer)
-      (insert (widget-apply widget :value-get))
-      (goto-char (point-min))
+  (with-temp-buffer
+    (insert (widget-apply widget :value-get))
+    (goto-char (point-min))
+    (let (err)

       (condition-case data
       (condition-case data

-         (let ((value (read buffer)))
+         (progn
+           ;; Avoid a confusing end-of-file error.
+           (skip-syntax-forward "\\s-")

            (if (eobp)
            (if (eobp)

-               (if (widget-apply widget :match value)
-                   nil
-                 (widget-put widget :error (widget-get widget :type-error))
-                 widget)
-             (widget-put widget
-                         :error (format "Junk at end of expression: %s"
-                                        (buffer-substring (point)
-                                                          (point-max))))
-             widget))
-       (error (widget-put widget :error (error-message-string data))
-              widget)))))
+               (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"
+                                 (buffer-substring (point)
+                                                   (point-max))))))
+       (end-of-file                    ; Avoid confusing error message.
+        (setq err "Unbalanced sexp"))
+       (error (setq err (error-message-string data))))
+      (if (not err)
+         nil
+       (widget-put widget :error err)
+       widget))))

 
 (defvar widget-sexp-prompt-value-history nil
   "History of input to `widget-sexp-prompt-value'.")
 
 (defvar widget-sexp-prompt-value-history nil
   "History of input to `widget-sexp-prompt-value'.")


@@ -3183,16 +3185,11 @@ It will read a directory name from the minibuffer when invoked."
   (let ((found (read-string prompt
                            (if unbound nil (cons (prin1-to-string value) 0))
                            (widget-get widget :prompt-history))))
   (let ((found (read-string prompt
                            (if unbound nil (cons (prin1-to-string value) 0))
                            (widget-get widget :prompt-history))))

-    (save-excursion
-      (let ((buffer (set-buffer (get-buffer-create " *Widget Scratch*"))))
-       (erase-buffer)
-       (insert found)
-       (goto-char (point-min))
-       (let ((answer (read buffer)))
-         (unless (eobp)
-           (error "Junk at end of expression: %s"
-                  (buffer-substring (point) (point-max))))
-         answer)))))
+    (let ((answer (read-from-string found)))
+      (unless (= (cdr answer) (length found))
+       (error "Junk at end of expression: %s"
+              (substring found (cdr answer))))
+      (car answer))))

 
 (define-widget 'restricted-sexp 'sexp
   "A Lisp expression restricted to values that match.
 
 (define-widget 'restricted-sexp 'sexp
   "A Lisp expression restricted to values that match.


@@ -3225,22 +3222,29 @@ To use this type, you must define :match or :match-alternatives."
   :match-alternatives '(integerp))
 
 (define-widget 'number 'restricted-sexp
   :match-alternatives '(integerp))
 
 (define-widget 'number 'restricted-sexp

-  "A floating point number."
+  "A number (floating point or integer)."

   :tag "Number"
   :value 0.0
   :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))
 
   :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"
   :value 0
 (define-widget 'character 'editable-field
   "A character."
   :tag "Character"
   :value 0

-  :size 1 
+  :size 1

   :format "%{%t%}: %v\n"
   :valid-regexp "\\`.\\'"
   :error "This field should contain a single character"
   :value-to-internal (lambda (widget value)
   :format "%{%t%}: %v\n"
   :valid-regexp "\\`.\\'"
   :error "This field should contain a single character"
   :value-to-internal (lambda (widget value)

-                      (if (stringp value) 
+                      (if (stringp value)

                           value
                         (char-to-string value)))
   :value-to-external (lambda (widget value)
                           value
                         (char-to-string value)))
   :value-to-external (lambda (widget value)


@@ -3248,9 +3252,7 @@ To use this type, you must define :match or :match-alternatives."
                           (aref value 0)
                         value))
   :match (lambda (widget value)
                           (aref value 0)
                         value))
   :match (lambda (widget value)

-          (if (fboundp 'characterp)
-              (characterp value)
-            (integerp value))))
+          (char-valid-p value)))

 
 (define-widget 'list 'group
   "A Lisp list."
 
 (define-widget 'list 'group
   "A Lisp list."


@@ -3265,7 +3267,7 @@ To use this type, you must define :match or :match-alternatives."
   :value-to-internal (lambda (widget value) (append value nil))
   :value-to-external (lambda (widget value) (apply 'vector value)))
 
   :value-to-internal (lambda (widget value) (append value nil))
   :value-to-external (lambda (widget value) (apply 'vector value)))
 

-(defun widget-vector-match (widget value) 
+(defun widget-vector-match (widget value)

   (and (vectorp value)
        (widget-group-match widget
                           (widget-apply widget :value-to-internal value))))
   (and (vectorp value)
        (widget-group-match widget
                           (widget-apply widget :value-to-internal value))))


@@ -3278,13 +3280,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)
   :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) 
+(defun widget-cons-match (widget value)

   (and (consp value)
        (widget-group-match widget
                           (widget-apply widget :value-to-internal value))))
 \f
   (and (consp value)
        (widget-group-match widget
                           (widget-apply widget :value-to-internal value))))
 \f

+;;; 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)
+
+\f

 ;;; The `plist' Widget.
 ;;
 ;; Property lists.
 ;;; The `plist' Widget.
 ;;
 ;; Property lists.


@@ -3301,11 +3359,10 @@ 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))
 (defun widget-plist-convert-widget (widget)
   ;; Handle `:options'.
   (let* ((options (widget-get widget :options))

-        (key-type (widget-get widget :key-type))

         (widget-plist-value-type (widget-get widget :value-type))
         (widget-plist-value-type (widget-get widget :value-type))

-        (other `(editable-list :inline t 
+        (other `(editable-list :inline t

                                (group :inline t
                                (group :inline t

-                                      ,key-type
+                                      ,(widget-get widget :key-type)

                                       ,widget-plist-value-type)))
         (args (if options
                   (list `(checklist :inline t
                                       ,widget-plist-value-type)))
         (args (if options
                   (list `(checklist :inline t


@@ -3324,7 +3381,7 @@ To use this type, you must define :match or :match-alternatives."
        (let ((key (nth 0 option)))
          (setq value-type (nth 1 option))
          (if (listp key)
        (let ((key (nth 0 option)))
          (setq value-type (nth 1 option))
          (if (listp key)

-             (setq key-type ,key)
+             (setq key-type key)

            (setq key-type `(const ,key))))
       (setq key-type `(const ,option)
            value-type widget-plist-value-type))
            (setq key-type `(const ,key))))
       (setq key-type `(const ,option)
            value-type widget-plist-value-type))


@@ -3347,11 +3404,10 @@ 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))
 (defun widget-alist-convert-widget (widget)
   ;; Handle `:options'.
   (let* ((options (widget-get widget :options))

-        (key-type (widget-get widget :key-type))

         (widget-alist-value-type (widget-get widget :value-type))
         (widget-alist-value-type (widget-get widget :value-type))

-        (other `(editable-list :inline t 
+        (other `(editable-list :inline t

                                (cons :format "%v"
                                (cons :format "%v"

-                                     ,key-type
+                                     ,(widget-get widget :key-type)

                                      ,widget-alist-value-type)))
         (args (if options
                   (list `(checklist :inline t
                                      ,widget-alist-value-type)))
         (args (if options
                   (list `(checklist :inline t


@@ -3370,7 +3426,7 @@ To use this type, you must define :match or :match-alternatives."
        (let ((key (nth 0 option)))
          (setq value-type (nth 1 option))
          (if (listp key)
        (let ((key (nth 0 option)))
          (setq value-type (nth 1 option))
          (if (listp key)

-             (setq key-type ,key)
+             (setq key-type key)

            (setq key-type `(const ,key))))
       (setq key-type `(const ,option)
            value-type widget-alist-value-type))
            (setq key-type `(const ,key))))
       (setq key-type `(const ,option)
            value-type widget-alist-value-type))


@@ -3385,11 +3441,11 @@ To use this type, you must define :match or :match-alternatives."
   :prompt-value 'widget-choice-prompt-value)
 
 (defun widget-choice-prompt-value (widget prompt value unbound)
   :prompt-value 'widget-choice-prompt-value)
 
 (defun widget-choice-prompt-value (widget prompt value unbound)

-  "Make a choice." 
+  "Make a choice."

   (let ((args (widget-get widget :args))
        (completion-ignore-case (widget-get widget :case-fold))
        current choices old)
   (let ((args (widget-get widget :args))
        (completion-ignore-case (widget-get widget :case-fold))
        current choices old)

-    ;; Find the first arg that match VALUE.
+    ;; Find the first arg that matches VALUE.

     (let ((look args))
       (while look
        (if (widget-apply (car look) :match value)
     (let ((look args))
       (while look
        (if (widget-apply (car look) :match value)


@@ -3458,7 +3514,8 @@ To use this type, you must define :match or :match-alternatives."
 \f
 ;;; The `color' Widget.
 
 \f
 ;;; The `color' Widget.
 

-(define-widget 'color 'editable-field 
+;; Fixme: match
+(define-widget 'color 'editable-field

   "Choose a color name (with sample)."
   :format "%t: %v (%{sample%})\n"
   :size 10
   "Choose a color name (with sample)."
   :format "%t: %v (%{sample%})\n"
   :size 10


@@ -3471,9 +3528,10 @@ To use this type, you must define :match or :match-alternatives."
 
 (defun widget-color-complete (widget)
   "Complete the color in WIDGET."
 
 (defun widget-color-complete (widget)
   "Complete the color in WIDGET."

+  (require 'facemenu)                  ; for facemenu-color-alist

   (let* ((prefix (buffer-substring-no-properties (widget-field-start widget)
                                                 (point)))
   (let* ((prefix (buffer-substring-no-properties (widget-field-start widget)
                                                 (point)))

-        (list (widget-color-choice-list))
+        (list (or facemenu-color-alist (defined-colors)))

         (completion (try-completion prefix list)))
     (cond ((eq completion t)
           (message "Exact match."))
         (completion (try-completion prefix list)))
     (cond ((eq completion t)
           (message "Exact match."))


@@ -3483,52 +3541,25 @@ To use this type, you must define :match or :match-alternatives."
           (insert-and-inherit (substring completion (length prefix))))
          (t
           (message "Making completion list...")
           (insert-and-inherit (substring completion (length prefix))))
          (t
           (message "Making completion list...")

-          (let ((list (all-completions prefix list nil)))
-            (with-output-to-temp-buffer "*Completions*"
-              (display-completion-list list)))
+          (with-output-to-temp-buffer "*Completions*"
+            (display-completion-list (all-completions prefix list nil)))

           (message "Making completion list...done")))))
 
 (defun widget-color-sample-face-get (widget)
   (let* ((value (condition-case nil
                    (widget-value widget)
           (message "Making completion list...done")))))
 
 (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))))
-
-(defvar widget-color-choice-list nil)
-;; Variable holding the possible colors.
-
-(defun widget-color-choice-list ()
-  (unless widget-color-choice-list
-    (setq widget-color-choice-list 
-         (mapcar '(lambda (color) (list color))
-                 (x-defined-colors))))
-  widget-color-choice-list)
-
-(defvar widget-color-history nil
-  "History of entered colors")
+                 (error (widget-get widget :value)))))
+    (if (color-defined-p value)
+       (list (cons 'foreground-color value))
+      'default)))

 
 (defun widget-color-action (widget &optional event)
 
 (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))
   (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 (if (commandp 'read-color)
-                    (read-color prompt)
-                  (completing-read (concat tag ": ")
-                                   (widget-color-choice-list) 
-                                   nil nil 
-                                   (cons value pos)
-                                   'widget-color-history))))
+        (answer (facemenu-read-color prompt)))

     (unless (zerop (length answer))
       (widget-value-set widget answer)
       (widget-setup)
     (unless (zerop (length answer))
       (widget-value-set widget answer)
       (widget-setup)


@@ -3536,61 +3567,23 @@ To use this type, you must define :match or :match-alternatives."
 
 (defun widget-color-notify (widget child &optional event)
   "Update the sample, and notofy the parent."
 
 (defun widget-color-notify (widget child &optional event)
   "Update the sample, and notofy the parent."

-  (overlay-put (widget-get widget :sample-overlay) 
+  (overlay-put (widget-get widget :sample-overlay)

               'face (widget-apply widget :sample-face-get))
   (widget-default-notify widget child event))
 \f
 ;;; The Help Echo
 
               'face (widget-apply widget :sample-face-get))
   (widget-default-notify widget child event))
 \f
 ;;; The Help Echo
 

-(defun widget-echo-help-mouse ()
-  "Display the help message for the widget under the mouse.
-Enable with (run-with-idle-timer 1 t 'widget-echo-help-mouse)"
-  (let* ((pos (mouse-position))
-        (frame (car pos))
-        (x (car (cdr pos)))
-        (y (cdr (cdr pos)))
-        (win (window-at x y frame))
-        (where (coordinates-in-window-p (cons x y) win)))
-    (when (consp where)
-      (save-window-excursion
-       (progn ; save-excursion
-         (select-window win)
-         (let* ((result (compute-motion (window-start win)
-                                        '(0 . 0)
-                                        (point-max)
-                                        where
-                                        (window-width win)
-                                        (cons (window-hscroll) 0)
-                                        win)))
-           (when (and (eq (nth 1 result) x)
-                      (eq (nth 2 result) y))
-             (widget-echo-help (nth 0 result))))))))
-  (unless track-mouse
-    (setq track-mouse t)
-    (add-hook 'post-command-hook 'widget-stop-mouse-tracking)))
-
-(defun widget-stop-mouse-tracking (&rest args)
-  "Stop the mouse tracking done while idle."
-  (remove-hook 'post-command-hook 'widget-stop-mouse-tracking)
-  (setq track-mouse nil))
-
-(defun widget-at (pos)
-  "The button or field at POS."
-  (or (get-char-property pos 'button)
-      (get-char-property pos 'field)))
-

 (defun widget-echo-help (pos)
 (defun widget-echo-help (pos)

-  "Display the help echo for widget at POS."
+  "Display help-echo text for widget at POS."

   (let* ((widget (widget-at pos))
         (help-echo (and widget (widget-get widget :help-echo))))
   (let* ((widget (widget-at pos))
         (help-echo (and widget (widget-get widget :help-echo))))

-    (cond ((stringp help-echo)
-          (message "%s" help-echo))
-         ((and (symbolp help-echo) (fboundp help-echo)
-               (stringp (setq help-echo (funcall help-echo widget))))
-          (message "%s" help-echo)))))
+    (if (functionp help-echo)
+       (setq help-echo (funcall help-echo widget)))
+    (if help-echo (message "%s" (eval help-echo)))))

 
 ;;; The End:
 
 (provide 'wid-edit)
 
 
 ;;; The End:
 
 (provide 'wid-edit)
 

-;; wid-edit.el ends here
+;;; arch-tag: a076e75e-18a1-4b46-8be5-3f317bcbc707
+;;; wid-edit.el ends here