diff options
| author | Mauro Aranda <maurooaranda@gmail.com> | 2020-08-07 13:14:41 +0200 |
|---|---|---|
| committer | Lars Ingebrigtsen <larsi@gnus.org> | 2020-08-07 13:36:55 +0200 |
| commit | 95b60c84b3bbed262d0af75bc69d4df9cb2cd9eb (patch) | |
| tree | 1a42fcf748db2b90681f749ddf8f6b2497bd75b0 /lisp/wid-edit.el | |
| parent | c32d6b21b81bed54d9738816c9164157ab6165c3 (diff) | |
| download | emacs-95b60c84b3bbed262d0af75bc69d4df9cb2cd9eb.tar.gz emacs-95b60c84b3bbed262d0af75bc69d4df9cb2cd9eb.tar.bz2 emacs-95b60c84b3bbed262d0af75bc69d4df9cb2cd9eb.zip | |
Add new commands to describe buttons and widgets
* lisp/help-fns.el (describe-widget-functions): New variable, used by
describe-widget.
(describe-widget): New command, to display information about a widget.
* lisp/button.el (button-describe): New command, for describing a button.
(button--describe): Helper function for button-describe.
* lisp/wid-edit.el (widget-describe): New command, for describing a
widget.
(widget--resolve-parent-action): Helper function, to allow
widget-describe to display more useful information (bug#139).
Diffstat (limited to 'lisp/wid-edit.el')
| -rw-r--r-- | lisp/wid-edit.el | 57 |
1 files changed, 57 insertions, 0 deletions
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 284fd1d6cbd..ea7e266e0d0 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -577,6 +577,63 @@ respectively." (if (and widget (funcall function widget maparg)) (setq overlays nil))))) +(defun widget-describe (&optional widget-or-pos) + "Describe the widget at point. +Displays a buffer with information about the widget (e.g., its actions) as well +as a link to browse all the properties of the widget. + +This command resolves the indirection of widgets running the action of its +parents, so the real action executed can be known. + +When called from Lisp, pass WIDGET-OR-POS as the widget to describe, +or a buffer position where a widget is present. If WIDGET-OR-POS is nil, +the widget at point is the widget to describe." + (interactive "d") + (require 'wid-browse) ; The widget-browse widget. + (let ((widget (if (widgetp widget-or-pos) + widget-or-pos + (widget-at widget-or-pos))) + props) + (when widget + (help-setup-xref (list #'widget-describe widget) + (called-interactively-p 'interactive)) + (setq props (list (cons 'action (widget--resolve-parent-action widget)) + (cons 'mouse-down-action + (widget-get widget :mouse-down-action)))) + (with-help-window (help-buffer) + (with-current-buffer (help-buffer) + (widget-insert "This widget's type is ") + (widget-create 'widget-browse :format "%[%v%]\n%d" + :doc (get (car widget) 'widget-documentation) + :help-echo "Browse this widget's properties" + widget) + (dolist (action '(action mouse-down-action)) + (let ((name (symbol-name action)) + (val (alist-get action props))) + (when (functionp val) + (widget-insert "\n\n" (propertize (capitalize name) 'face 'bold) + "'\nThe " name " of this widget is") + (if (symbolp val) + (progn (widget-insert " ") + (widget-create 'function-link :value val + :button-prefix "" :button-suffix "" + :help-echo "Describe this function")) + (widget-insert "\n") + (princ val))))))) + (widget-setup) + t))) + +(defun widget--resolve-parent-action (widget) + "Resolve the real action of WIDGET up its inheritance chain. +Follow the WIDGET's parents, until its :action is no longer +`widget-parent-action', and return its value." + (let ((action (widget-get widget :action)) + (parent (widget-get widget :parent))) + (while (eq action 'widget-parent-action) + (setq parent (widget-get parent :parent) + action (widget-get parent :action))) + action)) + ;;; Images. (defcustom widget-image-directory (file-name-as-directory |