Initial revision

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

diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index dc69b0ca82875be8918584e04ee7e43a36b03b9c..583ab54fbc2008dd92989d12cc30689fa0d348e3 100644 (file)
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: extensions
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: extensions

-;; Version: 1.9920
+;; Version: 1.9951

 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;; This file is part of GNU Emacs.
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;; This file is part of GNU Emacs.


@@ -34,34 +34,17 @@
 (eval-when-compile (require 'cl))
 
 ;;; Compatibility.
 (eval-when-compile (require 'cl))
 
 ;;; Compatibility.

+  
+(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")
 
 (eval-and-compile
   (autoload 'pp-to-string "pp")
   (autoload 'Info-goto-node "info")

-
-  (when (string-match "XEmacs" emacs-version)
-    (condition-case nil
-       (require 'overlay)
-      (error (load-library "x-overlay"))))
-  
-  (if (string-match "XEmacs" emacs-version)
-      (defun widget-event-point (event)
-       "Character position of the end of event if that exists, or nil."
-       (if (mouse-event-p event)
-           (event-point event)
-         nil))
-    (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 (if (string-match "XEmacs" emacs-version)
-                                  'next-event
-                                'read-event))
-
-  ;; The following should go away when bundled with Emacs.
-  (condition-case ()
-      (require 'custom)
-    (error nil))
+  (autoload 'finder-commentary "finder" nil t)

 
   (unless (and (featurep 'custom) (fboundp 'custom-declare-variable))
     ;; We have the old custom-library, hack around it!
 
   (unless (and (featurep 'custom) (fboundp 'custom-declare-variable))
     ;; We have the old custom-library, hack around it!


@@ -82,37 +65,7 @@
       (and (eventp event)
           (memq (event-basic-type event) '(mouse-1 mouse-2 mouse-3))
           (or (memq 'click (event-modifiers event))
       (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))))))
-
-  (unless (fboundp 'error-message-string)
-    ;; Emacs function missing in XEmacs.
-    (defun error-message-string (obj)
-      "Convert an error value to an error message."
-      (let ((buf (get-buffer-create " *error-message*")))
-       (erase-buffer buf)
-       (display-error obj buf)
-       (buffer-string buf)))))
-
-(when (let ((a "foo"))
-       (put-text-property 1 2 'foo 1 a)
-       (put-text-property 1 2 'bar 2 a)
-       (set-text-properties 1 2 nil a)
-       (text-properties-at 1 a))
-  ;; XEmacs 20.2 and earlier had a buggy set-text-properties.
-  (defun set-text-properties (start end props &optional buffer-or-string)
-    "Completely replace properties of text from START to END.
-The third argument PROPS is the new property list.
-The optional fourth argument, BUFFER-OR-STRING,
-is the string or buffer containing the text."
-    (map-extents #'(lambda (extent ignored)
-                    (remove-text-properties
-                     start end
-                     (list (extent-property extent 'text-prop)
-                           nil)
-                     buffer-or-string)
-                    nil)
-                buffer-or-string start end nil nil 'text-prop)
-    (add-text-properties start end props buffer-or-string)))
+              (memq  'drag (event-modifiers event)))))))

 
 ;;; Customization.
 
 
 ;;; Customization.
 


@@ -121,6 +74,7 @@ is the string or buffer containing the text."
   :link '(custom-manual "(widget)Top")
   :link '(url-link :tag "Development Page" 
                   "http://www.dina.kvl.dk/~abraham/custom/")
   :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
   :group 'hypermedia)
   :prefix "widget-"
   :group 'extensions
   :group 'hypermedia)


@@ -134,6 +88,10 @@ is the string or buffer containing the text."
   :group 'widgets
   :group 'faces)
 
   :group 'widgets
   :group 'faces)
 

+(defvar widget-documentation-face 'widget-documentation-face
+  "Face used for documentation strings in widges.
+This exists as a variable so it can be set locally in certain buffers.")
+

 (defface widget-documentation-face '((((class color)
                                       (background dark))
                                      (:foreground "lime green"))
 (defface widget-documentation-face '((((class color)
                                       (background dark))
                                      (:foreground "lime green"))


@@ -145,6 +103,10 @@ is the string or buffer containing the text."
   :group 'widget-documentation
   :group 'widget-faces)
 
   :group 'widget-documentation
   :group 'widget-faces)
 

+(defvar widget-button-face 'widget-button-face
+  "Face used for buttons in widges.
+This exists as a variable so it can be set locally in certain buffers.")
+

 (defface widget-button-face '((t (:bold t)))
   "Face used for widget buttons."
   :group 'widget-faces)
 (defface widget-button-face '((t (:bold t)))
   "Face used for widget buttons."
   :group 'widget-faces)


@@ -165,21 +127,33 @@ is the string or buffer containing the text."
   "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)
+                                          (background light))
+                                         (:background "gray85"))
+                                        (((class grayscale color)
+                                          (background dark))
+                                         (:background "dim gray"))
+                                        (t 
+                                         (:italic t)))
+  "Face used for editable fields spanning only a single line."
+  :group 'widget-faces)
+
+;;; This causes display-table to be loaded, and not usefully.
+;;;(defvar widget-single-line-display-table
+;;;  (let ((table (make-display-table)))
+;;;    (aset table 9  "^I")
+;;;    (aset table 10 "^J")
+;;;    table)
+;;;  "Display table used for single-line editable fields.")
+
+;;;(when (fboundp 'set-face-display-table)
+;;;  (set-face-display-table 'widget-single-line-field-face
+;;;                      widget-single-line-display-table))
+

 ;;; Utility functions.
 ;;
 ;; These are not really widget specific.
 
 ;;; Utility functions.
 ;;
 ;; These are not really widget specific.
 

-(defsubst widget-plist-member (plist prop)
-  ;; Return non-nil if PLIST has the property PROP.
-  ;; PLIST is a property list, which is a list of the form
-  ;; (PROP1 VALUE1 PROP2 VALUE2 ...).  PROP is a symbol.
-  ;; Unlike `plist-get', this allows you to distinguish between a missing
-  ;; property and a property with the value nil.
-  ;; The value is actually the tail of PLIST whose car is PROP.
-  (while (and plist (not (eq (car plist) prop)))
-    (setq plist (cdr (cdr plist))))
-  plist)
-

 (defun widget-princ-to-string (object)
   ;; Return string representation of OBJECT, any Lisp object.
   ;; No quoting characters are used; no delimiters are printed around
 (defun widget-princ-to-string (object)
   ;; Return string representation of OBJECT, any Lisp object.
   ;; No quoting characters are used; no delimiters are printed around


@@ -202,6 +176,13 @@ Larger menus are read through the minibuffer."
   :group 'widgets
   :type 'integer)
 
   :group 'widgets
   :type 'integer)
 

+(defcustom widget-menu-minibuffer-flag (string-match "XEmacs" emacs-version)
+  "*Control how to ask for a choice from the keyboard.
+Non-nil means use the minibuffer;
+nil means read a single character."
+  :group 'widgets
+  :type 'boolean)
+

 (defun widget-choose (title items &optional event)
   "Choose an item from a list.
 
 (defun widget-choose (title items &optional event)
   "Choose an item from a list.
 


@@ -221,24 +202,8 @@ minibuffer."
         ;; We are in Emacs-19, pressed by the mouse
         (x-popup-menu event
                       (list title (cons "" items))))
         ;; We are in Emacs-19, pressed by the mouse
         (x-popup-menu event
                       (list title (cons "" items))))

-       ((and (< (length items) widget-menu-max-size)
-             event (fboundp 'popup-menu) window-system)
-        ;; We are in XEmacs, pressed by the mouse
-        (let ((val (get-popup-menu-response
-                    (cons title
-                          (mapcar
-                           (function
-                            (lambda (x)
-                              (if (stringp x)
-                                  (vector x nil nil) 
-                                (vector (car x) (list (car x)) t))))
-                           items)))))
-          (setq val (and val
-                         (listp (event-object val))
-                         (stringp (car-safe (event-object val)))
-                         (car (event-object val))))
-          (cdr (assoc val items))))
-       (t
+       (widget-menu-minibuffer-flag
+        ;; Read the choice of name from the minibuffer.

         (setq items (widget-remove-if 'stringp items))
         (let ((val (completing-read (concat title ": ") items nil t)))
           (if (stringp val)
         (setq items (widget-remove-if 'stringp items))
         (let ((val (completing-read (concat title ": ") items nil t)))
           (if (stringp val)


@@ -246,7 +211,70 @@ minibuffer."
                 (when (stringp try)
                   (setq val try))
                 (cdr (assoc val items)))
                 (when (stringp try)
                   (setq val try))
                 (cdr (assoc val items)))

-            nil)))))
+            nil)))
+       (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)
+          ;; 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"))
+            (erase-buffer)
+            (insert "Available choices:\n\n")
+            (while items
+              (setq choice (car items) items (cdr items))
+              (if (consp choice)
+                  (let* ((name (car choice))
+                        (function (cdr choice)))
+                    (insert (format "%c = %s\n" next-digit name))
+                    (define-key map (vector next-digit) function)
+                    (setq some-choice-enabled t)))
+              ;; Allocate digits to disabled alternatives
+              ;; so that the digit of a given alternative never varies.
+              (setq next-digit (1+ next-digit)))
+            (insert "\nC-g = Quit"))
+          (or some-choice-enabled
+              (error "None of the choices is currently meaningful"))
+          (define-key map [?\C-g] 'keyboard-quit)
+          (define-key map [t] 'keyboard-quit)
+          (define-key map [?\M-\C-v] 'scroll-other-window)
+          (define-key map [?\M--] 'negative-argument)
+          (setcdr map (nreverse (cdr map)))
+          ;; Read a char with the menu, and return the result
+          ;; that corresponds to it.
+          (save-window-excursion
+            (let ((buf (get-buffer " widget-choose")))
+              (display-buffer buf)
+              (let ((cursor-in-echo-area t)
+                    keys
+                    (char 0)
+                    (arg 1))
+                (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 keys (read-key-sequence title))
+                  (setq value (lookup-key overriding-terminal-local-map keys t)
+                        char (string-to-char (substring keys 1)))
+                  (cond ((eq value 'scroll-other-window)
+                         (let ((minibuffer-scroll-window (get-buffer-window buf)))
+                           (if (> 0 arg)
+                               (scroll-other-window-down (window-height minibuffer-scroll-window))
+                             (scroll-other-window))
+                           (setq arg 1)))
+                        ((eq value 'negative-argument)
+                         (setq arg -1))
+                        (t
+                         (setq arg 1)))))))
+          (when (eq value 'keyboard-quit)
+            (error "Canceled"))
+          value))))

 
 (defun widget-remove-if (predictate list)
   (let (result (tail list))
 
 (defun widget-remove-if (predictate list)
   (let (result (tail list))


@@ -260,18 +288,6 @@ minibuffer."
 ;; 
 ;; These functions are for specifying text properties. 
 
 ;; 
 ;; These functions are for specifying text properties. 
 

-(defun widget-specify-none (from to)
-  ;; Clear all text properties between FROM and TO.
-  (set-text-properties from to nil))
-
-(defun widget-specify-text (from to)
-  ;; Default properties.
-  (add-text-properties from to (list 'read-only t
-                                    'front-sticky t
-                                    'rear-nonsticky nil
-                                    'start-open nil
-                                    'end-open nil)))
-

 (defcustom widget-field-add-space 
   (or (< emacs-major-version 20)
       (and (eq emacs-major-version 20)
 (defcustom widget-field-add-space 
   (or (< emacs-major-version 20)
       (and (eq emacs-major-version 20)


@@ -285,25 +301,35 @@ size field."
   :type 'boolean
   :group 'widgets)
 
   :type 'boolean
   :group 'widgets)
 

+(defcustom widget-field-use-before-change
+  (and (or (> emacs-minor-version 34)
+          (> emacs-major-version 19))
+       (not (string-match "XEmacs" emacs-version)))
+  "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. 
+Using before hooks also means that the :notify function can't know the
+new value."
+  :type 'boolean
+  :group 'widgets)
+

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

-  (put-text-property from to 'read-only nil)

   ;; Terminating space is not part of the field, but necessary in
   ;; order for local-map to work.  Remove next sexp if local-map works
   ;; at the end of the overlay.
   (save-excursion
     (goto-char to)
   ;; Terminating space is not part of the field, but necessary in
   ;; order for local-map to work.  Remove next sexp if local-map works
   ;; at the end of the overlay.
   (save-excursion
     (goto-char to)

-    (when widget-field-add-space
-      (insert-and-inherit " "))
+    (cond ((null (widget-get widget :size))
+          (forward-char 1))
+         (widget-field-add-space
+          (insert-and-inherit " ")))

     (setq to (point)))
     (setq to (point)))

-  (add-text-properties (1- to) to ;to (1+ to) 
-                      '(front-sticky nil start-open t read-only to))
-  (add-text-properties (1- from) from 
-                      '(rear-nonsticky t end-open t read-only from))

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

-       (overlay (make-overlay from to nil nil t)))
+       (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)
     (unless (or (stringp help-echo) (null help-echo))
       (setq help-echo 'widget-mouse-help))    
     (widget-put widget :field-overlay overlay)


@@ -313,7 +339,26 @@ size field."
     (overlay-put overlay 'keymap map)
     (overlay-put overlay 'face face)
     (overlay-put overlay 'balloon-help help-echo)
     (overlay-put overlay 'keymap map)
     (overlay-put overlay 'face face)
     (overlay-put overlay 'balloon-help help-echo)

-    (overlay-put overlay 'help-echo help-echo)))
+    (overlay-put overlay 'help-echo help-echo))
+  (widget-specify-secret widget))
+
+(defun widget-specify-secret (field)
+  "Replace text in FIELD with value of `:secret', if non-nil."
+  (let ((secret (widget-get field :secret))
+       (size (widget-get field :size)))
+    (when secret
+      (let ((begin (widget-field-start field))
+           (end (widget-field-end field)))
+       (when size 
+         (while (and (> end begin)
+                     (eq (char-after (1- end)) ?\ ))
+           (setq end (1- end))))
+       (while (< begin end)
+         (let ((old (char-after begin)))
+           (unless (eq old secret)
+             (subst-char-in-region begin (1+ begin) old secret)
+             (put-text-property begin (1+ begin) 'secret old))
+           (setq begin (1+ begin))))))))

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


@@ -343,15 +388,17 @@ size field."
 
 (defun widget-specify-sample (widget from to)
   ;; Specify sample for WIDGET between FROM and TO.
 
 (defun widget-specify-sample (widget from to)
   ;; Specify sample for WIDGET between FROM and TO.

-  (let ((face (widget-apply widget :sample-face-get)))
-    (when face
-      (add-text-properties from to (list 'start-open t
-                                        'end-open t
-                                        'face face)))))
+  (let ((face (widget-apply widget :sample-face-get))
+       (overlay (make-overlay from to nil t nil)))
+    (overlay-put overlay 'face face)
+    (widget-put widget :sample-overlay overlay)))
+

 (defun widget-specify-doc (widget from to)
   ;; Specify documentation for WIDGET between FROM and TO.
 (defun widget-specify-doc (widget from to)
   ;; Specify documentation for WIDGET between FROM and TO.

-  (add-text-properties from to (list 'widget-doc widget
-                                    '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)
+    (widget-put widget :doc-overlay overlay)))

 
 (defmacro widget-specify-insert (&rest form)
   ;; Execute FORM without inheriting any text properties.
 
 (defmacro widget-specify-insert (&rest form)
   ;; Execute FORM without inheriting any text properties.


@@ -359,10 +406,10 @@ size field."
    (save-restriction
      (let ((inhibit-read-only t)
           result
    (save-restriction
      (let ((inhibit-read-only t)
           result

+          before-change-functions

           after-change-functions)
        (insert "<>")
        (narrow-to-region (- (point) 2) (point))
           after-change-functions)
        (insert "<>")
        (narrow-to-region (- (point) 2) (point))

-       (widget-specify-none (point-min) (point-max))

        (goto-char (1+ (point-min)))
        (setq result (progn (,@ form)))
        (delete-region (point-min) (1+ (point-min)))
        (goto-char (1+ (point-min)))
        (setq result (progn (,@ form)))
        (delete-region (point-min) (1+ (point-min)))


@@ -375,7 +422,7 @@ size field."
                                 (:foreground "light gray"))
                                (((class grayscale color)
                                  (background light))
                                 (:foreground "light gray"))
                                (((class grayscale color)
                                  (background light))

-                                (:foreground "dark gray"))
+                                (:foreground "dim gray"))

                                (t 
                                 (:italic t)))
   "Face used for inactive widgets."
                                (t 
                                 (:italic t)))
   "Face used for inactive widgets."


@@ -414,26 +461,14 @@ size field."
   "Return the type of WIDGET, a symbol."
   (car widget))
 
   "Return the type of WIDGET, a symbol."
   (car widget))
 

-(defun widget-put (widget property value)
-  "In WIDGET set PROPERTY to VALUE.
-The value can later be retrived with `widget-get'."
-  (setcdr widget (plist-put (cdr widget) property value)))
-
-(defun widget-get (widget property)
+(defun widget-get-indirect (widget property)

   "In WIDGET, get the value of PROPERTY.
   "In WIDGET, get the value of PROPERTY.

-The value could either be specified when the widget was created, or
-later with `widget-put'."
-  (let ((missing t)
-       value tmp)
-    (while missing
-      (cond ((setq tmp (widget-plist-member (cdr widget) property))
-            (setq value (car (cdr tmp))
-                  missing nil))
-           ((setq tmp (car widget))
-            (setq widget (get tmp 'widget-type)))
-           (t 
-            (setq missing nil))))
-    value))
+If the value is a symbol, return its binding.  
+Otherwise, just return the value."
+  (let ((value (widget-get widget property)))
+    (if (symbolp value)
+       (symbol-value value)
+      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."


@@ -443,12 +478,6 @@ later with `widget-put'."
         (widget-member (get (car widget) 'widget-type) property))
        (t nil)))
 
         (widget-member (get (car widget) 'widget-type) property))
        (t nil)))
 

-;;;###autoload
-(defun widget-apply (widget property &rest args)
-  "Apply the value of WIDGET's PROPERTY to the widget itself.
-ARGS are passed as extra arguments to the function."
-  (apply (widget-get widget property) widget args))
-

 (defun widget-value (widget)
   "Extract the current value of WIDGET."
   (widget-apply widget
 (defun widget-value (widget)
   "Extract the current value of WIDGET."
   (widget-apply widget


@@ -460,6 +489,11 @@ ARGS are passed as extra arguments to the function."
                :value-set (widget-apply widget
                                         :value-to-internal value)))
 
                :value-set (widget-apply 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)))
+

 (defun widget-match-inline (widget vals)
   ;; In WIDGET, match the start of VALS.
   (cond ((widget-get widget :inline)
 (defun widget-match-inline (widget vals)
   ;; In WIDGET, match the start of VALS.
   (cond ((widget-get widget :inline)


@@ -628,14 +662,15 @@ provide the fallback TAG as a part of the instantiator yourself."
   "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."
   "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."

-  (set-glyph-property glyph 'widget widget)
-  (when down
-    (set-glyph-property down 'widget widget))
-  (when inactive
-    (set-glyph-property inactive 'widget widget))
+  (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))))
   (insert "*")
   (let ((ext (make-extent (point) (1- (point))))

-       (help-echo (widget-get widget :help-echo)))
+       (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-property ext 'invisible t)
     (set-extent-property ext 'start-open t)
     (set-extent-property ext 'end-open t)


@@ -643,9 +678,10 @@ glyphs used when the widget is pushed and inactive, respectively."
     (when help-echo
       (set-extent-property ext 'balloon-help help-echo)
       (set-extent-property ext 'help-echo help-echo)))
     (when help-echo
       (set-extent-property ext 'balloon-help help-echo)
       (set-extent-property ext 'help-echo help-echo)))

-  (widget-put widget :glyph-up glyph)
-  (when down (widget-put widget :glyph-down down))
-  (when inactive (widget-put widget :glyph-inactive inactive)))
+  (when widget
+    (widget-put widget :glyph-up glyph)
+    (when down (widget-put widget :glyph-down down))
+    (when inactive (widget-put widget :glyph-inactive inactive))))

 
 ;;; Buttons.
 
 
 ;;; Buttons.
 


@@ -663,14 +699,6 @@ glyphs used when the widget is pushed and inactive, respectively."
   :type 'string
   :group 'widget-button)
 
   :type 'string
   :group 'widget-button)
 

-(defun widget-button-insert-indirect (widget key)
-  "Insert value of WIDGET's KEY property."
-  (let ((val (widget-get widget key)))
-    (while (and val (symbolp val))
-      (setq val (symbol-value val)))
-    (when val 
-      (insert val))))
-

 ;;; Creating Widgets.
 
 ;;;###autoload
 ;;; Creating Widgets.
 
 ;;;###autoload


@@ -769,10 +797,10 @@ The optional ARGS are additional keyword arguments."
 (defun widget-insert (&rest args)
   "Call `insert' with ARGS and make the text read only."
   (let ((inhibit-read-only t)
 (defun widget-insert (&rest args)
   "Call `insert' with ARGS and make the text read only."
   (let ((inhibit-read-only t)

+       before-change-functions

        after-change-functions
        (from (point)))
        after-change-functions
        (from (point)))

-    (apply 'insert args)
-    (widget-specify-text from (point))))
+    (apply 'insert args)))

 
 (defun widget-convert-text (type from to
                                 &optional button-from button-to
 
 (defun widget-convert-text (type from to
                                 &optional button-from button-to


@@ -786,7 +814,6 @@ Optional ARGS are extra keyword arguments for TYPE."
   (let ((widget (apply 'widget-convert type :delete 'widget-leave-text args))
        (from (copy-marker from))
        (to (copy-marker to)))
   (let ((widget (apply 'widget-convert type :delete 'widget-leave-text args))
        (from (copy-marker from))
        (to (copy-marker to)))

-    (widget-specify-text from to)

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


@@ -808,12 +835,20 @@ button end points."
   (let ((from (widget-get widget :from))
        (to (widget-get widget :to))
        (button (widget-get widget :button-overlay))
   (let ((from (widget-get widget :from))
        (to (widget-get widget :to))
        (button (widget-get widget :button-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))
        (children (widget-get widget :children)))
     (set-marker from nil)
     (set-marker to nil)

-    (delete-overlay button)
-    (delete-overlay field)
+    (when button
+      (delete-overlay button))
+    (when sample
+      (delete-overlay sample))
+    (when doc
+      (delete-overlay doc))
+    (when field
+      (delete-overlay field))

     (mapcar 'widget-leave-text children)))
 
 ;;; Keymap and Commands.
     (mapcar 'widget-leave-text children)))
 
 ;;; Keymap and Commands.


@@ -882,8 +917,9 @@ Recommended as a parent keymap for modes using widgets.")
   :group 'widget-faces)
 
 (defun widget-button-click (event)
   :group 'widget-faces)
 
 (defun widget-button-click (event)

-  "Invoke button below mouse pointer."
+  "Invoke the button that the mouse is pointing at, and move there."

   (interactive "@e")
   (interactive "@e")

+  (mouse-set-point event)

   (cond ((and (fboundp 'event-glyph)
              (event-glyph event))
         (widget-glyph-click event))
   (cond ((and (fboundp 'event-glyph)
              (event-glyph event))
         (widget-glyph-click event))


@@ -921,24 +957,25 @@ Recommended as a parent keymap for modes using widgets.")
                         (widget-apply-action button event)))
                   (overlay-put overlay 'face face)
                   (overlay-put overlay 'mouse-face mouse-face)))
                         (widget-apply-action button event)))
                   (overlay-put overlay 'face face)
                   (overlay-put overlay 'mouse-face mouse-face)))

-            (let (command up)
+            (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
               ;; 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 ])))
+                           (lookup-key widget-global-map [ button2 ]))
+                     (setq up nil))

                     ((setq command     ;down event
                     ((setq command     ;down event

-                           (lookup-key widget-global-map [ down-mouse-2 ])))
+                           (lookup-key widget-global-map [ down-mouse-2 ]))
+                     (setq up nil))

                     ((setq command     ;up event
                     ((setq command     ;up event

-                           (lookup-key widget-global-map [ button2up ]))
-                     (setq up t))
+                           (lookup-key widget-global-map [ button2up ])))

                     ((setq command     ;up event
                     ((setq command     ;up event

-                           (lookup-key widget-global-map [ mouse-2]))
-                     (setq up t)))
-              (when command
+                           (lookup-key widget-global-map [ mouse-2]))))
+              (when up

                 ;; Don't execute up events twice.
                 ;; Don't execute up events twice.

-                (when up
-                  (while (not (button-release-event-p event))
-                    (setq event (widget-read-event))))
+                (while (not (button-release-event-p event))
+                  (setq event (widget-read-event))))
+              (when command

                 (call-interactively command))))))
        (t
         (message "You clicked somewhere weird."))))
                 (call-interactively command))))))
        (t
         (message "You clicked somewhere weird."))))


@@ -964,7 +1001,7 @@ Recommended as a parent keymap for modes using widgets.")
       (if (eq extent (event-glyph-extent last))
          (set-extent-property extent 'end-glyph down-glyph)
        (set-extent-property extent 'end-glyph up-glyph))
       (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 (next-event event)))
+      (setq last (read-event event)))

     ;; Release glyph.
     (when down-glyph
       (set-extent-property extent 'end-glyph up-glyph))
     ;; Release glyph.
     (when down-glyph
       (set-extent-property extent 'end-glyph up-glyph))


@@ -1004,6 +1041,12 @@ POS defaults to the value of (point)."
            widget))
       nil)))
 
            widget))
       nil)))
 

+(defcustom widget-use-overlay-change (string-match "XEmacs" emacs-version)
+  "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)
+

 (defun widget-move (arg)
   "Move point to the ARG next field or button.
 ARG may be negative to move backward."
 (defun widget-move (arg)
   "Move point to the ARG next field or button.
 ARG may be negative to move backward."


@@ -1014,9 +1057,12 @@ ARG may be negative to move backward."
        new)
     ;; Forward.
     (while (> arg 0)
        new)
     ;; Forward.
     (while (> arg 0)

-      (if (eobp)
-         (goto-char (point-min))
-       (forward-char 1))
+      (cond ((eobp)
+            (goto-char (point-min)))
+           (widget-use-overlay-change
+            (goto-char (next-overlay-change (point))))
+           (t
+            (forward-char 1)))

       (and (eq pos (point))
           (eq arg number)
           (error "No buttons or fields found"))
       (and (eq pos (point))
           (eq arg number)
           (error "No buttons or fields found"))


@@ -1027,9 +1073,12 @@ ARG may be negative to move backward."
            (setq old new)))))
     ;; Backward.
     (while (< arg 0)
            (setq old new)))))
     ;; Backward.
     (while (< arg 0)

-      (if (bobp)
-         (goto-char (point-max))
-       (backward-char 1))
+      (cond ((bobp)
+            (goto-char (point-max)))
+           (widget-use-overlay-change
+            (goto-char (previous-overlay-change (point))))
+           (t
+            (backward-char 1)))

       (and (eq pos (point))
           (eq arg number)
           (error "No buttons or fields found"))
       (and (eq pos (point))
           (eq arg number)
           (error "No buttons or fields found"))


@@ -1062,19 +1111,25 @@ With optional ARG, move across that many fields."
   "Go to beginning of field or beginning of line, whichever is first."
   (interactive)
   (let* ((field (widget-field-find (point)))
   "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))))
-    (if (and start (not (eq start (point))))
-       (goto-char start)
-      (call-interactively 'beginning-of-line))))
+        (start (and field (widget-field-start field)))
+         (bol (save-excursion
+                (beginning-of-line)
+                (point))))
+    (goto-char (if start
+                   (max start bol)
+                 bol))))

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

-        (end (and field (widget-field-end field))))
-    (if (and end (not (eq end (point))))
-       (goto-char end)
-      (call-interactively 'end-of-line))))
+        (end (and field (widget-field-end field)))
+         (eol (save-excursion
+                (end-of-line)
+                (point))))
+    (goto-char (if end
+                   (min end eol)
+                 eol))))

 
 (defun widget-kill-line ()
   "Kill to end of field or end of line, whichever is first."
 
 (defun widget-kill-line ()
   "Kill to end of field or end of line, whichever is first."


@@ -1115,6 +1170,7 @@ When not inside a field, move to the previous button or field."
   "Setup current buffer so editing string widgets works."
   (let ((inhibit-read-only t)
        (after-change-functions nil)
   "Setup current buffer so editing string widgets works."
   (let ((inhibit-read-only t)
        (after-change-functions nil)

+       before-change-functions

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


@@ -1127,11 +1183,7 @@ When not inside a field, move to the previous button or field."
        (set-marker from nil)
        (set-marker to nil))))
   (widget-clear-undo)
        (set-marker from nil)
        (set-marker to nil))))
   (widget-clear-undo)

-  ;; We need to maintain text properties and size of the editing fields.
-  (make-local-variable 'after-change-functions)
-  (if widget-field-list
-      (setq after-change-functions '(widget-after-change))
-    (setq after-change-functions nil)))
+  (widget-add-change))

 
 (defvar widget-field-last nil)
 ;; Last field containing point.
 
 (defvar widget-field-last nil)
 ;; Last field containing point.


@@ -1155,7 +1207,8 @@ When not inside a field, move to the previous button or field."
   "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.
   "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 widget-field-add-space
+    (and overlay (if (or widget-field-add-space
+                        (null (widget-get widget :size)))

                     (1- (overlay-end overlay))
                   (overlay-end overlay)))))
 
                     (1- (overlay-end overlay))
                   (overlay-end overlay)))))
 


@@ -1175,6 +1228,31 @@ Unlike (get-char-property POS 'field) this, works with empty fields too."
          (setq found field))))
     found))
 
          (setq found field))))
     found))
 

+(defun widget-before-change (from to)
+  ;; This is how, for example, a variable changes its state to `modified'.
+  ;; when it is being edited.
+  (unless inhibit-read-only
+    (let ((from-field (widget-field-find from))
+         (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"))
+           ((null from-field)
+            (add-hook 'post-command-hook 'widget-add-change nil t)
+            (error "Attempt to change text outside editable field"))
+           (widget-field-use-before-change
+            (condition-case nil
+                (widget-apply from-field :notify from-field)
+              (error (debug "Before Change"))))))))
+
+(defun widget-add-change ()
+  (make-local-hook 'post-command-hook)
+  (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)
+  (make-local-hook 'after-change-functions)
+  (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
 (defun widget-after-change (from to old)
   ;; Adjust field size and text properties.
   (condition-case nil


@@ -1183,8 +1261,7 @@ Unlike (get-char-property POS 'field) this, works with empty fields too."
        (when field
          (unless (eq field other)
            (debug "Change in different fields"))
        (when field
          (unless (eq field other)
            (debug "Change in different fields"))

-         (let ((size (widget-get field :size))
-               (secret (widget-get field :secret)))
+         (let ((size (widget-get field :size)))

            (when size 
              (let ((begin (widget-field-start field))
                    (end (widget-field-end field)))
            (when size 
              (let ((begin (widget-field-start field))
                    (end (widget-field-end field)))


@@ -1206,19 +1283,7 @@ Unlike (get-char-property POS 'field) this, works with empty fields too."
                         (while (and (eq (preceding-char) ?\ )
                                     (> (point) begin))
                           (delete-backward-char 1)))))))
                         (while (and (eq (preceding-char) ?\ )
                                     (> (point) begin))
                           (delete-backward-char 1)))))))

-           (when secret
-             (let ((begin (widget-field-start field))
-                   (end (widget-field-end field)))
-               (when size 
-                 (while (and (> end begin)
-                             (eq (char-after (1- end)) ?\ ))
-                   (setq end (1- end))))
-               (while (< begin end)
-                 (let ((old (char-after begin)))
-                   (unless (eq old secret)
-                     (subst-char-in-region begin (1+ begin) old secret)
-                     (put-text-property begin (1+ begin) 'secret old))
-                   (setq begin (1+ begin)))))))
+           (widget-specify-secret field))

          (widget-apply field :notify field)))
     (error (debug "After Change"))))
 
          (widget-apply field :notify field)))
     (error (debug "After Change"))))
 


@@ -1286,6 +1351,7 @@ Optional EVENT is the event that triggered the action."
   :delete 'widget-default-delete
   :value-set 'widget-default-value-set
   :value-inline 'widget-default-value-inline
   :delete 'widget-default-delete
   :value-set 'widget-default-value-set
   :value-inline 'widget-default-value-inline

+  :default-get 'widget-default-default-get

   :menu-tag-get 'widget-default-menu-tag-get
   :validate (lambda (widget) nil)
   :active 'widget-default-active
   :menu-tag-get 'widget-default-menu-tag-get
   :validate (lambda (widget) nil)
   :active 'widget-default-active


@@ -1320,9 +1386,9 @@ If that does not exists, call the value of `widget-complete-field'."
                (insert "%"))
               ((eq escape ?\[)
                (setq button-begin (point))
                (insert "%"))
               ((eq escape ?\[)
                (setq button-begin (point))

-               (widget-button-insert-indirect widget :button-prefix))
+               (insert (widget-get-indirect widget :button-prefix)))

               ((eq escape ?\])
               ((eq escape ?\])

-               (widget-button-insert-indirect widget :button-suffix)
+               (insert (widget-get-indirect widget :button-suffix))

                (setq button-end (point)))
               ((eq escape ?\{)
                (setq sample-begin (point)))
                (setq button-end (point)))
               ((eq escape ?\{)
                (setq sample-begin (point)))


@@ -1369,7 +1435,6 @@ If that does not exists, call the value of `widget-complete-field'."
        (widget-apply widget :value-create)))
    (let ((from (copy-marker (point-min)))
         (to (copy-marker (point-max))))
        (widget-apply widget :value-create)))
    (let ((from (copy-marker (point-min)))
         (to (copy-marker (point-max))))

-     (widget-specify-text from to)

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


@@ -1418,7 +1483,11 @@ If that does not exists, call the value of `widget-complete-field'."
 
 (defun widget-default-button-face-get (widget)
   ;; Use :button-face or widget-button-face
 
 (defun widget-default-button-face-get (widget)
   ;; Use :button-face or widget-button-face

-  (or (widget-get widget :button-face) 'widget-button-face))
+  (or (widget-get widget :button-face)
+      (let ((parent (widget-get widget :parent)))
+       (if parent
+           (widget-apply parent :button-face-get)
+         widget-button-face))))

 
 (defun widget-default-sample-face-get (widget)
   ;; Use :sample-face.
 
 (defun widget-default-sample-face-get (widget)
   ;; Use :sample-face.


@@ -1430,6 +1499,9 @@ If that does not exists, call the value of `widget-complete-field'."
        (to (widget-get widget :to))
        (inactive-overlay (widget-get widget :inactive))
        (button-overlay (widget-get widget :button-overlay))
        (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-read-only t))
     (widget-apply widget :value-delete)
        after-change-functions
        (inhibit-read-only t))
     (widget-apply widget :value-delete)


@@ -1437,6 +1509,10 @@ If that does not exists, call the value of `widget-complete-field'."
       (delete-overlay inactive-overlay))
     (when button-overlay
       (delete-overlay button-overlay))
       (delete-overlay inactive-overlay))
     (when button-overlay
       (delete-overlay button-overlay))

+    (when sample-overlay
+      (delete-overlay sample-overlay))
+    (when doc-overlay
+      (delete-overlay doc-overlay))

     (when (< from to)
       ;; Kludge: this doesn't need to be true for empty formats.
       (delete-region from to))
     (when (< from to)
       ;; Kludge: this doesn't need to be true for empty formats.
       (delete-region from to))


@@ -1446,11 +1522,25 @@ If that does not exists, call the value of `widget-complete-field'."
 
 (defun widget-default-value-set (widget value)
   ;; Recreate widget with new value.
 
 (defun widget-default-value-set (widget value)
   ;; Recreate widget with new value.

-  (save-excursion
-    (goto-char (widget-get widget :from))
-    (widget-apply widget :delete)
-    (widget-put widget :value value)
-    (widget-apply widget :create)))
+  (let* ((old-pos (point))
+        (from (copy-marker (widget-get widget :from)))
+        (to (copy-marker (widget-get widget :to)))
+        (offset (if (and (<= from old-pos) (<= old-pos to))
+                    (if (>= old-pos (1- to))
+                        (- 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 
+    ;; stay on the same side.  -- rms.
+    (save-excursion
+      (goto-char (widget-get widget :from))
+      (widget-apply widget :delete)
+      (widget-put widget :value value)
+      (widget-apply widget :create))
+    (if offset
+       (if (< offset 0)
+           (goto-char (+ (widget-get widget :to) offset 1))
+         (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.
 
 (defun widget-default-value-inline (widget)
   ;; Wrap value in a list unless it is inline.


@@ -1458,6 +1548,10 @@ If that does not exists, call the value of `widget-complete-field'."
       (widget-value widget)
     (list (widget-value widget))))
 
       (widget-value widget)
     (list (widget-value widget))))
 

+(defun widget-default-default-get (widget)
+  ;; Get `:value'.
+  (widget-get widget :value))
+

 (defun widget-default-menu-tag-get (widget)
   ;; Use tag or value for menus.
   (or (widget-get widget :menu-tag)
 (defun widget-default-menu-tag-get (widget)
   ;; Use tag or value for menus.
   (or (widget-get widget :menu-tag)


@@ -1573,30 +1667,33 @@ If END is omitted, it defaults to the length of LIST."
   ;; Insert text representing the `on' and `off' states.
   (let* ((tag (or (widget-get widget :tag)
                  (widget-get widget :value)))
   ;; 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
                       tag widget-push-button-suffix))
         (gui (cdr (assoc tag widget-push-button-cache))))
         (text (concat widget-push-button-prefix
                       tag widget-push-button-suffix))
         (gui (cdr (assoc tag widget-push-button-cache))))

-    (if (and (fboundp 'make-gui-button)
+    (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))
             (fboundp 'make-glyph)
             widget-push-button-gui
             (fboundp 'device-on-window-system-p)
             (device-on-window-system-p)
             (string-match "XEmacs" emacs-version))

-       (progn 
-         (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)))))
-      (insert text))))
+          (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)))))

 
 (defun widget-gui-action (widget)
   "Apply :action for WIDGET."
 
 (defun widget-gui-action (widget)
   "Apply :action for WIDGET."


@@ -1639,8 +1736,57 @@ If END is omitted, it defaults to the length of LIST."
 
 (defun widget-url-link-action (widget &optional event)
   "Open the url specified by WIDGET."
 
 (defun widget-url-link-action (widget &optional event)
   "Open the url specified by WIDGET."

-  (require 'browse-url)
-  (funcall browse-url-browser-function (widget-value widget)))
+  (browse-url (widget-value widget)))
+
+;;; The `function-link' Widget.
+
+(define-widget 'function-link 'link
+  "A link to an Emacs function."
+  :action 'widget-function-link-action)
+
+(defun widget-function-link-action (widget &optional event)
+  "Show the function specified by WIDGET."
+  (describe-function (widget-value widget)))
+
+;;; The `variable-link' Widget.
+
+(define-widget 'variable-link 'link
+  "A link to an Emacs variable."
+  :action 'widget-variable-link-action)
+
+(defun widget-variable-link-action (widget &optional event)
+  "Show the variable specified by WIDGET."
+  (describe-variable (widget-value widget)))
+
+;;; The `file-link' Widget.
+
+(define-widget 'file-link 'link
+  "A link to a file."
+  :action 'widget-file-link-action)
+
+(defun widget-file-link-action (widget &optional event)
+  "Find the file specified by WIDGET."
+  (find-file (widget-value widget)))
+
+;;; The `emacs-library-link' Widget.
+
+(define-widget 'emacs-library-link 'link
+  "A link to an Emacs Lisp library file."
+  :action 'widget-emacs-library-link-action)
+
+(defun widget-emacs-library-link-action (widget &optional event)
+  "Find the Emacs Library file specified by WIDGET."
+  (find-file (locate-library (widget-value widget))))
+
+;;; The `emacs-commentary-link' Widget.
+    
+(define-widget 'emacs-commentary-link 'link
+  "A link to Commentary in an Emacs Lisp library file."
+  :action 'widget-emacs-commentary-link-action)
+    
+(defun widget-emacs-commentary-link-action (widget &optional event)
+  "Find the Commentary section of the Emacs file specified by WIDGET."
+  (finder-commentary (widget-value widget)))

 
 ;;; The `editable-field' Widget.
 
 
 ;;; The `editable-field' Widget.
 


@@ -1682,16 +1828,12 @@ If END is omitted, it defaults to the length of LIST."
                                :prompt-internal prompt initial history)))
       (widget-apply widget :value-to-external answer))))
 
                                :prompt-internal prompt initial history)))
       (widget-apply widget :value-to-external answer))))
 

+(defvar widget-edit-functions nil)
+

 (defun widget-field-action (widget &optional event)
 (defun widget-field-action (widget &optional event)

-  ;; Edit the value in the minibuffer.
-  (let ((invalid (widget-apply widget :validate)))
-    (let ((prompt (concat (widget-apply widget :menu-tag-get) ": "))
-         (value (unless invalid 
-                  (widget-value widget))))
-      (let ((answer (widget-apply widget :prompt-value prompt value invalid) ))
-       (widget-value-set widget answer)))
-    (widget-setup)
-    (widget-apply widget :notify widget event)))
+  ;; Move to next field.
+  (widget-forward 1)
+  (run-hook-with-args 'widget-edit-functions widget))

 
 (defun widget-field-validate (widget)
   ;; Valid if the content matches `:valid-regexp'.
 
 (defun widget-field-validate (widget)
   ;; Valid if the content matches `:valid-regexp'.


@@ -1707,6 +1849,9 @@ If END is omitted, it defaults to the length of LIST."
   (let ((size (widget-get widget :size))
        (value (widget-get widget :value))
        (from (point))
   (let ((size (widget-get widget :size))
        (value (widget-get widget :value))
        (from (point))

+       ;; This is changed to a real overlay in `widget-setup'.  We
+       ;; need the end points to behave differently until
+       ;; `widget-setup' is called.   

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


@@ -1780,6 +1925,7 @@ If END is omitted, it defaults to the length of LIST."
   :value-delete 'widget-children-value-delete
   :value-get 'widget-choice-value-get
   :value-inline 'widget-choice-value-inline
   :value-delete 'widget-children-value-delete
   :value-get 'widget-choice-value-get
   :value-inline 'widget-choice-value-inline

+  :default-get 'widget-choice-default-get

   :mouse-down-action 'widget-choice-mouse-down-action
   :action 'widget-choice-action
   :error "Make a choice"
   :mouse-down-action 'widget-choice-mouse-down-action
   :action 'widget-choice-action
   :error "Make a choice"


@@ -1791,21 +1937,30 @@ If END is omitted, it defaults to the length of LIST."
   ;; Insert the first choice that matches the value.
   (let ((value (widget-get widget :value))
        (args (widget-get widget :args))
   ;; 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))
+       (explicit-value (widget-get widget :explicit-choice-value))

        current)
        current)

-    (while args
-      (setq current (car args)
-           args (cdr args))
-      (when (widget-apply current :match value)
-       (widget-put widget :children (list (widget-create-child-value
-                                           widget current value)))
-       (widget-put widget :choice current)
-       (setq args nil
-             current nil)))
-    (when current
-      (let ((void (widget-get widget :void)))
-       (widget-put widget :children (list (widget-create-child-and-convert
-                                           widget void :value value)))
-       (widget-put widget :choice void)))))
+    (if (and explicit (eq value explicit-value))
+       (progn
+         ;; If the user specified the choice for this value,
+         ;; respect that choice as long as the value is the same.
+         (widget-put widget :children (list (widget-create-child-value
+                                             widget explicit value)))
+         (widget-put widget :choice explicit))
+      (while args
+       (setq current (car args)
+             args (cdr args))
+       (when (widget-apply current :match value)
+         (widget-put widget :children (list (widget-create-child-value
+                                             widget current value)))
+         (widget-put widget :choice current)
+         (setq args nil
+               current nil)))
+      (when current
+       (let ((void (widget-get widget :void)))
+         (widget-put widget :children (list (widget-create-child-and-convert
+                                             widget void :value value)))
+         (widget-put widget :choice void))))))

 
 (defun widget-choice-value-get (widget)
   ;; Get value of the child widget.
 
 (defun widget-choice-value-get (widget)
   ;; Get value of the child widget.


@@ -1815,6 +1970,10 @@ If END is omitted, it defaults to the length of LIST."
   ;; Get value of the child widget.
   (widget-apply (car (widget-get widget :children)) :value-inline))
 
   ;; 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))))
+

 (defcustom widget-choice-toggle nil
   "If non-nil, a binary choice will just toggle between the values.
 Otherwise, the user will explicitly have to choose between the values
 (defcustom widget-choice-toggle nil
   "If non-nil, a binary choice will just toggle between the values.
 Otherwise, the user will explicitly have to choose between the values


@@ -1854,6 +2013,7 @@ when he invoked the menu."
        (old (widget-get widget :choice))
        (tag (widget-apply widget :menu-tag-get))
        (completion-ignore-case (widget-get widget :case-fold))
        (old (widget-get widget :choice))
        (tag (widget-apply widget :menu-tag-get))
        (completion-ignore-case (widget-get widget :case-fold))

+       this-explicit

        current choices)
     ;; Remember old value.
     (if (and old (not (widget-apply widget :validate)))
        current choices)
     ;; Remember old value.
     (if (and old (not (widget-apply widget :validate)))


@@ -1880,13 +2040,22 @@ when he invoked the menu."
                         (cons (cons (widget-apply current :menu-tag-get)
                                     current)
                               choices)))
                         (cons (cons (widget-apply current :menu-tag-get)
                                     current)
                               choices)))

+                (setq this-explicit t)

                 (widget-choose tag (reverse choices) event))))
     (when current
                 (widget-choose tag (reverse choices) event))))
     (when current

-      (widget-value-set widget 
-                       (widget-apply current :value-to-external
-                                     (widget-get current :value)))
+      ;; If this was an explicit user choice,
+      ;; record the choice, and the record the value it was made for.
+      ;; widget-choice-value-create will respect this choice,
+      ;; as long as the value is the same.
+      (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-setup)
       (widget-setup)

-      (widget-apply widget :notify widget event))))
+      (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.
 
 (defun widget-choice-validate (widget)
   ;; Valid if we have made a valid choice.


@@ -1941,7 +2110,8 @@ when he invoked the menu."
 (defun widget-toggle-action (widget &optional event)
   ;; Toggle value.
   (widget-value-set widget (not (widget-value widget)))
 (defun widget-toggle-action (widget &optional event)
   ;; Toggle value.
   (widget-value-set widget (not (widget-value widget)))

-  (widget-apply widget :notify widget event))
+  (widget-apply widget :notify widget event)
+  (run-hook-with-args 'widget-edit-functions widget))

 
 ;;; The `checkbox' Widget.
 
 
 ;;; The `checkbox' Widget.
 


@@ -2417,6 +2587,7 @@ when he invoked the menu."
   (save-excursion
     (let ((children (widget-get widget :children))
          (inhibit-read-only t)
   (save-excursion
     (let ((children (widget-get widget :children))
          (inhibit-read-only t)

+         before-change-functions

          after-change-functions)
       (cond (before 
             (goto-char (widget-get before :entry-from)))
          after-change-functions)
       (cond (before 
             (goto-char (widget-get before :entry-from)))


@@ -2427,8 +2598,6 @@ when he invoked the menu."
        (when (< (widget-get child :entry-from) (widget-get widget :from))
          (set-marker (widget-get widget :from)
                      (widget-get child :entry-from)))
        (when (< (widget-get child :entry-from) (widget-get widget :from))
          (set-marker (widget-get widget :from)
                      (widget-get child :entry-from)))

-       (widget-specify-text (widget-get child :entry-from)
-                            (widget-get child :entry-to))

        (if (eq (car children) before)
            (widget-put widget :children (cons child children))
          (while (not (eq (car (cdr children)) before))
        (if (eq (car children) before)
            (widget-put widget :children (cons child children))
          (while (not (eq (car (cdr children)) before))


@@ -2443,6 +2612,7 @@ when he invoked the menu."
     (let ((buttons (copy-sequence (widget-get widget :buttons)))
          button
          (inhibit-read-only t)
     (let ((buttons (copy-sequence (widget-get widget :buttons)))
          button
          (inhibit-read-only t)

+         before-change-functions

          after-change-functions)
       (while buttons
        (setq button (car buttons)
          after-change-functions)
       (while buttons
        (setq button (car buttons)


@@ -2454,6 +2624,7 @@ when he invoked the menu."
     (let ((entry-from (widget-get child :entry-from))
          (entry-to (widget-get child :entry-to))
          (inhibit-read-only t)
     (let ((entry-from (widget-get child :entry-from))
          (entry-to (widget-get child :entry-to))
          (inhibit-read-only t)

+         before-change-functions

          after-change-functions)
       (widget-delete child)
       (delete-region entry-from entry-to)
          after-change-functions)
       (widget-delete child)
       (delete-region entry-from entry-to)


@@ -2491,7 +2662,10 @@ when he invoked the menu."
                (if conv
                    (setq child (widget-create-child-value 
                                 widget type value))
                (if conv
                    (setq child (widget-create-child-value 
                                 widget type value))

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

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


@@ -2500,7 +2674,6 @@ when he invoked the menu."
                                      (widget-get widget :buttons))))
      (let ((entry-from (copy-marker (point-min)))
           (entry-to (copy-marker (point-max))))
                                      (widget-get widget :buttons))))
      (let ((entry-from (copy-marker (point-min)))
           (entry-to (copy-marker (point-max))))

-       (widget-specify-text entry-from entry-to)

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


@@ -2518,6 +2691,7 @@ when he invoked the menu."
   :value-create 'widget-group-value-create
   :value-delete 'widget-children-value-delete
   :value-get 'widget-editable-list-value-get
   :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
   :match 'widget-group-match
   :match-inline 'widget-group-match-inline)
   :validate 'widget-children-validate
   :match 'widget-group-match
   :match-inline 'widget-group-match-inline)


@@ -2544,6 +2718,10 @@ when he invoked the menu."
            children))
     (widget-put widget :children (nreverse children))))
 
            children))
     (widget-put widget :children (nreverse children))))
 

+(defun widget-group-default-get (widget)
+  ;; Get the default of the components.
+  (mapcar 'widget-default-get (widget-get widget :args)))
+

 (defun widget-group-match (widget values)
   ;; Match if the components match.
   (and (listp values)
 (defun widget-group-match (widget values)
   ;; Match if the components match.
   (and (listp values)


@@ -2574,8 +2752,8 @@ when he invoked the menu."
   :format "%[%v%]"
   :button-prefix ""
   :button-suffix ""
   :format "%[%v%]"
   :button-prefix ""
   :button-suffix ""

-  :on "hide"
-  :off "show"
+  :on "Hide"
+  :off "Show"

   :value-create 'widget-visibility-value-create
   :action 'widget-toggle-action
   :match (lambda (widget value) t))
   :value-create 'widget-visibility-value-create
   :action 'widget-toggle-action
   :match (lambda (widget value) t))


@@ -2591,13 +2769,12 @@ when he invoked the menu."
       (setq on ""))
     (if off
        (setq off (concat widget-push-button-prefix
       (setq on ""))
     (if off
        (setq off (concat widget-push-button-prefix

-                        off
-                        widget-push-button-suffix))
+                         off
+                         widget-push-button-suffix))

       (setq off ""))
     (if (widget-value widget)
        (widget-glyph-insert widget on "down" "down-pushed")
       (setq off ""))
     (if (widget-value widget)
        (widget-glyph-insert widget on "down" "down-pushed")

-      (widget-glyph-insert widget off "right" "right-pushed")
-      (insert "..."))))
+      (widget-glyph-insert widget off "right" "right-pushed"))))

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


@@ -2614,8 +2791,15 @@ when he invoked the menu."
   (concat "Describe the `" (widget-get widget :value) "' symbol."))
 
 (defun widget-documentation-link-action (widget &optional event)
   (concat "Describe the `" (widget-get widget :value) "' symbol."))
 
 (defun widget-documentation-link-action (widget &optional event)

-  "Run apropos on WIDGET's value.  Ignore optional argument EVENT."
-  (apropos (concat "\\`" (regexp-quote (widget-get widget :value)) "\\'")))
+  "Display documentation for WIDGET's value.  Ignore optional argument EVENT."
+  (let* ((string (widget-get widget :value))
+        (symbol (intern string)))
+    (if (and (fboundp symbol) (boundp symbol))
+       ;; If there are two doc strings, give the user a way to pick one.
+       (apropos (concat "\\`" (regexp-quote string) "\\'"))
+      (if (fboundp symbol)
+         (describe-function symbol)
+       (describe-variable symbol)))))

 
 (defcustom widget-documentation-links t
   "Add hyperlinks to documentation strings when non-nil."
 
 (defcustom widget-documentation-links t
   "Add hyperlinks to documentation strings when non-nil."


@@ -2653,8 +2837,8 @@ link for that string."
        (goto-char from)
        (while (re-search-forward regexp to t)
          (let ((name (match-string 1))
        (goto-char from)
        (while (re-search-forward regexp to t)
          (let ((name (match-string 1))

-               (begin (match-beginning 0))
-               (end (match-end 0)))
+               (begin (match-beginning 1))
+               (end (match-end 1)))

            (when (funcall predicate name)
              (push (widget-convert-button type begin end :value name)
                    buttons)))))
            (when (funcall predicate name)
              (push (widget-convert-button type begin end :value name)
                    buttons)))))


@@ -2692,7 +2876,7 @@ link for that string."
          (push (widget-create-child-and-convert
                 widget 'visibility
                 :help-echo "Show or hide rest of the documentation."
          (push (widget-create-child-and-convert
                 widget 'visibility
                 :help-echo "Show or hide rest of the documentation."

-                :off nil
+                :off "More"

                 :action 'widget-parent-action
                 shown)
                buttons)
                 :action 'widget-parent-action
                 shown)
                buttons)


@@ -2739,6 +2923,17 @@ link for that string."
   :format "%v\n%h"
   :documentation-property 'variable-documentation)
 
   :format "%v\n%h"
   :documentation-property 'variable-documentation)
 

+(define-widget 'other 'sexp
+  "Matches any value, but doesn't let the user edit the value.
+This is useful as last item in a `choice' widget.
+You should use this widget type with a default value,
+as in (other DEFAULT) or (other :tag \"NAME\" DEFAULT).
+If the user selects this alternative, that specifies DEFAULT
+as the value."
+  :tag "Other"
+  :format "%t%n"
+  :value 'other)
+

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


@@ -2753,6 +2948,8 @@ link for that string."
   "A regular expression."
   :match 'widget-regexp-match
   :validate 'widget-regexp-validate
   "A regular expression."
   :match 'widget-regexp-match
   :validate 'widget-regexp-validate

+  ;; Doesn't work well with terminating newline.
+  ;; :value-face 'widget-single-line-field-face

   :tag "Regexp")
 
 (defun widget-regexp-match (widget value)
   :tag "Regexp")
 
 (defun widget-regexp-match (widget value)


@@ -2775,10 +2972,38 @@ link for that string."
 (define-widget 'file 'string
   "A file widget.  
 It will read a file name from the minibuffer when invoked."
 (define-widget 'file 'string
   "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
   :format "%{%t%}: %v"
   :prompt-value 'widget-file-prompt-value
   :format "%{%t%}: %v"

-  :tag "File"
-  :action 'widget-file-action)
+  ;; Doesn't work well with terminating newline.
+  ;; :value-face 'widget-single-line-field-face
+  :tag "File")
+
+(defun widget-file-complete ()
+  "Perform completion on file name preceding point."
+  (interactive)
+  (let* ((end (point))
+        (beg (save-excursion
+               (skip-chars-backward "^ ")
+               (point)))
+        (pattern (buffer-substring beg end))
+        (name-part (file-name-nondirectory pattern))
+        (directory (file-name-directory pattern))
+        (completion (file-name-completion name-part directory)))
+    (cond ((eq completion t))
+         ((null completion)
+          (message "Can't find completion for \"%s\"" pattern)
+          (ding))
+         ((not (string= name-part completion))
+          (delete-region beg end)
+          (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)))
+          (message "Making completion list...%s" "done")))))

 
 (defun widget-file-prompt-value (widget prompt value unbound)
   ;; Read file from minibuffer.
 
 (defun widget-file-prompt-value (widget prompt value unbound)
   ;; Read file from minibuffer.


@@ -2791,18 +3016,18 @@ It will read a file name from the minibuffer when invoked."
           (must-match (widget-get widget :must-match)))
        (read-file-name prompt2 dir nil must-match file)))))
 
           (must-match (widget-get widget :must-match)))
        (read-file-name prompt2 dir nil must-match file)))))
 

-(defun widget-file-action (widget &optional event)
-  ;; Read a file name from the minibuffer.
-  (let* ((value (widget-value widget))
-        (dir (file-name-directory value))
-        (file (file-name-nondirectory value))
-        (menu-tag (widget-apply widget :menu-tag-get))
-        (must-match (widget-get widget :must-match))
-        (answer (read-file-name (concat menu-tag ": (default `" value "') ")
-                                dir nil must-match file)))
-    (widget-value-set widget (abbreviate-file-name answer))
-    (widget-setup)
-    (widget-apply widget :notify widget event)))
+;;;(defun widget-file-action (widget &optional event)
+;;;  ;; Read a file name from the minibuffer.
+;;;  (let* ((value (widget-value widget))
+;;;     (dir (file-name-directory value))
+;;;     (file (file-name-nondirectory value))
+;;;     (menu-tag (widget-apply widget :menu-tag-get))
+;;;     (must-match (widget-get widget :must-match))
+;;;     (answer (read-file-name (concat menu-tag ": (default `" value "') ")
+;;;                             dir nil must-match file)))
+;;;    (widget-value-set widget (abbreviate-file-name answer))
+;;;    (widget-setup)
+;;;    (widget-apply widget :notify widget event)))

 
 (define-widget 'directory 'file
   "A directory widget.  
 
 (define-widget 'directory 'file
   "A directory widget.  


@@ -2813,11 +3038,12 @@ It will read a directory name from the minibuffer when invoked."
   "History of input to `widget-symbol-prompt-value'.")
 
 (define-widget 'symbol 'editable-field
   "History of input to `widget-symbol-prompt-value'.")
 
 (define-widget 'symbol 'editable-field

-  "A lisp symbol."
+  "A Lisp symbol."

   :value nil
   :tag "Symbol"
   :format "%{%t%}: %v"
   :match (lambda (widget value) (symbolp value))
   :value nil
   :tag "Symbol"
   :format "%{%t%}: %v"
   :match (lambda (widget value) (symbolp value))

+  :complete-function 'lisp-complete-symbol

   :prompt-internal 'widget-symbol-prompt-internal
   :prompt-match 'symbolp
   :prompt-history 'widget-symbol-prompt-value-history
   :prompt-internal 'widget-symbol-prompt-internal
   :prompt-match 'symbolp
   :prompt-history 'widget-symbol-prompt-value-history


@@ -2844,7 +3070,7 @@ It will read a directory name from the minibuffer when invoked."
   "History of input to `widget-function-prompt-value'.")
 
 (define-widget 'function 'sexp
   "History of input to `widget-function-prompt-value'.")
 
 (define-widget 'function 'sexp

-  "A lisp function."
+  "A Lisp function."

   :complete-function 'lisp-complete-symbol
   :prompt-value 'widget-field-prompt-value
   :prompt-internal 'widget-symbol-prompt-internal
   :complete-function 'lisp-complete-symbol
   :prompt-value 'widget-field-prompt-value
   :prompt-internal 'widget-symbol-prompt-internal


@@ -2858,7 +3084,7 @@ It will read a directory name from the minibuffer when invoked."
 
 (define-widget 'variable 'symbol
   ;; Should complete on variables.
 
 (define-widget 'variable 'symbol
   ;; Should complete on variables.

-  "A lisp variable."
+  "A Lisp variable."

   :prompt-match 'boundp
   :prompt-history 'widget-variable-prompt-value-history
   :tag "Variable")
   :prompt-match 'boundp
   :prompt-history 'widget-variable-prompt-value-history
   :tag "Variable")


@@ -2899,7 +3125,7 @@ It will read a directory name from the minibuffer when invoked."
   )
 
 (define-widget 'sexp 'editable-field
   )
 
 (define-widget 'sexp 'editable-field

-  "An arbitrary lisp expression."
+  "An arbitrary Lisp expression."

   :tag "Lisp expression"
   :format "%{%t%}: %v"
   :value nil
   :tag "Lisp expression"
   :format "%{%t%}: %v"
   :value nil


@@ -2963,19 +3189,45 @@ It will read a directory name from the minibuffer when invoked."
                   (buffer-substring (point) (point-max))))
          answer)))))
 
                   (buffer-substring (point) (point-max))))
          answer)))))
 

-(define-widget 'integer 'sexp
+(define-widget 'restricted-sexp 'sexp
+  "A Lisp expression restricted to values that match.
+To use this type, you must define :match or :match-alternatives."
+  :type-error "The specified value is not valid"
+  :match 'widget-restricted-sexp-match
+  :value-to-internal (lambda (widget value)
+                      (if (widget-apply widget :match value)
+                          (prin1-to-string value)
+                        value)))
+
+(defun widget-restricted-sexp-match (widget value)
+  (let ((alternatives (widget-get widget :match-alternatives))
+       matched)
+    (while (and alternatives (not matched))
+      (if (cond ((functionp (car alternatives))
+                (funcall (car alternatives) value))
+               ((and (consp (car alternatives))
+                     (eq (car (car alternatives)) 'quote))
+                (eq value (nth 1 (car alternatives)))))
+         (setq matched t))
+      (setq alternatives (cdr alternatives)))
+    matched))
+
+(define-widget 'integer 'restricted-sexp

   "An integer."
   :tag "Integer"
   :value 0
   :type-error "This field should contain an integer"
   "An integer."
   :tag "Integer"
   :value 0
   :type-error "This field should contain an integer"

-  :value-to-internal (lambda (widget value)
-                      (if (integerp value) 
-                          (prin1-to-string value)
-                        value))
-  :match (lambda (widget value) (integerp value)))
+  :match-alternatives '(integerp))
+
+(define-widget 'number 'restricted-sexp
+  "A floating point number."
+  :tag "Number"
+  :value 0.0
+  :type-error "This field should contain a number"
+  :match-alternatives '(numberp))

 
 (define-widget 'character 'editable-field
 
 (define-widget 'character 'editable-field

-  "An character."
+  "A character."

   :tag "Character"
   :value 0
   :size 1 
   :tag "Character"
   :value 0
   :size 1 


@@ -2995,24 +3247,13 @@ It will read a directory name from the minibuffer when invoked."
               (characterp value)
             (integerp value))))
 
               (characterp value)
             (integerp value))))
 

-(define-widget 'number 'sexp
-  "A floating point number."
-  :tag "Number"
-  :value 0.0
-  :type-error "This field should contain a number"
-  :value-to-internal (lambda (widget value)
-                      (if (numberp value)
-                          (prin1-to-string value)
-                        value))
-  :match (lambda (widget value) (numberp value)))
-

 (define-widget 'list 'group
 (define-widget 'list 'group

-  "A lisp list."
+  "A Lisp list."

   :tag "List"
   :format "%{%t%}:\n%v")
 
 (define-widget 'vector 'group
   :tag "List"
   :format "%{%t%}:\n%v")
 
 (define-widget 'vector 'group

-  "A lisp vector."
+  "A Lisp vector."

   :tag "Vector"
   :format "%{%t%}:\n%v"
   :match 'widget-vector-match
   :tag "Vector"
   :format "%{%t%}:\n%v"
   :match 'widget-vector-match


@@ -3042,7 +3283,7 @@ It will read a directory name from the minibuffer when invoked."
 (define-widget 'choice 'menu-choice
   "A union of several sexp types."
   :tag "Choice"
 (define-widget 'choice 'menu-choice
   "A union of several sexp types."
   :tag "Choice"

-  :format "%{%t%}: %[value menu%] %v"
+  :format "%{%t%}: %[Value Menu%] %v"

   :button-prefix 'widget-push-button-prefix
   :button-suffix 'widget-push-button-suffix
   :prompt-value 'widget-choice-prompt-value)
   :button-prefix 'widget-push-button-prefix
   :button-suffix 'widget-push-button-suffix
   :prompt-value 'widget-choice-prompt-value)


@@ -3111,7 +3352,9 @@ It will read a directory name from the minibuffer when invoked."
   :prompt-value 'widget-boolean-prompt-value
   :button-prefix 'widget-push-button-prefix
   :button-suffix 'widget-push-button-suffix
   :prompt-value 'widget-boolean-prompt-value
   :button-prefix 'widget-push-button-prefix
   :button-suffix 'widget-push-button-suffix

-  :format "%{%t%}: %[toggle%] %v\n")
+  :format "%{%t%}: %[Toggle%]  %v\n"
+  :on "on (non-nil)"
+  :off "off (nil)")

 
 (defun widget-boolean-prompt-value (widget prompt value unbound)
   ;; Toggle a boolean.
 
 (defun widget-boolean-prompt-value (widget prompt value unbound)
   ;; Toggle a boolean.


@@ -3119,33 +3362,44 @@ It will read a directory name from the minibuffer when invoked."
 
 ;;; The `color' Widget.
 
 
 ;;; The `color' Widget.
 

-(define-widget 'color-item 'choice-item
-  "A color name (with sample)."
-  :format "%v (%{sample%})\n"
-  :sample-face-get 'widget-color-item-button-face-get)
-
-(defun widget-color-item-button-face-get (widget)
-  (let ((symbol (intern (concat "fg:" (widget-value widget)))))
-    (if (string-match "XEmacs" emacs-version)
-       (prog1 symbol
-         (or (find-face symbol)
-             (set-face-foreground (make-face symbol) (widget-value widget))))
-      (condition-case nil
-         (facemenu-get-face symbol)
-       (error 'default)))))
-
-(define-widget 'color 'push-button
+(define-widget 'color 'editable-field 

   "Choose a color name (with sample)."
   "Choose a color name (with sample)."

-  :format "%[%t%]: %v"
+  :format "%t: %v (%{sample%})\n"
+  :size 10

   :tag "Color"
   :value "black"
   :tag "Color"
   :value "black"

-  :value-create 'widget-color-value-create
-  :value-delete 'widget-children-value-delete
-  :value-get 'widget-color-value-get
-  :value-set 'widget-color-value-set
-  :action 'widget-color-action
-  :match 'widget-field-match
-  :tag "Color")
+  :complete 'widget-color-complete
+  :sample-face-get 'widget-color-sample-face-get
+  :notify 'widget-color-notify
+  :action 'widget-color-action)
+
+(defun widget-color-complete (widget)
+  "Complete the color in WIDGET."
+  (let* ((prefix (buffer-substring-no-properties (widget-field-start widget)
+                                                (point)))
+        (list (widget-color-choice-list))
+        (completion (try-completion prefix list)))
+    (cond ((eq completion t)
+          (message "Exact match."))
+         ((null completion)
+          (error "Can't find completion for \"%s\"" prefix))
+         ((not (string-equal prefix completion))
+          (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)))
+          (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.
 
 (defvar widget-color-choice-list nil)
 ;; Variable holding the possible colors.


@@ -3157,19 +3411,6 @@ It will read a directory name from the minibuffer when invoked."
                  (x-defined-colors))))
   widget-color-choice-list)
 
                  (x-defined-colors))))
   widget-color-choice-list)
 

-(defun widget-color-value-create (widget)
-  (let ((child (widget-create-child-and-convert
-               widget 'color-item (widget-get widget :value))))
-    (widget-put widget :children (list child))))
-
-(defun widget-color-value-get (widget)
-  ;; Pass command to first child.
-  (widget-apply (car (widget-get widget :children)) :value-get))
-
-(defun widget-color-value-set (widget value)
-  ;; Pass command to first child.
-  (widget-apply (car (widget-get widget :children)) :value-set value))
-

 (defvar widget-color-history nil
   "History of entered colors")
 
 (defvar widget-color-history nil
   "History of entered colors")
 


@@ -3177,19 +3418,32 @@ It will read a directory name from the minibuffer when invoked."
   ;; Prompt for a color.
   (let* ((tag (widget-apply widget :menu-tag-get))
         (prompt (concat tag ": "))
   ;; Prompt for a color.
   (let* ((tag (widget-apply widget :menu-tag-get))
         (prompt (concat tag ": "))

-        (answer (cond ((string-match "XEmacs" emacs-version)
-                       (read-color prompt))
-                      ((fboundp 'x-defined-colors)
-                       (completing-read (concat tag ": ")
-                                        (widget-color-choice-list) 
-                                        nil nil nil 'widget-color-history))
-                      (t
-                       (read-string prompt (widget-value widget))))))
+        (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))))

     (unless (zerop (length answer))
       (widget-value-set widget answer)
       (widget-setup)
       (widget-apply widget :notify widget event))))
 
     (unless (zerop (length answer))
       (widget-value-set widget answer)
       (widget-setup)
       (widget-apply widget :notify widget event))))
 

+(defun widget-color-notify (widget child &optional event)
+  "Update the sample, and notofy the parent."
+  (overlay-put (widget-get widget :sample-overlay) 
+              'face (widget-apply widget :sample-face-get))
+  (widget-default-notify widget child event))
+

 ;;; The Help Echo
 
 (defun widget-echo-help-mouse ()
 ;;; The Help Echo
 
 (defun widget-echo-help-mouse ()


@@ -3207,7 +3461,7 @@ Enable with (run-with-idle-timer 1 t 'widget-echo-help-mouse)"
          (select-window win)
          (let* ((result (compute-motion (window-start win)
                                         '(0 . 0)
          (select-window win)
          (let* ((result (compute-motion (window-start win)
                                         '(0 . 0)

-                                        (window-end win)
+                                        (point-max)

                                         where
                                         (window-width win)
                                         (cons (window-hscroll) 0)
                                         where
                                         (window-width win)
                                         (cons (window-hscroll) 0)