From 318281d4affcb53403914c592bd10bb45d655af1 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Fri, 21 Jun 2024 10:46:41 +0200 Subject: [PATCH] Add 'minibuffer-action' to some 'describe-*' and '*-theme' commands --- lisp/cus-theme.el | 7 ++++++- lisp/custom.el | 20 +++++++++++++++----- lisp/emacs-lisp/icons.el | 5 ++++- lisp/emacs-lisp/package.el | 3 +++ lisp/help.el | 2 ++ lisp/international/mule-cmds.el | 5 +++++ lisp/international/mule-diag.el | 14 +++++++++++++- 7 files changed, 48 insertions(+), 8 deletions(-) diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el index 1aa995a1d91..da04f1a9dec 100644 --- a/lisp/cus-theme.el +++ b/lisp/cus-theme.el @@ -333,9 +333,11 @@ SPEC, if non-nil, should be a face spec to which to set the widget." "Merge the custom theme THEME's settings into the current buffer." (interactive (list + ;; TODO: Add `minibuffer-action'. (intern (completing-read "Merge custom theme: " (mapcar #'symbol-name - (custom-available-themes)))))) + (custom-available-themes))))) + custom-new-theme-mode) (unless (eq theme 'user) (unless (custom-theme-name-valid-p theme) (error "Invalid theme name `%s'" theme)) @@ -482,6 +484,7 @@ It includes all faces in list FACES." (intern (completing-read "Describe custom theme: " (mapcar #'symbol-name (custom-available-themes)))))) + (setq theme (if (stringp theme) (intern theme) theme)) (unless (custom-theme-name-valid-p theme) (error "Invalid theme name `%s'" theme)) (help-setup-xref (list 'describe-theme theme) @@ -490,6 +493,8 @@ It includes all faces in list FACES." (with-current-buffer standard-output (describe-theme-1 theme)))) +(put 'describe-theme 'minibuffer-action "describe") + (defun describe-theme-from-file (theme &optional file short) "Describe THEME from its FILE without loading it. diff --git a/lisp/custom.el b/lisp/custom.el index 5d2a51f5fe3..3dfe40a4301 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1323,12 +1323,12 @@ Return t if THEME was successfully loaded, nil otherwise." (mapcar #'symbol-name (custom-available-themes)))) nil nil)) + (setq theme (if (stringp theme) (intern theme) theme) + ;; If THEME is already enabled, re-enable it after loading, even + ;; if NO-ENABLE is non-nil. + no-enable (and no-enable (not (custom-theme-enabled-p theme)))) (unless (custom-theme-name-valid-p theme) (error "Invalid theme name `%s'" theme)) - ;; If THEME is already enabled, re-enable it after loading, even if - ;; NO-ENABLE is t. - (if no-enable - (setq no-enable (not (custom-theme-enabled-p theme)))) ;; If reloading, clear out the old theme settings. (when (custom-theme-p theme) (disable-theme theme) @@ -1384,6 +1384,8 @@ Return t if THEME was successfully loaded, nil otherwise." (enable-theme theme)) t) +(put 'load-theme 'minibuffer-action "load") + (defun theme-list-variants (theme &rest list) "Return a list of theme variants for THEME. By default this will use all known custom themes (see @@ -1533,6 +1535,7 @@ After THEME has been enabled, runs `enable-theme-functions'." (completing-read "Enable custom theme: " obarray (lambda (sym) (get sym 'theme-settings)) t)))) + (setq theme (if (stringp theme) (intern theme) theme)) (unless (custom-theme-p theme) (error "Undefined Custom theme %s" theme)) (let ((settings (get theme 'theme-settings)) ; '(prop symbol theme value) @@ -1580,6 +1583,8 @@ After THEME has been enabled, runs `enable-theme-functions'." ;; Allow callers to react to the enabling. (run-hook-with-args 'enable-theme-functions theme)) +(put 'enable-theme 'minibuffer-action "enable") + (defcustom custom-enabled-themes nil "List of enabled Custom Themes, highest precedence first. This list does not include the `user' theme, which is set by @@ -1629,8 +1634,11 @@ After THEME has been disabled, runs `disable-theme-functions'." (interactive (list (intern (completing-read "Disable custom theme: " - (mapcar #'symbol-name custom-enabled-themes) + (completion-table-dynamic + (lambda (_) (mapcar #'symbol-name + custom-enabled-themes))) nil t)))) + (setq theme (if (stringp theme) (intern theme) theme)) (when (custom-theme-enabled-p theme) (let ((settings (get theme 'theme-settings))) (dolist (s settings) @@ -1673,6 +1681,8 @@ After THEME has been disabled, runs `disable-theme-functions'." ;; Allow callers to react to the disabling. (run-hook-with-args 'disable-theme-functions theme))) +(put 'disable-theme 'minibuffer-action "disable") + ;; Only used if window-system not null. (declare-function x-get-resource "frame.c" (attribute class &optional component subclass)) diff --git a/lisp/emacs-lisp/icons.el b/lisp/emacs-lisp/icons.el index 847ef53a1cb..e84fbadeda1 100644 --- a/lisp/emacs-lisp/icons.el +++ b/lisp/emacs-lisp/icons.el @@ -246,7 +246,8 @@ present if the icon is represented by an image." "Pop to a buffer to describe ICON." (interactive (list (intern (completing-read "Describe icon: " obarray 'iconp t)))) - (let ((help-buffer-under-preparation t)) + (let ((icon (if (stringp icon) (intern icon) icon)) + (help-buffer-under-preparation t)) (help-setup-xref (list #'describe-icon icon) (called-interactively-p 'interactive)) (with-help-window (help-buffer) @@ -263,6 +264,8 @@ present if the icon is represented by an image." (insert "\nSpecification not including inheritance and theming:\n") (icons--describe-spec plain))))))) +(put 'describe-icon 'minibuffer-action "describe") + (defun icons--describe-spec (spec) (dolist (elem spec) (let ((type (car elem)) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index fac824d44a4..0e1f97b8204 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2720,6 +2720,7 @@ the Emacs user directory is set to a temporary directory." packages nil t nil nil (when guess (symbol-name guess))))) (list (and (> (length val) 0) (intern val))))))) + (setq package (if (stringp package) (intern package) package)) (if (not (or (package-desc-p package) (and package (symbolp package)))) (message "No package specified") (help-setup-xref (list #'describe-package package) @@ -2728,6 +2729,8 @@ the Emacs user directory is set to a temporary directory." (with-current-buffer standard-output (describe-package-1 package))))) +(put 'describe-package 'minibuffer-action "describe") + (defface package-help-section-name '((t :inherit (bold font-lock-function-name-face))) "Face used on section names in package description buffers." diff --git a/lisp/help.el b/lisp/help.el index b8c7d59760c..021d83f0705 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1363,6 +1363,8 @@ appeared on the mode-line." (t (error "No such minor mode: %s" minor-mode))))) +(put 'describe-minor-mode 'minibuffer-action "describe") + ;; symbol (defun describe-minor-mode-completion-table-for-symbol () ;; In order to list up all minor modes, minor-mode-list diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 8f7d9715f36..f38045f968d 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -1662,6 +1662,8 @@ If `default-transient-input-method' was not yet defined, prompt for it." "Input method: %s (`%s' in mode line) for %s\n %s\n" input-method (nth 3 elt) (nth 1 elt) (nth 4 elt))))))))))) +(put 'describe-input-method 'minibuffer-action "describe") + (defun describe-current-input-method () "Describe the input method currently in use. This is a subroutine for `describe-input-method'." @@ -2246,6 +2248,9 @@ See `set-language-info-alist' for use in programs." (setq aliases (cdr aliases))) (insert ")\n"))) (setq l (cdr l)))))))))) + +(put 'describe-language-environment 'minibuffer-action "describe") + ;;; Locales. diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el index 6ef0c26c55f..725592c9a10 100644 --- a/lisp/international/mule-diag.el +++ b/lisp/international/mule-diag.el @@ -296,6 +296,7 @@ meanings of these arguments." (defun describe-character-set (charset) "Display information about built-in character set CHARSET." (interactive (list (read-charset "Charset: "))) + (setq charset (if (stringp charset) (intern charset) charset)) (let ((help-buffer-under-preparation t)) (or (charsetp charset) (error "Invalid charset: %S" charset)) @@ -356,6 +357,9 @@ or provided just for backward compatibility." nil))) (let ((print-length 10) (print-level 2)) (princ (funcall (nth 2 elt) val) (current-buffer)))) (insert ?\n)))))))) + +(put 'describe-character-set 'minibuffer-action "describe") + ;;; CODING-SYSTEM @@ -404,7 +408,9 @@ or provided just for backward compatibility." nil))) (defun describe-coding-system (coding-system) "Display information about CODING-SYSTEM." (interactive "zDescribe coding system (default current choices): ") - (let ((help-buffer-under-preparation t)) + (let ((coding-system (if (stringp coding-system) (intern coding-system) + coding-system)) + (help-buffer-under-preparation t)) (if (null coding-system) (describe-current-coding-system) (help-setup-xref (list #'describe-coding-system coding-system) @@ -489,6 +495,8 @@ or provided just for backward compatibility." nil))) (goto-char (point-max)) (setq charsets (cdr charsets)))))))))))) +(put 'describe-coding-system 'minibuffer-action "describe") + ;;;###autoload (defun describe-current-coding-system-briefly () "Display coding systems currently used in a brief format in echo area. @@ -860,6 +868,8 @@ The IGNORED argument is ignored." (with-output-to-temp-buffer "*Help*" (describe-font-internal font-info))))) +(put 'describe-font 'minibuffer-action "describe") + (defvar mule--print-opened) (defun mule--kbd-at (point) @@ -1016,6 +1026,8 @@ This shows which font is used for which character(s)." (with-current-buffer standard-output (print-fontset fontset t))))) +(put 'describe-fontset 'minibuffer-action "describe") + (declare-function fontset-plain-name "fontset" (fontset)) ;;;###autoload -- 2.39.2