diff options
Diffstat (limited to 'lisp/wid-edit.el')
| -rw-r--r-- | lisp/wid-edit.el | 102 |
1 files changed, 57 insertions, 45 deletions
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 50df4bd56c6..49d519a9ea2 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -1503,6 +1503,8 @@ If that does not exists, call the value of `widget-complete-field'." (delete-backward-char 1)) (insert ?\n) (setq doc-end (point))))) + ((eq escape ?h) + (widget-add-documentation-string-button widget)) ((eq escape ?v) (if (and button-begin (not button-end)) (widget-apply widget :value-create) @@ -1528,44 +1530,7 @@ If that does not exists, call the value of `widget-complete-field'." (widget-clear-undo)) (defun widget-default-format-handler (widget escape) - ;; We recognize the %h escape by default. - (let* ((buttons (widget-get widget :buttons))) - (cond ((eq escape ?h) - (let* ((doc-property (widget-get widget :documentation-property)) - (doc-try (cond ((widget-get widget :doc)) - ((functionp doc-property) - (funcall doc-property - (widget-get widget :value))) - ((symbolp doc-property) - (documentation-property - (widget-get widget :value) - doc-property)))) - (doc-text (and (stringp doc-try) - (> (length doc-try) 1) - doc-try)) - (doc-indent (widget-get widget :documentation-indent))) - (when doc-text - (and (eq (preceding-char) ?\n) - (widget-get widget :indent) - (insert-char ?\s (widget-get widget :indent))) - ;; The `*' in the beginning is redundant. - (when (eq (aref doc-text 0) ?*) - (setq doc-text (substring doc-text 1))) - ;; Get rid of trailing newlines. - (when (string-match "\n+\\'" doc-text) - (setq doc-text (substring doc-text 0 (match-beginning 0)))) - (push (widget-create-child-and-convert - widget 'documentation-string - :indent (cond ((numberp doc-indent ) - doc-indent) - ((null doc-indent) - nil) - (t 0)) - doc-text) - buttons)))) - (t - (error "Unknown escape `%c'" escape))) - (widget-put widget :buttons buttons))) + (error "Unknown escape `%c'" escape)) (defun widget-default-button-face-get (widget) ;; Use :button-face or widget-button-face @@ -1677,13 +1642,32 @@ If that does not exists, call the value of `widget-complete-field'." (widget-default-action widget event)) (defun widget-default-prompt-value (widget prompt value unbound) - "Read an arbitrary value. Stolen from `set-variable'." -;; (let ((initial (if unbound -;; nil -;; It would be nice if we could do a `(cons val 1)' here. -;; (prin1-to-string (custom-quote value)))))) + "Read an arbitrary value." (eval-minibuffer prompt)) +(defun widget-docstring (widget) + "Return the documentation string specificied by WIDGET, or nil if none. +If WIDGET has a `:doc' property, that specifies the documentation string. +Otherwise, try the `:documentation-property' property. If this +is a function, call it with the widget's value as an argument; if +it is a symbol, use this symbol together with the widget's value +as the argument to `documentation-property'." + (let ((doc (or (widget-get widget :doc) + (let ((doc-prop (widget-get widget :documentation-property)) + (value (widget-get widget :value))) + (cond ((functionp doc-prop) + (funcall doc-prop value)) + ((symbolp doc-prop) + (documentation-property value doc-prop))))))) + (when (and (stringp doc) (> (length doc) 0)) + ;; Remove any redundant `*' in the beginning. + (when (eq (aref doc 0) ?*) + (setq doc (substring doc 1))) + ;; Remove trailing newlines. + (when (string-match "\n+\\'" doc) + (setq doc (substring doc 0 (match-beginning 0)))) + doc))) + ;;; The `item' Widget. (define-widget 'item 'default @@ -2925,7 +2909,8 @@ link for that string." "A documentation string." :format "%v" :action 'widget-documentation-string-action - :value-create 'widget-documentation-string-value-create) + :value-create 'widget-documentation-string-value-create + :visibility-widget 'visibility) (defun widget-documentation-string-value-create (widget) ;; Insert documentation string. @@ -2937,11 +2922,13 @@ link for that string." (let ((before (substring doc 0 (match-beginning 0))) (after (substring doc (match-beginning 0))) button) + (when (and indent (not (zerop indent))) + (insert-char ?\s indent)) (insert before ?\s) (widget-documentation-link-add widget start (point)) (setq button (widget-create-child-and-convert - widget 'visibility + widget (widget-get widget :visibility-widget) :help-echo "Show or hide rest of the documentation." :on "Hide Rest" :off "More" @@ -2955,6 +2942,8 @@ link for that string." (insert after) (widget-documentation-link-add widget start (point))) (widget-put widget :buttons (list button))) + (when (and indent (not (zerop indent))) + (insert-char ?\s indent)) (insert doc) (widget-documentation-link-add widget start (point)))) (insert ?\n)) @@ -2966,6 +2955,29 @@ link for that string." (not (widget-get parent :documentation-shown)))) ;; Redraw. (widget-value-set widget (widget-value widget))) + +(defun widget-add-documentation-string-button (widget &rest args) + "Insert a new `documentation-string' widget based on WIDGET. +The new widget becomes a child of WIDGET, and is also added to +its `:buttons' list. The documentation string is found from +WIDGET using the function `widget-docstring'. +Optional ARGS specifies additional keyword arguments for the +`documentation-string' widget." + (let ((doc (widget-docstring widget)) + (indent (widget-get widget :indent)) + (doc-indent (widget-get widget :documentation-indent))) + (when doc + (and (eq (preceding-char) ?\n) + indent + (insert-char ?\s indent)) + (unless (or (numberp doc-indent) (null doc-indent)) + (setq doc-indent 0)) + (widget-put widget :buttons + (cons (apply 'widget-create-child-and-convert + widget 'documentation-string + :indent doc-indent + (nconc args (list doc))) + (widget-get widget :buttons)))))) ;;; The Sexp Widgets. |