.emacs.d.git - Gitblit

Chizi123

2018-11-18 76bbd07de7add0f9d13c6914f158d19630fe2f62

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