Klimi's new dotfiles with stow.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

363 lines
15 KiB

4 years ago
  1. ;;; helm-command.el --- Helm execute-exended-command. -*- lexical-binding: t -*-
  2. ;; Copyright (C) 2012 ~ 2019 Thierry Volpiatto <thierry.volpiatto@gmail.com>
  3. ;; This program is free software; you can redistribute it and/or modify
  4. ;; it under the terms of the GNU General Public License as published by
  5. ;; the Free Software Foundation, either version 3 of the License, or
  6. ;; (at your option) any later version.
  7. ;; This program is distributed in the hope that it will be useful,
  8. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  10. ;; GNU General Public License for more details.
  11. ;; You should have received a copy of the GNU General Public License
  12. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  13. ;;; Code:
  14. (require 'cl-lib)
  15. (require 'helm)
  16. (require 'helm-help)
  17. (require 'helm-mode)
  18. (require 'helm-elisp)
  19. (defgroup helm-command nil
  20. "Emacs command related Applications and libraries for Helm."
  21. :group 'helm)
  22. (defcustom helm-M-x-requires-pattern 0
  23. "Value of requires-pattern for `helm-M-x'.
  24. Show all candidates on startup when 0 (default)."
  25. :group 'helm-command
  26. :type 'boolean)
  27. (defcustom helm-M-x-always-save-history nil
  28. "`helm-M-x' Save command in `extended-command-history' even when it fail."
  29. :group 'helm-command
  30. :type 'boolean)
  31. (defcustom helm-M-x-reverse-history nil
  32. "The history source of `helm-M-x' appear in second position when non--nil."
  33. :group 'helm-command
  34. :type 'boolean)
  35. (defcustom helm-M-x-fuzzy-match nil
  36. "Enable fuzzy matching in `helm-M-x' when non--nil.
  37. This have no effect when `helm-M-x-use-completion-styles' is non nil"
  38. :group 'helm-command
  39. :type 'boolean)
  40. (defcustom helm-M-x-use-completion-styles t
  41. "Use `completion-styles' in helm-M-x."
  42. :group 'helm-command
  43. :type 'boolean)
  44. (defcustom helm-M-x-default-sort-fn #'helm-M-x-fuzzy-sort-candidates
  45. "Default sort function for `helm-M-x' with fuzzy matching.
  46. It should sort against REAL value of candidates."
  47. :group 'helm-command
  48. :type 'function)
  49. ;;; Faces
  50. ;;
  51. ;;
  52. (defgroup helm-command-faces nil
  53. "Customize the appearance of helm-command."
  54. :prefix "helm-"
  55. :group 'helm-command
  56. :group 'helm-faces)
  57. (defface helm-M-x-key '((t (:foreground "orange" :underline t)))
  58. "Face used in helm-M-x to show keybinding."
  59. :group 'helm-command-faces)
  60. (defvar helm-M-x-input-history nil)
  61. (defvar helm-M-x-prefix-argument nil
  62. "Prefix argument before calling `helm-M-x'.")
  63. (defun helm-M-x-get-major-mode-command-alist (mode-map)
  64. "Return alist of MODE-MAP."
  65. (when mode-map
  66. (cl-loop for key being the key-seqs of mode-map using (key-bindings com)
  67. for str-key = (key-description key)
  68. for ismenu = (string-match "<menu-bar>" str-key)
  69. unless ismenu collect (cons str-key com))))
  70. (defun helm-get-mode-map-from-mode (mode)
  71. "Guess the mode-map name according to MODE.
  72. Some modes don't use conventional mode-map name
  73. so we need to guess mode-map name. e.g python-mode ==> py-mode-map.
  74. Return nil if no mode-map found."
  75. (cl-loop ;; Start with a conventional mode-map name.
  76. with mode-map = (intern-soft (format "%s-map" mode))
  77. with mode-string = (symbol-name mode)
  78. with mode-name = (replace-regexp-in-string "-mode" "" mode-string)
  79. while (not mode-map)
  80. for count downfrom (length mode-name)
  81. ;; Return when no result after parsing entire string.
  82. when (eq count 0) return nil
  83. for sub-name = (substring mode-name 0 count)
  84. do (setq mode-map (intern-soft (format "%s-map" (concat sub-name "-mode"))))
  85. finally return mode-map))
  86. (defun helm-M-x-current-mode-map-alist ()
  87. "Return mode-map alist of current `major-mode'."
  88. (let ((map-sym (helm-get-mode-map-from-mode major-mode)))
  89. (when (and map-sym (boundp map-sym))
  90. (helm-M-x-get-major-mode-command-alist (symbol-value map-sym)))))
  91. (defun helm-M-x-transformer-1 (candidates &optional sort)
  92. "Transformer function to show bindings in emacs commands.
  93. Show global bindings and local bindings according to current `major-mode'.
  94. If SORT is non nil sort list with `helm-generic-sort-fn'.
  95. Note that SORT should not be used when fuzzy matching because
  96. fuzzy matching is running its own sort function with a different algorithm."
  97. (with-helm-current-buffer
  98. (cl-loop with local-map = (helm-M-x-current-mode-map-alist)
  99. for cand in candidates
  100. for local-key = (car (rassq cand local-map))
  101. for key = (substitute-command-keys (format "\\[%s]" cand))
  102. unless (get (intern (if (consp cand) (car cand) cand)) 'helm-only)
  103. collect
  104. (cons (cond ((and (string-match "^M-x" key) local-key)
  105. (format "%s (%s)"
  106. cand (propertize
  107. local-key
  108. 'face 'helm-M-x-key)))
  109. ((string-match "^M-x" key) cand)
  110. (t (format "%s (%s)"
  111. cand (propertize
  112. key
  113. 'face 'helm-M-x-key))))
  114. cand)
  115. into ls
  116. finally return
  117. (if sort (sort ls #'helm-generic-sort-fn) ls))))
  118. (defun helm-M-x-transformer (candidates _source)
  119. "Transformer function for `helm-M-x' candidates."
  120. ;; Generic sort function is handling helm-flex.
  121. (helm-M-x-transformer-1 candidates (null helm--in-fuzzy)))
  122. (defun helm-M-x-transformer-no-sort (candidates _source)
  123. "Transformer function for `helm-M-x' candidates."
  124. (helm-M-x-transformer-1 candidates))
  125. (defun helm-M-x--notify-prefix-arg ()
  126. ;; Notify a prefix-arg set AFTER calling M-x.
  127. (when prefix-arg
  128. (with-helm-window
  129. (helm-display-mode-line (helm-get-current-source) 'force))))
  130. (defun helm-cmd--get-current-function-name ()
  131. (save-excursion
  132. (beginning-of-defun)
  133. (cadr (split-string (buffer-substring-no-properties
  134. (point-at-bol) (point-at-eol))))))
  135. (defun helm-cmd--get-preconfigured-commands (&optional dir)
  136. (let* ((helm-dir (or dir (helm-basedir (locate-library "helm"))))
  137. (helm-autoload-file (expand-file-name "helm-autoloads.el" helm-dir))
  138. results)
  139. (when (file-exists-p helm-autoload-file)
  140. (with-temp-buffer
  141. (insert-file-contents helm-autoload-file)
  142. (while (re-search-forward "Preconfigured" nil t)
  143. (push (substring (helm-cmd--get-current-function-name) 1) results))))
  144. results))
  145. (defvar helm-M-x-map
  146. (let ((map (make-sparse-keymap)))
  147. (set-keymap-parent map helm-comp-read-map)
  148. (define-key map (kbd "C-u") nil)
  149. (define-key map (kbd "C-u") 'helm-M-x-universal-argument)
  150. map))
  151. (defun helm-M-x-universal-argument ()
  152. "Same as `universal-argument' but for `helm-M-x'."
  153. (interactive)
  154. (if helm-M-x-prefix-argument
  155. (progn (setq helm-M-x-prefix-argument nil)
  156. (let ((inhibit-read-only t))
  157. (with-selected-window (minibuffer-window)
  158. (save-excursion
  159. (goto-char (point-min))
  160. (delete-char (- (minibuffer-prompt-width) (length "M-x "))))))
  161. (message "Initial prefix arg disabled"))
  162. (setq prefix-arg (list 4))
  163. (universal-argument--mode)))
  164. (put 'helm-M-x-universal-argument 'helm-only t)
  165. (defun helm-M-x-fuzzy-sort-candidates (candidates _source)
  166. (helm-fuzzy-matching-default-sort-fn-1 candidates t))
  167. (defun helm-M-x-persistent-action (candidate)
  168. (helm-elisp--persistent-help
  169. candidate 'helm-describe-function))
  170. (defun helm-M-x-read-extended-command (collection &optional history)
  171. "Read command name to invoke in `helm-M-x'.
  172. Helm completion is not provided when executing or defining
  173. kbd macros.
  174. Optional arg COLLECTION is to allow using another COLLECTION
  175. than the default which is OBARRAY."
  176. (if (or defining-kbd-macro executing-kbd-macro)
  177. (if helm-mode
  178. (unwind-protect
  179. (progn
  180. (helm-mode -1)
  181. (read-extended-command))
  182. (helm-mode 1))
  183. (read-extended-command))
  184. (let* ((helm-fuzzy-sort-fn helm-M-x-default-sort-fn)
  185. (helm--mode-line-display-prefarg t)
  186. (tm (run-at-time 1 0.1 'helm-M-x--notify-prefix-arg))
  187. (helm-move-selection-after-hook
  188. (cons (lambda () (setq current-prefix-arg nil))
  189. helm-move-selection-after-hook))
  190. (extended-command-history
  191. (cl-loop for c in extended-command-history
  192. when (and c (commandp (intern c)))
  193. do (set-text-properties 0 (length c) nil c)
  194. and collect c))
  195. (minibuffer-completion-confirm t)
  196. (sources (and helm-M-x-use-completion-styles
  197. `(,(helm-build-sync-source "Emacs Commands history"
  198. :candidates (helm-dynamic-completion
  199. (or history extended-command-history)
  200. #'commandp
  201. nil nil t)
  202. :match-dynamic t
  203. :requires-pattern helm-M-x-requires-pattern
  204. :must-match t
  205. :persistent-action
  206. 'helm-M-x-persistent-action
  207. :persistent-help "Describe this command"
  208. :help-message 'helm-M-x-help-message
  209. :nomark t
  210. :group 'helm-command
  211. :keymap helm-M-x-map
  212. :filtered-candidate-transformer
  213. 'helm-M-x-transformer-no-sort)
  214. ,(helm-build-sync-source "Emacs Commands"
  215. :candidates (helm-dynamic-completion
  216. collection #'commandp
  217. nil nil t)
  218. :match-dynamic t
  219. :requires-pattern helm-M-x-requires-pattern
  220. :must-match t
  221. :filtered-candidate-transformer
  222. 'helm-M-x-transformer
  223. :persistent-action
  224. 'helm-M-x-persistent-action
  225. :persistent-help "Describe this command"
  226. :help-message 'helm-M-x-help-message
  227. :nomark t
  228. :group 'helm-command
  229. :keymap helm-M-x-map))))
  230. (prompt (concat (cond
  231. ((eq helm-M-x-prefix-argument '-) "- ")
  232. ((and (consp helm-M-x-prefix-argument)
  233. (eq (car helm-M-x-prefix-argument) 4)) "C-u ")
  234. ((and (consp helm-M-x-prefix-argument)
  235. (integerp (car helm-M-x-prefix-argument)))
  236. (format "%d " (car helm-M-x-prefix-argument)))
  237. ((integerp helm-M-x-prefix-argument)
  238. (format "%d " helm-M-x-prefix-argument)))
  239. "M-x ")))
  240. (when (and sources helm-M-x-reverse-history)
  241. (setq sources (nreverse sources)))
  242. (unwind-protect
  243. (progn
  244. (setq current-prefix-arg nil)
  245. (if sources
  246. ;; Use dynamic-matching and `completion-styles'.
  247. (helm :sources sources
  248. :prompt prompt
  249. :buffer "*helm M-x*"
  250. :history 'helm-M-x-input-history)
  251. ;; Use helm matching through `helm-comp-read'.
  252. (helm-comp-read
  253. prompt
  254. (or collection obarray)
  255. :test 'commandp
  256. :requires-pattern helm-M-x-requires-pattern
  257. :name "Emacs Commands"
  258. :buffer "*helm M-x*"
  259. :persistent-action (lambda (candidate)
  260. (helm-elisp--persistent-help
  261. candidate 'helm-describe-function))
  262. :persistent-help "Describe this command"
  263. :history (or history extended-command-history)
  264. :reverse-history helm-M-x-reverse-history
  265. :input-history 'helm-M-x-input-history
  266. :del-input nil
  267. :help-message 'helm-M-x-help-message
  268. :group 'helm-command
  269. :keymap helm-M-x-map
  270. :must-match t
  271. :match-part (lambda (c) (car (split-string c)))
  272. :fuzzy helm-M-x-fuzzy-match
  273. :nomark t
  274. :candidates-in-buffer t
  275. :fc-transformer 'helm-M-x-transformer
  276. :hist-fc-transformer 'helm-M-x-transformer-no-sort)))
  277. (cancel-timer tm)
  278. (setq helm--mode-line-display-prefarg nil)))))
  279. ;;;###autoload
  280. (defun helm-M-x (_arg &optional command-name)
  281. "Preconfigured `helm' for Emacs commands.
  282. It is `helm' replacement of regular `M-x' `execute-extended-command'.
  283. Unlike regular `M-x' emacs vanilla `execute-extended-command' command,
  284. the prefix args if needed, can be passed AFTER starting `helm-M-x'.
  285. When a prefix arg is passed BEFORE starting `helm-M-x', the first `C-u'
  286. while in `helm-M-x' session will disable it.
  287. You can get help on each command by persistent action."
  288. (interactive
  289. (progn
  290. (setq helm-M-x-prefix-argument current-prefix-arg)
  291. (list current-prefix-arg (helm-M-x-read-extended-command obarray))))
  292. (when (stringp command-name)
  293. (unless (string= command-name "")
  294. (let ((sym-com (and (stringp command-name) (intern-soft command-name))))
  295. (when sym-com
  296. ;; Avoid having `this-command' set to *exit-minibuffer.
  297. (setq this-command sym-com
  298. ;; Handle C-x z (repeat) Issue #322
  299. real-this-command sym-com)
  300. ;; If helm-M-x is called with regular emacs completion (kmacro)
  301. ;; use the value of arg otherwise use helm-current-prefix-arg.
  302. (let ((prefix-arg (or helm-current-prefix-arg helm-M-x-prefix-argument)))
  303. (cl-flet ((save-hist (command)
  304. (setq extended-command-history
  305. (cons command (delete command extended-command-history)))))
  306. (condition-case-unless-debug err
  307. (progn
  308. (command-execute sym-com 'record)
  309. (save-hist command-name))
  310. (error
  311. (when helm-M-x-always-save-history
  312. (save-hist command-name))
  313. (signal (car err) (cdr err)))))))))))
  314. (put 'helm-M-x 'interactive-only 'command-execute)
  315. (provide 'helm-command)
  316. ;; Local Variables:
  317. ;; byte-compile-warnings: (not obsolete)
  318. ;; coding: utf-8
  319. ;; indent-tabs-mode: nil
  320. ;; End:
  321. ;;; helm-command.el ends here