branch: elpa/helm
commit 4477cebf4c1d583b6a37c273b70fd04218b58172
Author: Thierry Volpiatto <thie...@posteo.net>
Commit: Thierry Volpiatto <thie...@posteo.net>
Integrate helm-M-x prefix arg in helm-mode
Add a new completion metadata category command-help to handle this feature.
---
helm-mode.el | 130 ++++++++++++++++++++++++++++++++++++++---------------------
1 file changed, 85 insertions(+), 45 deletions(-)
diff --git a/helm-mode.el b/helm-mode.el
index 47b463ae93..965b66e409 100644
--- a/helm-mode.el
+++ b/helm-mode.el
@@ -1039,6 +1039,11 @@ that use `helm-comp-read'. See `helm-M-x' for example."
(symbol-help . (metadata
(affixation-function .
helm-symbol-completion-table-affixation)
(category . symbol-help)))
+ (command-help . (metadata
+ (prefix-arg . t)
+ (flags . (helm-M-x-prefix-argument))
+ (affixation-function .
helm-symbol-completion-table-affixation)
+ (category . symbol-help)))
(eww-help . (metadata ;; Emacs-30 only
(affixation-function . helm-completion-eww-affixation)
(category . eww-help)))
@@ -1106,7 +1111,7 @@ FLAGS is a list of variables to renitialize to nil when
exiting or quitting.")
("describe-minor-mode" . symbol-help)
("where-is" . symbol-help)
("execute-extended-command" . symbol-help)
- ("execute-extended-command-for-buffer" . symbol-help)
+ ("execute-extended-command-for-buffer" . command-help)
("info-lookup-symbol" . symbol-help)
("Info-goto-emacs-command-node" . symbol-help)
("find-library" . library)
@@ -1506,7 +1511,7 @@ dynamically otherwise use
`helm-completing-read-default-2'."
metadata 'display-sort-function)
(lambda (candidates)
(sort candidates #'helm-generic-sort-fn)))))
- popup-info flags)
+ popup-info flags pref-arg keymap)
(helm-aif (and (null category)
(assoc-default name
helm-completing-read-command-categories))
(setq metadata `(metadata (category . ,it))
@@ -1518,54 +1523,89 @@ dynamically otherwise use
`helm-completing-read-default-2'."
(setq metadata it)
(setq afun (completion-metadata-get metadata 'annotation-function)
afix (completion-metadata-get metadata 'affixation-function)
+ pref-arg (completion-metadata-get metadata 'prefix-arg)
popup-info (completion-metadata-get metadata
'popup-info-function)
flags (completion-metadata-get metadata 'flags))))
+ (setq keymap (if pref-arg
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map helm-comp-read-map)
+ (define-key map (kbd "C-u")
'helm-M-x-universal-argument)
+ map)
+ helm-comp-read-map)
+ prompt (if pref-arg
+ (concat (helm-acase helm-M-x-prefix-argument
+ (- "-")
+ ((guard* (and (consp it) (car it)))
+ (if (eq guard 4) "C-u " (format "%d " guard)))
+ ((guard* (integerp it)) (format "%d " it)))
+ prompt)
+ prompt)
+ helm--mode-line-display-prefarg pref-arg)
+ (when pref-arg
+ (setq helm-M-x--timer (run-at-time 1 0.1 #'helm-M-x--notify-prefix-arg))
+ (setq current-prefix-arg nil)
+ (advice-add 'command-execute :around #'helm--advice-command-execute)
+ ;; Remove command-execute advice when execute-extended-command exit.
+ (advice-add 'execute-extended-command :around
#'helm--advice-execute-extended-command))
(unwind-protect
- (helm-comp-read
- prompt collection
- :test test
- :history history
- :reverse-history helm-mode-reverse-history
- :input-history history
- :must-match require-match
- :alistp alistp
- :diacritics helm-mode-ignore-diacritics
- :help-message #'helm-comp-read-help-message
- :name name
- :requires-pattern (if (and (stringp default)
- (string= default "")
- (memq require-match
- '(confirm
confirm-after-completion)))
- 1 0)
- :fc-transformer
- ;; When afun afix and category are nil
- ;; helm-completion--decorate returns
- ;; candidates (COMPS) unmodified.
- (append (list (lambda (candidates _source)
- (helm-completion--decorate
- (if (and sort-fn (> (length helm-pattern) 0))
- (funcall sort-fn candidates)
- candidates)
- afun afix category)))
- '(helm-cr-default-transformer))
- :popup-info popup-info
- :quit-when-no-cand (eq require-match t)
- :nomark (null helm-comp-read-use-marked)
- :candidates-in-buffer cands-in-buffer
- :get-line (or get-line #'buffer-substring)
- :exec-when-only-one exec-when-only-one
- :fuzzy (eq helm-completion-style 'helm-fuzzy)
- :buffer buffer
- ;; If DEF is not provided, fallback to empty string
- ;; to avoid `thing-at-point' to be appended on top of list
- :default (or default "")
- ;; Fail with special characters (e.g in gnus "nnimap+gmail:")
- ;; if regexp-quote is not used.
- ;; when init is added to history, it will be unquoted by
- ;; helm-comp-read.
- :initial-input initial-input)
+ (prog1
+ (helm-comp-read
+ prompt collection
+ :test test
+ :keymap keymap
+ :history history
+ :reverse-history helm-mode-reverse-history
+ :input-history history
+ :must-match require-match
+ :alistp alistp
+ :diacritics helm-mode-ignore-diacritics
+ :help-message #'helm-comp-read-help-message
+ :name name
+ :requires-pattern (if (and (stringp default)
+ (string= default "")
+ (memq require-match
+ '(confirm
confirm-after-completion)))
+ 1 0)
+ :fc-transformer
+ ;; When afun afix and category are nil
+ ;; helm-completion--decorate returns
+ ;; candidates (COMPS) unmodified.
+ (append (list (lambda (candidates _source)
+ (helm-completion--decorate
+ (if (and sort-fn (> (length helm-pattern) 0))
+ (funcall sort-fn candidates)
+ candidates)
+ afun afix category)))
+ '(helm-cr-default-transformer))
+ :popup-info popup-info
+ :quit-when-no-cand (eq require-match t)
+ :nomark (null helm-comp-read-use-marked)
+ :candidates-in-buffer cands-in-buffer
+ :get-line (or get-line #'buffer-substring)
+ :exec-when-only-one exec-when-only-one
+ :fuzzy (eq helm-completion-style 'helm-fuzzy)
+ :buffer buffer
+ ;; If DEF is not provided, fallback to empty string
+ ;; to avoid `thing-at-point' to be appended on top of list
+ :default (or default "")
+ ;; Fail with special characters (e.g in gnus "nnimap+gmail:")
+ ;; if regexp-quote is not used.
+ ;; when init is added to history, it will be unquoted by
+ ;; helm-comp-read.
+ :initial-input initial-input)
+ (when pref-arg (setq current-prefix-arg helm-current-prefix-arg)))
+ (when (timerp helm-M-x--timer)
+ (cancel-timer helm-M-x--timer) (setq helm-M-x--timer nil))
(dolist (f flags) (set f nil)))))
+(defun helm--advice-command-execute (old--fn &rest args)
+ (unless prefix-arg (setq prefix-arg current-prefix-arg))
+ (apply old--fn args))
+
+(defun helm--advice-execute-extended-command (old--fn &rest args)
+ (prog1 (apply old--fn args)
+ (advice-remove 'command-execute 'helm--advice-command-execute)))
+
(defun helm-completing-read-default-2
(prompt collection predicate require-match
init hist default _inherit-input-method
