bug#139: describe-key vs. widget red tape

[Mauro Aranda <maurooaranda@gmail.com>]

[-- Attachment #1.1: Type: text/plain, Size: 1235 bytes --]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> Mauro Aranda <maurooaranda@gmail.com> writes:
>
>>> Could this also be extended to button.el buttons?
>>
>> I think so.  I'll think how to put it all together and come back with a
>> patch.  (Will be busy the next few days, but perhaps by the weekend I'll
>> be able to send it)
>
> Great!

Find in the attached patch my idea to implement this.

I wrote a command, describe-actions, so the user does not have to care
if the element to describe is either a button, a widget, or whatever.
And then, the libraries that define this kind of elements should add
themselves to `describe-actions-functions'.

Then I implemented the functions for the button.el buttons and the
widgets.

There are some things I would like to ask:
- I would like to put an initial value of nil to
`describe-actions-functions', and let each library add the function to
this list.  Is it OK to use `with-eval-after-load' here? Is there
another way?

- I put an autoload cookie in `seq-find', in order to use it in
`describe-actions'.  Is it OK?

Please review the patch and send any suggestions for improvement.  If
accepted, I'll write the documentation needed for the NEWS file and the
manual.

Best regards,
Mauro.

[-- Attachment #1.2: Type: text/html, Size: 1557 bytes --]

[-- Attachment #2: 0001-New-command-describe-actions-Bug-139.patch --]
[-- Type: text/x-patch, Size: 9454 bytes --]

From 314ad932333f6c34143d7e388809003c7b424316 Mon Sep 17 00:00:00 2001
From: Mauro Aranda <maurooaranda@gmail.com>
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))))))
+\f
+;; 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")))
 
 \f
 ;;; 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