** Autosaving via 'auto-save-visited-mode' can now be inhibited by
setting the variable 'auto-save-visited-mode' buffer-locally to nil.
+** New commands to describe buttons and widgets have been added.
+'describe-widget' (on a widget) will pop up a help buffer and give a
+description of the properties. Likewise 'describe-button' does the
+same for a button.
+
\f
* Changes in Specialized Modes and Packages in Emacs 28.1
(interactive "p\nd\nd")
(forward-button (- n) wrap display-message no-error))
+(defun button--describe (properties)
+ "Describe a button's PROPERTIES (an alist) in a *Help* buffer.
+This is a helper function for `button-describe', in order to be possible to
+use `help-setup-xref'.
+
+Each element of PROPERTIES should be of the form (PROPERTY . VALUE)."
+ (help-setup-xref (list #'button--describe properties)
+ (called-interactively-p 'interactive))
+ (with-help-window (help-buffer)
+ (with-current-buffer (help-buffer)
+ (insert (format-message "This button's type is `%s'."
+ (alist-get 'type properties)))
+ (dolist (prop '(action mouse-action))
+ (let ((name (symbol-name prop))
+ (val (alist-get prop properties)))
+ (when (functionp val)
+ (insert "\n\n"
+ (propertize (capitalize name) 'face 'bold)
+ "\nThe " name " of this button is")
+ (if (symbolp val)
+ (progn
+ (insert (format-message " `%s',\nwhich is " val))
+ (describe-function-1 val))
+ (insert "\n")
+ (princ val))))))))
+
+(defun button-describe (&optional button-or-pos)
+ "Display a buffer with information about the button at point.
+
+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 ((integer-or-marker-p button-or-pos)
+ (button-at button-or-pos))
+ ((null button-or-pos) (button-at (point)))
+ ((overlayp button-or-pos) button-or-pos)))
+ (props (and button
+ (mapcar (lambda (prop)
+ (cons prop (button-get button prop)))
+ '(type action mouse-action)))))
+ (when props
+ (button--describe props)
+ t)))
+
(provide 'button)
;;; button.el ends here
;; For the sake of IELM and maybe others
nil)
\f
+;; Widgets.
+
+(defvar describe-widget-functions
+ '(button-describe widget-describe)
+ "A list of functions for `describe-widget' to call.
+Each function should take one argument, a buffer position, and return
+non-nil if it described a widget at that position.")
+
+;;;###autoload
+(defun describe-widget (&optional pos)
+ "Display a buffer with information about a widget.
+You can use this command to describe buttons (e.g., the links in a *Help*
+buffer), editable fields of the customization buffers, etc.
+
+Interactively, click on a widget to describe it, or hit RET to describe the
+widget at point.
+
+When called from Lisp, POS may be a buffer position or a mouse position list.
+
+Calls each function of the list `describe-widget-functions' in turn, until
+one of them returns non-nil."
+ (interactive
+ (list
+ (let ((key
+ (read-key
+ "Click on a widget, or hit RET to describe the widget at point")))
+ (cond ((eq key ?\C-m) (point))
+ ((and (mouse-event-p key)
+ (eq (event-basic-type key) 'mouse-1)
+ (equal (event-modifiers key) '(click)))
+ (event-end key))
+ ((eq key ?\C-g) (signal 'quit nil))
+ (t (user-error "You didn't specify a widget"))))))
+ (let (buf)
+ ;; Allow describing a widget in a different window.
+ (when (posnp pos)
+ (setq buf (window-buffer (posn-window pos))
+ pos (posn-point pos)))
+ (with-current-buffer (or buf (current-buffer))
+ (unless (cl-some (lambda (fun) (when (fboundp fun) (funcall fun pos)))
+ describe-widget-functions)
+ (message "No widget found at that position")))))
+\f
+
;;; Replacements for old lib-src/ programs. Don't seem especially useful.
;; Replaces lib-src/digest-doc.c.
(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
projects / emacs.git / commitdiff