+(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"))))
+
+;;; The `documentation-link' Widget.
+;;
+;; This is a helper widget for `documentation-string'.
+
+(define-widget 'documentation-link 'link
+ "Link type used in documentation strings."
+ :tab-order -1
+ :help-echo 'widget-documentation-link-echo-help
+ :action 'widget-documentation-link-action)
+
+(defun widget-documentation-link-echo-help (widget)
+ "Tell what this link will describe."
+ (concat "Describe the `" (widget-get widget :value) "' symbol."))
+
+(defun widget-documentation-link-action (widget &optional event)
+ "Display documentation for WIDGET's value. Ignore optional argument EVENT."
+ (let* ((string (widget-get widget :value))
+ (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."
+ :type 'boolean
+ :group 'widget-documentation)
+
+(defcustom widget-documentation-link-regexp "`\\([^\n`' ]+\\)'"
+ "Regexp for matching potential links in documentation strings.
+The first group should be the link itself."
+ :type 'regexp
+ :group 'widget-documentation)
+
+(defcustom widget-documentation-link-p 'intern-soft
+ "Predicate used to test if a string is useful as a link.
+The value should be a function. The function will be called one
+argument, a string, and should return non-nil if there should be a
+link for that string."
+ :type 'function
+ :options '(widget-documentation-link-p)
+ :group 'widget-documentation)
+
+(defcustom widget-documentation-link-type 'documentation-link
+ "Widget type used for links in documentation strings."
+ :type 'symbol
+ :group 'widget-documentation)
+
+(defun widget-documentation-link-add (widget from to)
+ (widget-specify-doc widget from to)
+ (when widget-documentation-links
+ (let ((regexp widget-documentation-link-regexp)
+ (predicate widget-documentation-link-p)
+ (type widget-documentation-link-type)
+ (buttons (widget-get widget :buttons)))
+ (save-excursion
+ (goto-char from)
+ (while (re-search-forward regexp to t)
+ (let ((name (match-string 1))
+ (begin (match-beginning 1))
+ (end (match-end 1)))
+ (when (funcall predicate name)
+ (push (widget-convert-button type begin end :value name)
+ buttons)))))
+ (widget-put widget :buttons buttons)))
+ (let ((indent (widget-get widget :indent)))
+ (when (and indent (not (zerop indent)))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region from to)
+ (goto-char (point-min))
+ (while (search-forward "\n" nil t)
+ (insert-char ?\ indent)))))))
+
+;;; 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))
+ (indent (widget-get widget :indent))
+ (shown (widget-get (widget-get widget :parent) :documentation-shown))
+ (start (point)))
+ (if (string-match "\n" doc)
+ (let ((before (substring doc 0 (match-beginning 0)))
+ (after (substring doc (match-beginning 0)))
+ buttons)
+ (insert before " ")
+ (widget-documentation-link-add widget start (point))
+ (push (widget-create-child-and-convert
+ widget 'visibility
+ :help-echo "Show or hide rest of the documentation."
+ :off "More"
+ :action 'widget-parent-action
+ shown)
+ buttons)
+ (when shown
+ (setq start (point))
+ (when (and indent (not (zerop indent)))
+ (insert-char ?\ indent))
+ (insert after)
+ (widget-documentation-link-add widget start (point)))
+ (widget-put widget :buttons buttons))
+ (insert doc)
+ (widget-documentation-link-add widget start (point))))
+ (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.