Synched with version 1.9901.

3 files changed, 259 insertions, 144 deletions

diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index e15a39a015c..c4d6b7f6c2f 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: help, faces
-;; Version: 1.9900
+;; Version: 1.9901
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;; This file is part of GNU Emacs.
@@ -517,7 +517,7 @@ if that fails, the doc string with `custom-guess-doc-alist'."
   "Function used for sorting group members in buffers.
 The value should be useful as a predicate for `sort'.  
 The list to be sorted is the value of the groups `custom-group' property."
-  :type '(radio (function-item 'custom-buffer-sort-alphabetically)
+  :type '(radio (function-item custom-buffer-sort-alphabetically)
                 (function :tag "Other"))
   :group 'customize)
 
@@ -539,7 +539,7 @@ sorted after all non-groups."
   "Function used for sorting group members in menus.
 The value should be useful as a predicate for `sort'.  
 The list to be sorted is the value of the groups `custom-group' property."
-  :type '(radio (function-item 'custom-menu-sort-alphabetically)
+  :type '(radio (function-item custom-menu-sort-alphabetically)
                 (function :tag "Other"))
   :group 'customize)
 
@@ -1028,8 +1028,8 @@ uninitialized, you should not see this.")
                                (unknown "?" italic "\
 unknown, you should not see this.")
                                (hidden "-" default "\
-hidden, invoke the state button to show." "\
-group now hidden, invoke the state button to show contents.")
+hidden, invoke the dots above to show." "\
+group now hidden, invoke the dots above to show contents.")
                                (invalid "x" custom-invalid-face "\
 the value displayed for this item is invalid and cannot be set.")
                                (modified "*" custom-modified-face "\
@@ -1088,12 +1088,18 @@ left out, ITEM-DESC will be used.
 The list should be sorted most significant first.")
 
 (defcustom custom-magic-show 'long
-  "Show long description of the state of each customization option."
+  "If non-nil, show textual description of the state.
+If non-nil and not the symbol `long', only show first word."
   :type '(choice (const :tag "no" nil)
                  (const short)
                  (const long))
   :group 'customize)
 
+(defcustom custom-magic-show-hidden nil
+  "If non-nil, also show long state description of hidden options."
+  :type 'boolean
+  :group 'customize)
+
 (defcustom custom-magic-show-button nil
   "Show a magic button indicating the state of each customization option."
   :type 'boolean
@@ -1118,6 +1124,7 @@ The list should be sorted most significant first.")
   ;; Create compact status report for WIDGET.
   (let* ((parent (widget-get widget :parent))
          (state (widget-get parent :custom-state))
+         (hidden (eq state 'hidden))
          (entry (assq state custom-magic-alist))
          (magic (nth 1 entry))
          (face (nth 2 entry))
@@ -1126,13 +1133,14 @@ The list should be sorted most significant first.")
                    (nth 3 entry)))
          (lisp (eq (widget-get parent :custom-form) 'lisp))
          children)
-    (when custom-magic-show
+    (when (and custom-magic-show
+               (or custom-magic-show-hidden (not hidden)))
       (insert "   ")
       (push (widget-create-child-and-convert 
              widget 'choice-item 
              :help-echo "\
 Change the state of this item."
-             :format "%[%t%]"
+             :format (if hidden "%t" "%[%t%]")
              :button-prefix 'widget-push-button-prefix
              :button-suffix 'widget-push-button-suffix
              :mouse-down-action 'widget-magic-mouse-down-action
@@ -1154,8 +1162,10 @@ Change the state of this item."
              widget 'choice-item 
              :mouse-down-action 'widget-magic-mouse-down-action
              :button-face face
+             :button-prefix ""
+             :button-suffix ""
              :help-echo "Change the state."
-             :format "%[%t%]"
+             :format (if hidden "%t" "%[%t%]")
              :tag (if lisp 
                       (concat "(" magic ")")
                     (concat "[" magic "]")))
@@ -1201,13 +1211,25 @@ Change the state of this item."
          (level (widget-get widget :custom-level)))
     (cond ((eq escape ?l)
            (when level 
-             (push (widget-create-child-and-convert
-                    widget 'item :format "%v " (make-string level ?*))
-                   buttons)
-             (widget-put widget :buttons buttons)))
+             (if (eq state 'hidden)
+                 (insert-char ?- (* 2 level))
+               (insert "/" (make-string (1- (* 2 level)) ?-)))))
+          ((eq escape ?e)
+           (when (and level (not (eq state 'hidden)))
+             (insert "\n\\" (make-string (1- (* 2 level)) ?-) " "
+                     (widget-get widget :tag) " group end ")
+             (insert (make-string (- 75 (current-column)) ?-) "/\n")))
+          ((eq escape ?-)
+           (when level 
+             (if (eq state 'hidden)
+                 (insert-char ?- (- 77 (current-column)))                
+               (insert (make-string (- 76 (current-column)) ?-) "\\"))))
           ((eq escape ?L)
-           (when (eq state 'hidden)
-             (widget-insert " ...")))
+           (push (widget-create-child-and-convert
+                  widget 'visibility
+                  :action 'custom-toggle-parent
+                  (not (eq state 'hidden)))
+                 buttons))
           ((eq escape ?m)
            (and (eq (preceding-char) ?\n)
                 (widget-get widget :indent)
@@ -1218,27 +1240,28 @@ Change the state of this item."
              (push magic buttons)
              (widget-put widget :buttons buttons)))
           ((eq escape ?a)
-           (let* ((symbol (widget-get widget :value))
-                  (links (get symbol 'custom-links))
-                  (many (> (length links) 2)))
-             (when links
-               (and (eq (preceding-char) ?\n)
-                    (widget-get widget :indent)
-                    (insert-char ?  (widget-get widget :indent)))
-               (insert "See also ")
-               (while links
-                 (push (widget-create-child-and-convert widget (car links))
-                       buttons)
-                 (setq links (cdr links))
-                 (cond ((null links)
-                        (insert ".\n"))
-                       ((null (cdr links))
-                        (if many
-                            (insert ", and ")
-                          (insert " and ")))
-                       (t 
-                        (insert ", "))))
-               (widget-put widget :buttons buttons))))
+           (unless (eq state 'hidden)
+             (let* ((symbol (widget-get widget :value))
+                    (links (get symbol 'custom-links))
+                    (many (> (length links) 2)))
+               (when links
+                 (and (eq (preceding-char) ?\n)
+                      (widget-get widget :indent)
+                      (insert-char ?  (widget-get widget :indent)))
+                 (insert "See also ")
+                 (while links
+                   (push (widget-create-child-and-convert widget (car links))
+                         buttons)
+                   (setq links (cdr links))
+                   (cond ((null links)
+                          (insert ".\n"))
+                         ((null (cdr links))
+                          (if many
+                              (insert ", and ")
+                            (insert " and ")))
+                         (t 
+                          (insert ", "))))
+                 (widget-put widget :buttons buttons)))))
           (t 
            (widget-default-format-handler widget escape)))))
 
@@ -1329,9 +1352,14 @@ Change the state of this item."
           ((eq state 'hidden)
            (widget-put widget :custom-state 'unknown))
           (t 
+           (widget-put widget :documentation-shown nil)
            (widget-put widget :custom-state 'hidden)))
     (custom-redraw widget)))
 
+(defun custom-toggle-parent (widget &rest ignore)
+  "Toggle visibility of parent to WIDGET."
+  (custom-toggle-hide (widget-get widget :parent)))
+
 ;;; The `custom-variable' Widget.
 
 (defface custom-variable-sample-face '((t (:underline t)))
@@ -1405,11 +1433,16 @@ Otherwise, look up symbol in `custom-guess-type-alist'."
            ;; Indicate hidden value.
            (push (widget-create-child-and-convert 
                   widget 'item
-                  :format "%{%t%}: ..."
+                  :format "%{%t%}: "
                   :sample-face 'custom-variable-sample-face
                   :tag tag
                   :parent widget)
-                 children))
+                 buttons)
+           (push (widget-create-child-and-convert 
+                  widget 'visibility
+                  :action 'custom-toggle-parent
+                  nil)
+                 buttons))
           ((eq form 'lisp)
            ;; In lisp mode edit the saved value when possible.
            (let* ((value (cond ((get symbol 'saved-value)
@@ -1420,22 +1453,49 @@ Otherwise, look up symbol in `custom-guess-type-alist'."
                                 (custom-quote (funcall get symbol)))
                                (t
                                 (custom-quote (widget-get conv :value))))))
+             (insert (symbol-name symbol) ": ")
+             (push (widget-create-child-and-convert 
+                  widget 'visibility
+                  :action 'custom-toggle-parent
+                  t)
+                 buttons)
+             (insert " ")
              (push (widget-create-child-and-convert 
                     widget 'sexp 
                     :button-face 'custom-variable-button-face
+                    :format "%v"
                     :tag (symbol-name symbol)
                     :parent widget
                     :value value)
                    children)))
           (t
            ;; Edit mode.
-           (push (widget-create-child-and-convert
-                  widget type 
-                  :tag tag
-                  :button-face 'custom-variable-button-face
-                  :sample-face 'custom-variable-sample-face
-                  :value value)
-                 children)))
+           (let* ((format (widget-get type :format))
+                  tag-format value-format)
+             (unless (string-match ":" format)
+               (error "Bad format."))
+             (setq tag-format (substring format 0 (match-end 0)))
+             (setq value-format (substring format (match-end 0)))
+             (push (widget-create-child-and-convert
+                    widget 'item 
+                    :format tag-format
+                    :action 'custom-tag-action
+                    :mouse-down-action 'custom-tag-mouse-down-action
+                    :button-face 'custom-variable-button-face
+                    :sample-face 'custom-variable-sample-face
+                    tag)
+                   buttons)
+             (insert " ")
+             (push (widget-create-child-and-convert 
+                  widget 'visibility
+                  :action 'custom-toggle-parent
+                  t)
+                 buttons)            
+             (push (widget-create-child-and-convert
+                    widget type 
+                    :format value-format
+                    :value value)
+                   children))))
     ;; Now update the state.
     (unless (eq (preceding-char) ?\n)
       (widget-insert "\n"))
@@ -1446,6 +1506,16 @@ Otherwise, look up symbol in `custom-guess-type-alist'."
     (widget-put widget :buttons buttons)
     (widget-put widget :children children)))
 
+(defun custom-tag-action (widget &rest args)
+  "Pass :action to first child of WIDGET's parent."
+  (apply 'widget-apply (car (widget-get (widget-get widget :parent) :children))
+         :action args))
+
+(defun custom-tag-mouse-down-action (widget &rest args)
+  "Pass :mouse-down-action to first child of WIDGET's parent."
+  (apply 'widget-apply (car (widget-get (widget-get widget :parent) :children))
+         :mouse-down-action args))
+
 (defun custom-variable-state-set (widget)
   "Set the state of WIDGET."
   (let* ((symbol (widget-value widget))
@@ -1476,10 +1546,7 @@ Otherwise, look up symbol in `custom-guess-type-alist'."
     (widget-put widget :custom-state state)))
 
 (defvar custom-variable-menu 
-  '(("Hide" custom-toggle-hide
-     (lambda (widget)
-       (not (memq (widget-get widget :custom-state) '(modified invalid)))))
-     ("Edit" custom-variable-edit 
+  '(("Edit" custom-variable-edit 
      (lambda (widget)
        (not (eq (widget-get widget :custom-form) 'edit))))
     ("Edit Lisp" custom-variable-edit-lisp
@@ -1712,7 +1779,7 @@ Match frames with dark backgrounds.")
 
 (define-widget 'custom-face 'custom
   "Customize face."
-  :format "%{%t%}: %s%m%h%a%v"
+  :format "%{%t%}: %s %L\n%m%h%a%v"
   :format-handler 'custom-face-format-handler
   :sample-face 'custom-face-tag-face
   :help-echo "Set or reset this face."
@@ -1739,7 +1806,7 @@ Match frames with dark backgrounds.")
                 (copy-face 'custom-face-empty symbol))
            (setq child (widget-create-child-and-convert 
                         widget 'item
-                        :format "(%{%t%})\n"
+                        :format "(%{%t%})"
                         :sample-face symbol
                         :tag "sample")))
           (t 
@@ -1813,10 +1880,7 @@ Match frames with dark backgrounds.")
     (message "Creating face editor...done")))
 
 (defvar custom-face-menu 
-  '(("Hide" custom-toggle-hide
-     (lambda (widget)
-       (not (memq (widget-get widget :custom-state) '(modified invalid)))))
-    ("Edit Selected" custom-face-edit-selected
+  '(("Edit Selected" custom-face-edit-selected
      (lambda (widget)
        (not (eq (widget-get widget :custom-form) 'selected))))
     ("Edit All" custom-face-edit-all
@@ -1955,7 +2019,7 @@ Optional EVENT is the location for the menu."
   (let* ((symbol (widget-value widget))
          (child (widget-create-child-and-convert
                  widget 'custom-face
-                 :format "%t %s%m%h%v"
+                 :format "%t %s %L\n%m%h%v"
                  :custom-level nil
                  :value symbol)))
     (custom-magic-reset child)
@@ -2039,7 +2103,7 @@ and so forth.  The remaining group tags are shown with
 
 (define-widget 'custom-group 'custom
   "Customize group."
-  :format "%l%{%t%}:%L\n%m%h%a%v"
+  :format "%l %{%t%} group: %L %-\n%m%h%a%v%e"
   :sample-face-get 'custom-group-sample-face-get
   :documentation-property 'group-documentation
   :help-echo "Set or reset all members of this group."
@@ -2096,10 +2160,7 @@ and so forth.  The remaining group tags are shown with
         (message "Creating group... done")))))
 
 (defvar custom-group-menu 
-  '(("Hide" custom-toggle-hide
-     (lambda (widget)
-       (not (memq (widget-get widget :custom-state) '(modified invalid)))))
-    ("Set" custom-group-set
+  '(("Set" custom-group-set
      (lambda (widget)
        (eq (widget-get widget :custom-state) 'modified)))
     ("Save" custom-group-save
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 6de406f4c4c..6749807bb2e 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: extensions
-;; Version: 1.9900
+;; Version: 1.9901
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;; This file is part of GNU Emacs.
@@ -31,6 +31,7 @@
 ;;; Code:
 
 (require 'widget)
+(eval-when-compile (require 'cl))
 
 ;;; Compatibility.
 
@@ -567,27 +568,23 @@ automatically."
                        (repeat :tag "Suffixes"
                                (string :format "%v")))))
 
-(defun widget-glyph-insert (widget tag 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'.
-
-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."
-  (cond ((not (and (string-match "XEmacs" emacs-version)
+(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
+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.
-         (insert tag))
+         nil)
         ((and (fboundp 'glyphp)
               (glyphp image))
-         ;; Already a glyph.  Insert it.
-         (widget-glyph-insert-glyph widget image))
+         ;; Already a glyph.  Use it.
+         image)
         ((stringp image)
          ;; A string.  Look it up in relevant directories.
          (let* ((dirlist (list (or widget-glyph-directory
@@ -599,50 +596,65 @@ cause the last created widget to be invoked."
            (while (and formats (not file))
              (if (valid-image-instantiator-format-p (car (car formats)))
                  (setq file (locate-file image dirlist
-                                         (mapconcat 'identity (cdr (car formats))
+                                         (mapconcat 'identity
+                                                    (cdr (car formats))
                                                     ":")))
                (setq formats (cdr formats))))
            ;; We create a glyph with the file as the default image
            ;; instantiator, and the TAG fallback
-           (widget-glyph-insert-glyph
-            widget
-            (make-glyph (if file
-                            (list (vector (car (car formats)) ':file file)
-                                  (vector 'string ':data tag))
-                          (vector 'string ':data tag))))))
+           (make-glyph (if file
+                           (list (vector (car (car formats)) ':file file)
+                                 (vector 'string ':data tag))
+                         (vector 'string ':data tag)))))
         ((valid-instantiator-p image 'image)
          ;; A valid image instantiator (e.g. [gif :file "somefile"] etc.)
-         (widget-glyph-insert-glyph
-          widget
-          (make-glyph (list image
-                            (vector 'string ':data tag)))))
+         (make-glyph (list image
+                           (vector 'string ':data tag))))
         (t
          ;; Oh well.
-         (insert tag))))
+         nil)))
+
+(defun widget-glyph-insert (widget tag image &optional down inactive)
+  "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."
+  (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, with alternative text TAG, insert GLYPH."
+  "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))
   (insert "*")
-  (add-text-properties (1- (point)) (point) 
-                       (list 'invisible t
-                             'end-glyph glyph))
+  (let ((ext (make-extent (point) (1- (point))))
+        (help-echo (widget-get widget :help-echo)))
+    (set-extent-property ext 'invisible 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)))
   (widget-put widget :glyph-up glyph)
   (when down (widget-put widget :glyph-down down))
-  (when inactive (widget-put widget :glyph-inactive inactive))
-  (let ((help-echo (widget-get widget :help-echo)))
-    (when help-echo
-      (let ((extent (extent-at (1- (point)) nil 'end-glyph))
-            (help-property (if (featurep 'balloon-help)
-                               'balloon-help
-                             'help-echo)))
-        (set-extent-property extent help-property (if (stringp help-echo)
-                                                      help-echo
-                                                    'widget-mouse-help))))))
+  (when inactive (widget-put widget :glyph-inactive inactive)))
 
 ;;; Buttons.
 
@@ -653,12 +665,12 @@ cause the last created widget to be invoked."
 (defcustom widget-button-prefix ""
   "String used as prefix for buttons."
   :type 'string
-  :group 'widgets)
+  :group 'widget-button)
 
 (defcustom widget-button-suffix ""
   "String used as suffix for buttons."
   :type 'string
-  :group 'widgets)
+  :group 'widget-button)
 
 (defun widget-button-insert-indirect (widget key)
   "Insert value of WIDGET's KEY property."
@@ -1313,20 +1325,10 @@ Optional EVENT is the event that triggered the action."
              ;; Get rid of trailing newlines.
              (when (string-match "\n+\\'" doc-text)
                (setq doc-text (substring doc-text 0 (match-beginning 0))))
-             (setq buttons
-                   (cons (if (string-match "\n." doc-text)
-                             ;; Allow multiline doc to be hiden.
-                             (widget-create-child-and-convert
-                              widget 'widget-help 
-                              :doc (progn
-                                     (string-match "\\`.*" doc-text)
-                                     (match-string 0 doc-text))
-                              :widget-doc doc-text
-                              "?")
-                           ;; A single line is just inserted.
-                           (widget-create-child-and-convert
-                            widget 'item :format "%d" :doc doc-text nil))
-                         buttons))))
+             (push (widget-create-child-and-convert
+                    widget 'documentation-string
+                    doc-text)
+                   buttons)))
           (t 
            (error "Unknown escape `%c'" escape)))
     (widget-put widget :buttons buttons)))
@@ -1495,8 +1497,7 @@ If END is omitted, it defaults to the length of LIST."
         (progn 
           (unless gui
             (setq gui (make-gui-button tag 'widget-gui-action widget))
-            (setq widget-push-button-cache
-                  (cons (cons tag gui) widget-push-button-cache)))
+            (push (cons tag gui) widget-push-button-cache))
           (widget-glyph-insert-glyph widget
                                      (make-glyph
                                       (list (nth 0 (aref gui 1))
@@ -2451,14 +2452,13 @@ when he invoked the menu."
       (and (eq (preceding-char) ?\n)
            (widget-get widget :indent)
            (insert-char ?  (widget-get widget :indent)))
-      (setq children
-            (cons (cond ((null answer)
-                         (widget-create-child widget arg))
-                        ((widget-get arg :inline)
-                         (widget-create-child-value widget arg  (car answer)))
-                        (t
-                         (widget-create-child-value widget arg  (car (car answer)))))
-                  children)))
+      (push (cond ((null answer)
+                   (widget-create-child widget arg))
+                  ((widget-get arg :inline)
+                   (widget-create-child-value widget arg  (car answer)))
+                  (t
+                   (widget-create-child-value widget arg  (car (car answer)))))
+            children))
     (widget-put widget :children (nreverse children))))
 
 (defun widget-group-match (widget values)
@@ -2484,20 +2484,74 @@ when he invoked the menu."
         (cons found vals)
       nil)))
 
-;;; The `widget-help' Widget.
+;;; The `visibility' Widget.
 
-(define-widget 'widget-help 'push-button
-  "The widget documentation button."
-  :format "%[%v%] %d"
-  :help-echo "Toggle display of documentation."
-  :action 'widget-help-action)
+(define-widget 'visibility 'item
+  "An indicator and manipulator for hidden items."
+  :format "%[%v%]"
+  :button-prefix ""
+  :button-suffix ""
+  :on "hide"
+  :off "more"
+  :value-create 'widget-visibility-value-create
+  :action 'widget-toggle-action
+  :match (lambda (widget value) t))
 
-(defun widget-help-action (widget &optional event)
-  "Toggle documentation for WIDGET."
-  (let ((old (widget-get widget :doc))
-        (new (widget-get widget :widget-doc)))
-    (widget-put widget :doc new)
-    (widget-put widget :widget-doc old))
+(defun widget-visibility-value-create (widget)
+  ;; Insert text representing the `on' and `off' states.
+  (let ((on (widget-get widget :on))
+        (off (widget-get widget :off)))
+    (if on
+        (setq on (concat widget-push-button-prefix
+                         on
+                         widget-push-button-suffix))
+      (setq on ""))
+    (if off
+        (setq off (concat widget-push-button-prefix
+                         off
+                         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")
+      (insert "..."))))
+
+;;; The `documentation-string' Widget.
+
+(define-widget 'documentation-string 'item
+  "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)
+  ;; Insert documentation string.
+  (let ((doc (widget-value widget))
+        (shown (widget-get (widget-get widget :parent) :documentation-shown)))
+    (if (string-match "\n" doc)
+        (let ((before (substring doc 0 (match-beginning 0)))
+              (after (substring doc (match-beginning 0)))
+              buttons)
+          (insert before " ")
+          (push (widget-create-child-and-convert
+                 widget 'visibility
+                 :off nil
+                 :action 'widget-parent-action
+                 shown)
+                buttons)
+          (when shown
+            (insert after))
+          (widget-put widget :buttons buttons))
+      (insert doc)))
+  (insert "\n"))
+
+(defun widget-documentation-string-action (widget &rest ignore)
+  ;; Toggle documentation.
+  (let ((parent (widget-get widget :parent)))
+    (widget-put parent :documentation-shown 
+                (not (widget-get parent :documentation-shown))))
+  ;; Redraw.
   (widget-value-set widget (widget-value widget)))
 
 ;;; The Sexp Widgets.
diff --git a/lisp/widget.el b/lisp/widget.el
index 1be690a6d36..8a550c15f72 100644
--- a/lisp/widget.el
+++ b/lisp/widget.el
@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: help, extensions, faces, hypermedia
-;; Version: 1.9900
+;; Version: 1.9901
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;; This file is part of GNU Emacs.
@@ -44,14 +44,14 @@
              (set (car keywords) (car keywords)))
          (setq keywords (cdr keywords)))))))
 
-(define-widget-keywords :button-prefix :button-suffix
-  :mouse-down-action :glyph-up :glyph-down :glyph-inactive  
+(define-widget-keywords :documentation-shown :button-prefix
+  :button-suffix :mouse-down-action :glyph-up :glyph-down :glyph-inactive  
   :prompt-internal :prompt-history :prompt-match
   :prompt-value  :deactivate :active  
   :inactive :activate :sibling-args :delete-button-args
   :insert-button-args :append-button-args :button-args 
   :tag-glyph :off-glyph :on-glyph :valid-regexp
-  :secret :sample-face :sample-face-get :case-fold :widget-doc 
+  :secret :sample-face :sample-face-get :case-fold 
   :create :convert-widget :format :value-create :offset :extra-offset
   :tag :doc :from :to :args :value :value-from :value-to :action
   :value-set :value-delete :match :parent :delete :menu-tag-get