From 314ad932333f6c34143d7e388809003c7b424316 Mon Sep 17 00:00:00 2001 From: Mauro Aranda Date: Fri, 4 Oct 2019 13:58:11 -0300 Subject: [PATCH] New command describe-actions (Bug#139) * lisp/help-fns.el (describe-actions-functions): New variable, to use in describe-actions. (describe-actions): New command, to describe the actions of an element, like a button or widget. * lisp/emacs-lisp/seq.el (seq-find): Add autoload cookie, so describe-actions can use it. * lisp/button.el (button-describe-actions): New command, to describe the actions of a button. (button--describe-actions-internal): Helper function for button-describe-action. * lisp/wid-edit.el (widget-describe-actions): New command, to describe the actions of a widget. (widget-resolve-parent-action): Helper function, to allow widget-describe-actions show more useful information. --- lisp/button.el | 58 +++++++++++++++++++++++++++++++++++++++++++++ lisp/emacs-lisp/seq.el | 1 + lisp/help-fns.el | 42 +++++++++++++++++++++++++++++++++ lisp/wid-edit.el | 64 ++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 165 insertions(+) diff --git a/lisp/button.el b/lisp/button.el index 04e77ca..66bc12f 100644 --- a/lisp/button.el +++ b/lisp/button.el @@ -538,6 +538,64 @@ backward-button (interactive "p\nd\nd") (forward-button (- n) wrap display-message no-error)) +(defun button--describe-actions-internal (type action mouse-down-action) + "Describe a button's TYPE, ACTION and MOUSE-DOWN-ACTION in a *Help* buffer. +This is a helper function for `button-describe-actions', in order to be possible +to use `help-setup-xref'." + (with-help-window (help-buffer) + (with-current-buffer (help-buffer) + (insert "This button's type is ") + (princ type) + (insert "\n\n") + (when (functionp action) + (insert (propertize "Action" 'face 'bold)) + (insert "\nThe action of this button is ") + (if (symbolp action) + (progn + (princ action) + (insert ",\nwhich is ") + (describe-function-1 action)) + (insert "\n") + (princ action))) + (when (functionp mouse-down-action) + (insert (propertize "Mouse-down-action" 'face 'bold)) + (insert "\nThe mouse-down-action of this button is ") + (if (symbolp mouse-down-action) + (progn + (princ mouse-down-action) + (insert ",\nwhich is ") + (describe-function-1 mouse-down-action)) + (insert "\n") + (princ mouse-down-action)))))) + +(defun button-describe-actions (&optional button-or-pos) + "Describe the actions associated to the button at point. +Displays a *Help* buffer with a description of the actions. + +When called from Lisp, pass BUTTON-OR-POS as the button to describe, or a +buffer position where a button is present. If BUTTON-OR-POS is nil, the +button at point is the button to describe." + (interactive "d") + (let ((button (cond ((numberp button-or-pos) + (button-at button-or-pos)) + ((markerp button-or-pos) + (with-current-buffer (marker-buffer button-or-pos) + (button-at button-or-pos))) + ((null button-or-pos) + (button-at (point))) + (t + button-or-pos))) + action mouse-down-action type) + (when button + (setq type (button-type button) + action (button-get button 'action) + mouse-down-action (button-get button 'mouse-down-action)) + (help-setup-xref + (list #'button--describe-actions-internal type action mouse-down-action) + (called-interactively-p 'interactive)) + (button--describe-actions-internal type action mouse-down-action) + t))) + (provide 'button) ;;; button.el ends here diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 3413cd1..f001dce 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -334,6 +334,7 @@ seq-sort-by (throw 'seq--break result)))) nil)) +;;;###autoload (cl-defgeneric seq-find (pred sequence &optional default) "Return the first element for which (PRED element) is non-nil in SEQUENCE. If no element is found, return DEFAULT. diff --git a/lisp/help-fns.el b/lisp/help-fns.el index e9e2818d..e9d2139 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1530,6 +1530,48 @@ describe-categories (while (setq table (char-table-parent table)) (insert "\nThe parent category table is:") (describe-vector table 'help-describe-category-set)))))) + +;; Actions. + +(defvar describe-actions-functions '(button-describe-actions + widget-describe-actions) + "A list of functions for `describe-actions' to call. +Each function should take one argument, a position in the buffer, and return +non-nil if it described the actions of an element at that position. +The argument passed might be nil, which indicates to describe the actions of +the element at point.") + +;;;###autoload +(defun describe-actions (&optional pos) + "Describe the actions associated to an element at a buffer position POS. +Actions are functions that get executed when the user activates the element, +by clicking on it, or pressing a key. Typically, actions are associated to +a button (e.g., links in a *Help* buffer) or a widget (e.g., buttons, links, +editable fields, etc., of the customization buffers). + +Interactively, click on an element to describe its actions, or hit RET +to describe the actions of the element at point. + +When called from Lisp, POS may be a buffer position, or nil, to describe the +actions of the element at point. + +Traverses the list `describe-action-functions', until one of the functions +returns non-nil." + (interactive + (list + (let ((key + (read-key + "Click an element, or hit RET to describe the element at point"))) + (cond ((eq key ?\C-m) nil) + ((and (mouse-event-p key) + (eq (event-basic-type key) 'mouse-1) + (equal (event-modifiers key) '(click))) + (posn-point (event-end key))) + ((eq key ?\C-g) (signal 'quit nil)) + (t (user-error "You didn't specify an element")))))) + (unless (seq-find (lambda (fun) (when (fboundp fun) (funcall fun pos))) + describe-actions-functions) + (message "No actions here"))) ;;; Replacements for old lib-src/ programs. Don't seem especially useful. diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 916d41a..f8f485a 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -586,6 +586,70 @@ widget-map-buttons (if (and widget (funcall function widget maparg)) (setq overlays nil))))) +(defun widget-describe-actions (&optional widget-or-pos) + "Describe the actions associated to the widget at point. +Displays a buffer with a description of the 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) + (let ((widget (if (widgetp widget-or-pos) + widget-or-pos + (widget-at (or widget-or-pos (point))))) + (inhibit-read-only t) ; For erasing the contents of the buffer. + action mouse-down-action) + (when widget + (setq action (widget-resolve-parent-action widget) + mouse-down-action (widget-get widget :mouse-down-action)) + (help-setup-xref (list #'widget-describe-actions widget) + (called-interactively-p 'interactive)) + (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) + (widget-insert "\n") + (when (functionp action) + (widget-insert (propertize "Action" 'face 'bold)) + (widget-insert "\nThe action of this widget is ") + (if (symbolp action) + (widget-create 'function-link :value action + :button-prefix "" + :button-suffix "" + :help-echo "Describe this function") + (widget-insert "\n") + (princ action)) + (widget-insert "\n\n")) + (when (functionp mouse-down-action) + (widget-insert (propertize "Mouse-down-action" 'face 'bold)) + (widget-insert "\nThe mouse-down-action of this widget is ") + (if (symbolp mouse-down-action) + (widget-create 'function-link :value mouse-down-action + :button-prefix "" + :button-suffix "" + :help-echo "Describe this function") + (widget-insert "\n") + (princ mouse-down-action)) + (widget-insert "\n")) + (widget-setup) + (goto-char (point-min))))))) + +(defun widget-resolve-parent-action (widget) + "If action of WIDGET is `widget-parent-action', find out what would that be." + (let ((action (widget-get widget :action)) + (parent (widget-get widget :parent))) + (while (and (eq action 'widget-parent-action) + (setq parent (widget-get parent :parent))) + (setq action (widget-get parent :action))) + action)) + ;;; Images. (defcustom widget-image-directory (file-name-as-directory -- 2.7.4