.emacs.d.git - Gitblit

Chizi123

2018-11-17 c4001ccd1864293b64aa37d83a9d9457eb875e70

commit \| author \| age
5cb5f7	1	;;; helm-elisp.el --- Elisp symbols completion for helm. -- 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	(require 'cl-lib)
	20	(require 'helm)
	21	(require 'helm-lib)
	22	(require 'helm-help)
	23	(require 'helm-types)
	24	(require 'helm-utils)
	25	(require 'helm-info)
	26	(require 'helm-eval)
	27	(require 'helm-files)
	28
	29	(declare-function 'helm-describe-function "helm-lib")
	30	(declare-function 'helm-describe-variable "helm-lib")
	31	(declare-function 'helm-describe-face "helm-lib")
	32
	33
	34	;;; Customizable values
	35
	36	(defgroup helm-elisp nil
	37	"Elisp related Applications and libraries for Helm."
	38	:group 'helm)
	39
	40	(defcustom helm-turn-on-show-completion t
	41	"Display candidate in `current-buffer' while moving selection when non--nil."
	42	:group 'helm-elisp
	43	:type 'boolean)
	44
	45	(defcustom helm-show-completion-min-window-height 7
	46	"Minimum completion window height used in show completion.
	47	This is used in macro `with-helm-show-completion'."
	48	:group 'helm-elisp
	49	:type 'integer)
	50
	51	(defcustom helm-lisp-quoted-function-list
	52	'(funcall apply mapc cl-mapc mapcar cl-mapcar
	53	callf callf2 cl-callf cl-callf2 fset
	54	fboundp fmakunbound symbol-function)
	55	"List of function where quoted function completion happen.
	56	e.g give only function names after \(funcall '."
	57	:group 'helm-elisp
	58	:type '(repeat (choice symbol)))
	59
	60	(defcustom helm-lisp-unquoted-function-list
	61	'(function defadvice)
	62	"List of function where unquoted function completion happen.
	63	e.g give only function names after \(function ."
	64	:group 'helm-elisp
	65	:type '(repeat (choice symbol)))
	66
	67	(defcustom helm-apropos-fuzzy-match nil
	68	"Enable fuzzy matching for `helm-apropos' when non-nil."
	69	:group 'helm-elisp
	70	:type 'boolean)
	71
	72	(defcustom helm-lisp-fuzzy-completion nil
	73	"Enable fuzzy matching in emacs-lisp completion when non-nil.
	74	NOTE: This enable fuzzy matching in helm native implementation of
	75	elisp completion, but not on helmized elisp completion, i.e
	76	fuzzy completion is not available in `completion-at-point'."
	77	:group 'helm-elisp
	78	:type 'boolean)
	79
	80	(defcustom helm-apropos-function-list '(helm-def-source--emacs-commands
	81	helm-def-source--emacs-functions
	82	helm-def-source--eieio-classes
	83	helm-def-source--eieio-generic
	84	helm-def-source--emacs-variables
	85	helm-def-source--emacs-faces)
	86	"A list of functions that build helm sources to use in `helm-apropos'."
	87	:group 'helm-elisp
	88	:type '(repeat (choice symbol)))
	89
	90	(defcustom helm-apropos-defaut-info-lookup-sources '(helm-source-info-elisp
	91	helm-source-info-cl
	92	helm-source-info-eieio)
	93	"A list of sources to look into when searching info page of a symbol."
	94	:group 'helm-elisp
	95	:type '(repeat (choice symbol)))
	96
	97	(defcustom helm-show-completion-display-function
	98	(if (display-graphic-p)
	99	#'helm-display-buffer-in-own-frame
	100	#'helm-show-completion-default-display-function)
	101	"The function used to display helm completion buffer.
	102
	103	This function is used by `with-helm-show-completion', when nil
	104	fallback to `helm-default-display-buffer'.
	105
	106	Default is to use a separate frame on graphic display and
	107	`helm-show-completion-default-display-function' on non graphic
	108	display."
	109	:group 'helm-elisp
	110	:type 'function)
	111
	112	;;; Faces
	113	;;
	114	;;
	115	(defgroup helm-elisp-faces nil
	116	"Customize the appearance of helm-elisp."
	117	:prefix "helm-"
	118	:group 'helm-elisp
	119	:group 'helm-faces)
	120
	121	(defface helm-lisp-show-completion
	122	'((t (:background "DarkSlateGray")))
	123	"Face used for showing candidates in `helm-lisp-completion'."
	124	:group 'helm-elisp-faces)
	125
	126	(defface helm-lisp-completion-info
	127	'((t (:foreground "red")))
	128	"Face used for showing info in `helm-lisp-completion'."
	129	:group 'helm-elisp-faces)
	130
	131	(defcustom helm-elisp-help-function
	132	'helm-elisp-show-help
	133	"Function for displaying help for Lisp symbols."
	134	:group 'helm-elisp
	135	:type '(choice (function :tag "Open help for the symbol."
	136	helm-elisp-show-help)
	137	(function :tag "Show one liner in modeline."
	138	helm-elisp-show-doc-modeline)))
	139
	140	(defcustom helm-locate-library-fuzzy-match t
	141	"Enable fuzzy-matching in `helm-locate-library' when non--nil."
	142	:type 'boolean
	143	:group 'helm-elisp)
	144
	145
	146	;;; Show completion.
	147	;;
	148	;; Provide show completion with macro `with-helm-show-completion'.
	149
	150	(defvar helm-show-completion-overlay nil)
	151
	152	;; Called each time cursor move in helm-buffer.
	153	(defun helm-show-completion ()
	154	(with-helm-current-buffer
	155	(overlay-put helm-show-completion-overlay
	156	'display (substring-no-properties
	157	(helm-get-selection)))))
	158
	159	(defun helm-show-completion-init-overlay (beg end)
	160	(setq helm-show-completion-overlay (make-overlay beg end))
	161	(overlay-put helm-show-completion-overlay
	162	'face 'helm-lisp-show-completion))
	163
	164	(defun helm-show-completion-default-display-function (buffer &rest _args)
	165	"A special resized helm window is used depending on position in BUFFER."
	166	(with-selected-window (selected-window)
	167	(if (window-dedicated-p)
	168	(helm-default-display-buffer buffer)
	169	(let* ((screen-size (+ (count-screen-lines (window-start) (point) t)
	170	1 ; mode-line
	171	(if header-line-format 1 0))) ; header-line
	172	(def-size (- (window-height)
	173	helm-show-completion-min-window-height))
	174	(upper-height (max window-min-height (min screen-size def-size)))
	175	split-window-keep-point)
	176	(recenter -1)
	177	(set-window-buffer (if (active-minibuffer-window)
	178	(minibuffer-selected-window)
	179	(split-window nil upper-height
	180	helm-split-window-default-side))
	181	buffer)))))
	182
	183	(defmacro with-helm-show-completion (beg end &rest body)
	184	"Show helm candidate in an overlay at point.
	185	BEG and END are the beginning and end position of the current completion
	186	in `helm-current-buffer'.
	187	BODY is an helm call where we want to enable show completion.
	188	If `helm-turn-on-show-completion' is nil do nothing."
	189	(declare (indent 2) (debug t))
	190	`(unwind-protect
	191	(if helm-turn-on-show-completion
	192	(let ((helm-move-selection-after-hook
	193	(append (list 'helm-show-completion)
	194	helm-move-selection-after-hook))
	195	(helm-split-window-default-side
	196	(if (eq helm-split-window-default-side 'same)
	197	'below helm-split-window-default-side))
	198	helm-split-window-inside-p
	199	helm-reuse-last-window-split-state)
	200	(helm-set-local-variable
	201	'helm-display-function
	202	(or helm-show-completion-display-function
	203	'helm-default-display-buffer))
	204	(helm-show-completion-init-overlay ,beg ,end)
	205	,@body)
	206	,@body)
	207	(when (and helm-show-completion-overlay
	208	(overlayp helm-show-completion-overlay))
	209	(delete-overlay helm-show-completion-overlay))))
	210
	211
	212	;;; Lisp symbol completion.
	213	;;
	214	;;
	215	(defun helm-lisp-completion--predicate-at-point (beg)
	216	;; Return a predicate for `all-completions'.
	217	(let ((fn-sym-p (lambda ()
	218	(or
	219	(and (eq (char-before) ?\ )
	220	(save-excursion
	221	(skip-syntax-backward " " (point-at-bol))
	222	(memq (symbol-at-point)
	223	helm-lisp-unquoted-function-list)))
	224	(and (eq (char-before) ?\')
	225	(save-excursion
	226	(forward-char -1)
	227	(eq (char-before) ?\#)))))))
	228	(save-excursion
	229	(goto-char beg)
	230	(if (or
	231	;; Complete on all symbols in non--lisp modes (logs mail etc..)
	232	(not (memq major-mode '(emacs-lisp-mode
	233	lisp-interaction-mode
	234	inferior-emacs-lisp-mode)))
	235	(not (or (funcall fn-sym-p)
	236	(and (eq (char-before) ?\')
	237	(save-excursion
	238	(forward-char (if (funcall fn-sym-p) -2 -1))
	239	(skip-syntax-backward " " (point-at-bol))
	240	(memq (symbol-at-point)
	241	helm-lisp-quoted-function-list)))
	242	(eq (char-before) ?\())) ; no paren before str.
	243	;; Looks like we are in a let statement.
	244	(condition-case nil
	245	(progn (up-list -2) (forward-char 1)
	246	(eq (char-after) ?\())
	247	(error nil)))
	248	(lambda (sym)
	249	(or (boundp sym) (fboundp sym) (symbol-plist sym)))
	250	#'fboundp))))
	251
	252	(defun helm-thing-before-point (&optional limits regexp)
	253	"Return symbol name before point.
	254	If REGEXP is specified return what REGEXP find before point.
	255	By default match the beginning of symbol before point.
	256	With LIMITS arg specified return the beginning and end position
	257	of symbol before point."
	258	(save-excursion
	259	(let (beg
	260	(end (point))
	261	(boundary (field-beginning nil nil (point-at-bol))))
	262	(if (re-search-backward (or regexp "\\_<") boundary t)
	263	(setq beg (match-end 0))
	264	(setq beg boundary))
	265	(unless (= beg end)
	266	(if limits
	267	(cons beg end)
	268	(buffer-substring-no-properties beg end))))))
	269
	270	(defun helm-bounds-of-thing-before-point (&optional regexp)
	271	"Get the beginning and end position of `helm-thing-before-point'.
	272	Return a cons \(beg . end\)."
	273	(helm-thing-before-point 'limits regexp))
	274
	275	(defun helm-insert-completion-at-point (beg end str)
	276	;; When there is no space after point
	277	;; we are completing inside a symbol or
	278	;; after a partial symbol with the next arg aside
	279	;; without space, in this case mark the region.
	280	;; deleting it would remove the
	281	;; next arg which is unwanted.
	282	(delete-region beg end)
	283	(insert str)
	284	(let ((pos (cdr (or (bounds-of-thing-at-point 'symbol)
	285	;; needed for helm-dabbrev.
	286	(bounds-of-thing-at-point 'filename)))))
	287	(when (and pos (< (point) pos))
	288	(push-mark pos t t))))
	289
	290	(defvar helm-lisp-completion--cache nil)
	291	(defvar helm-lgst-len nil)
	292	;;;###autoload
	293	(defun helm-lisp-completion-at-point ()
	294	"Preconfigured helm for lisp symbol completion at point."
	295	(interactive)
	296	(setq helm-lgst-len 0)
	297	(let* ((target (helm-thing-before-point))
	298	(beg (car (helm-bounds-of-thing-before-point)))
	299	(end (point))
	300	(pred (and beg (helm-lisp-completion--predicate-at-point beg)))
	301	(loc-vars (and (fboundp 'elisp--local-variables)
	302	(ignore-errors
	303	(mapcar #'symbol-name (elisp--local-variables)))))
	304	(glob-syms (and target pred (all-completions target obarray pred)))
	305	(candidates (append loc-vars glob-syms))
	306	(helm-quit-if-no-candidate t)
	307	(helm-execute-action-at-once-if-one t)
	308	(enable-recursive-minibuffers t))
	309	(setq helm-lisp-completion--cache (cl-loop for sym in candidates
	310	for len = (length sym)
	311	when (> len helm-lgst-len)
	312	do (setq helm-lgst-len len)
	313	collect sym))
	314	(if candidates
	315	(with-helm-show-completion beg end
	316	;; Overlay is initialized now in helm-current-buffer.
	317	(helm
	318	:sources (helm-build-in-buffer-source "Lisp completion"
	319	:data helm-lisp-completion--cache
	320	:persistent-action `(helm-lisp-completion-persistent-action .
	321	,(and (eq helm-elisp-help-function
	322	'helm-elisp-show-doc-modeline)
	323	'never-split))
	324	:nomark t
	325	:match-part (lambda (c) (car (split-string c)))
	326	:fuzzy-match helm-lisp-fuzzy-completion
	327	:persistent-help (helm-lisp-completion-persistent-help)
	328	:filtered-candidate-transformer
	329	'helm-lisp-completion-transformer
	330	:action (lambda (candidate)
	331	(with-helm-current-buffer
	332	(run-with-timer
	333	0.01 nil
	334	'helm-insert-completion-at-point
	335	beg end candidate))))
	336	:input (if helm-lisp-fuzzy-completion
	337	target (concat target " "))
	338	:resume 'noresume
	339	:truncate-lines t
	340	:buffer "helm lisp completion"
	341	:allow-nest t))
	342	(message "[No Match]"))))
	343
	344	(defun helm-lisp-completion-persistent-action (candidate &optional name)
	345	"Show documentation for the function.
	346	Documentation is shown briefly in mode-line or completely
	347	in other window according to the value of `helm-elisp-help-function'."
	348	(funcall helm-elisp-help-function candidate name))
	349
	350	(defun helm-lisp-completion-persistent-help ()
	351	"Return persistent-help according to the value of `helm-elisp-help-function'"
	352	(cl-ecase helm-elisp-help-function
	353	(helm-elisp-show-doc-modeline "Show brief doc in mode-line")
	354	(helm-elisp-show-help "Toggle show help for the symbol")))
	355
	356	(defun helm-elisp--show-help-1 (candidate &optional name)
	357	(let ((sym (intern-soft candidate)))
	358	(cl-typecase sym
	359	((and fboundp boundp)
	360	(if (member name '("describe-function" "describe-variable"))
	361	(funcall (intern (format "helm-%s" name)) sym)
	362	;; When there is no way to know what to describe
	363	;; prefer describe-function.
	364	(helm-describe-function sym)))
	365	(fbound (helm-describe-function sym))
	366	(bound (helm-describe-variable sym))
	367	(face (helm-describe-face sym)))))
	368
	369	(defun helm-elisp-show-help (candidate &optional name)
	370	"Show full help for the function CANDIDATE.
	371	Arg NAME specify the name of the top level function
	372	calling helm generic completion (e.g \"describe-function\")
	373	which allow calling the right function when CANDIDATE symbol
	374	refers at the same time to variable and a function."
	375	(helm-elisp--persistent-help
	376	candidate 'helm-elisp--show-help-1 name))
	377
	378	(defun helm-elisp-show-doc-modeline (candidate &optional name)
	379	"Show brief documentation for the function in modeline."
	380	(let ((cursor-in-echo-area t)
	381	mode-line-in-non-selected-windows)
	382	(helm-show-info-in-mode-line
	383	(propertize
	384	(helm-get-first-line-documentation
	385	(intern candidate) name)
	386	'face 'helm-lisp-completion-info))))
	387
	388	(defun helm-lisp-completion-transformer (candidates _source)
	389	"Helm candidates transformer for lisp completion."
	390	(cl-loop for c in candidates
	391	for sym = (intern c)
	392	for annot = (cl-typecase sym
	393	(command " (Com)")
	394	(class " (Class)")
	395	(generic " (Gen)")
	396	(fbound " (Fun)")
	397	(bound " (Var)")
	398	(face " (Face)"))
	399	for spaces = (make-string (- helm-lgst-len (length c)) ? )
	400	collect (cons (concat c spaces annot) c) into lst
	401	finally return (sort lst #'helm-generic-sort-fn)))
	402
	403	(defun helm-get-first-line-documentation (sym &optional name)
	404	"Return first line documentation of symbol SYM.
	405	If SYM is not documented, return \"Not documented\"."
	406	(let ((doc (cl-typecase sym
	407	((and fboundp boundp)
	408	(cond ((string= name "describe-function")
	409	(documentation sym t))
	410	((string= name "describe-variable")
	411	(documentation-property sym 'variable-documentation t))
	412	(t (documentation sym t))))
	413	(fbound (documentation sym t))
	414	(bound (documentation-property sym 'variable-documentation t))
	415	(face (face-documentation sym)))))
	416	(if (and doc (not (string= doc ""))
	417	;; `documentation' return "\n\n(args...)"
	418	;; for CL-style functions.
	419	(not (string-match-p "^\n\n" doc)))
	420	(car (split-string doc "\n"))
	421	"Not documented")))
	422
	423	;;; File completion.
	424	;;
	425	;; Complete file name at point.
	426
	427	;;;###autoload
	428	(defun helm-complete-file-name-at-point (&optional force)
	429	"Preconfigured helm to complete file name at point."
	430	(interactive)
	431	(require 'helm-mode)
	432	(let* ((tap (thing-at-point 'filename))
	433	beg
	434	(init (and tap
	435	(or force
	436	(save-excursion
	437	(end-of-line)
	438	(search-backward tap (point-at-bol) t)
	439	(setq beg (point))
	440	(looking-back "[^'`( ]" (1- (point)))))
	441	(expand-file-name
	442	(substring-no-properties tap))))
	443	(end (point))
	444	(helm-quit-if-no-candidate t)
	445	(helm-execute-action-at-once-if-one t)
	446	completion)
	447	(with-helm-show-completion beg end
	448	(setq completion (helm-read-file-name "FileName: "
	449	:initial-input init)))
	450	(when (and completion (not (string= completion "")))
	451	(delete-region beg end) (insert (if (string-match "^~" tap)
	452	(abbreviate-file-name completion)
	453	completion)))))
	454
	455	;;;###autoload
	456	(defun helm-lisp-indent ()
	457	;; It is meant to use with `helm-define-multi-key' which
	458	;; does not support args for functions yet, so use `current-prefix-arg'
	459	;; for now instead of (interactive "P").
	460	(interactive)
	461	(let ((tab-always-indent (or (eq tab-always-indent 'complete)
	462	tab-always-indent)))
	463	(indent-for-tab-command current-prefix-arg)))
	464
	465	;;;###autoload
	466	(defun helm-lisp-completion-or-file-name-at-point ()
	467	"Preconfigured helm to complete lisp symbol or filename at point.
	468	Filename completion happen if string start after or between a double quote."
	469	(interactive)
	470	(let* ((tap (thing-at-point 'filename)))
	471	(if (and tap (save-excursion
	472	(end-of-line)
	473	(search-backward tap (point-at-bol) t)
	474	(looking-back "[^'`( ]" (1- (point)))))
	475	(helm-complete-file-name-at-point)
	476	(helm-lisp-completion-at-point))))
	477
	478
	479	;;; Apropos
	480	;;
	481	;;
	482	(defvar helm-apropos-history nil)
	483
	484	(defun helm-apropos-init (test default)
	485	"Init candidates buffer for `helm-apropos' sources."
	486	(require 'helm-help)
	487	(helm-init-candidates-in-buffer 'global
	488	(let ((default-symbol (and (stringp default)
	489	(intern-soft default)))
	490	(symbols (all-completions "" obarray test)))
	491	(if (and default-symbol (funcall test default-symbol))
	492	(cons default-symbol symbols)
	493	symbols))))
	494
	495	(defun helm-apropos-init-faces (default)
	496	"Init candidates buffer for faces for `helm-apropos'."
	497	(require 'helm-help)
	498	(with-current-buffer (helm-candidate-buffer 'global)
	499	(goto-char (point-min))
	500	(let ((default-symbol (and (stringp default)
	501	(intern-soft default)))
	502	(faces (face-list)))
	503	(when (and default-symbol (facep default-symbol))
	504	(insert (concat default "\n")))
	505	(insert
	506	(mapconcat #'prin1-to-string
	507	(if default
	508	(cl-remove-if (lambda (sym) (string= sym default)) faces)
	509	faces)
	510	"\n")))))
	511
	512	(defun helm-apropos-default-sort-fn (candidates _source)
	513	(if (string= helm-pattern "")
	514	candidates
	515	(sort candidates #'helm-generic-sort-fn)))
	516
	517	(defun helm-apropos-clean-history-variable (candidate)
	518	(with-helm-current-buffer ; var is maybe local
	519	(let* ((sym (intern-soft candidate))
	520	(cands (symbol-value sym))
	521	(mkds (and (listp cands)
	522	(helm-comp-read "Delete entry: "
	523	cands :marked-candidates t))))
	524	(cl-assert (listp mkds) nil "Variable value is not a list")
	525	(cl-loop for elm in mkds do
	526	(if (local-variable-p sym)
	527	(set (make-local-variable sym)
	528	(setq cands (delete elm cands)))
	529	(set sym (setq cands (delete elm cands))))))))
	530
	531	(defun helm-apropos-clean-ring (candidate)
	532	(with-helm-current-buffer ; var is maybe local
	533	(let* ((sym (intern-soft candidate))
	534	(val (symbol-value sym))
	535	(cands (and (ring-p val) (ring-elements val)))
	536	(mkds (and cands (helm-comp-read
	537	"Delete entry: "
	538	cands :marked-candidates t))))
	539	(when mkds
	540	(cl-loop for elm in mkds do
	541	(ring-remove
	542	val (helm-position
	543	elm
	544	(ring-elements val)
	545	:test 'equal))
	546	and do (if (local-variable-p sym)
	547	(set (make-local-variable sym) val)
	548	(set sym val)))))))
	549
	550	(defun helm-apropos-action-transformer (actions candidate)
	551	(let* ((sym (helm-symbolify candidate))
	552	(val (with-helm-current-buffer (symbol-value sym))))
	553	(cond ((custom-variable-p sym)
	554	(append
	555	actions
	556	(let ((standard-value (eval (car (get sym 'standard-value)))))
	557	(unless (equal standard-value (symbol-value sym))
	558	`(("Reset Variable to default value"
	559	. ,(lambda (candidate)
	560	(let ((sym (helm-symbolify candidate)))
	561	(set sym standard-value)))))))
	562	'(("Customize variable" .
	563	(lambda (candidate)
	564	(customize-option (helm-symbolify candidate)))))))
	565	((and val (with-helm-current-buffer (ring-p (symbol-value sym))))
	566	(append actions
	567	'(("Clean ring" . helm-apropos-clean-ring))))
	568	((and (string-match-p "history" candidate) (listp val))
	569	(append actions
	570	'(("Clean variable" .
	571	helm-apropos-clean-history-variable))))
	572	(t actions))))
	573
	574	(defun helm-def-source--emacs-variables (&optional default)
	575	(helm-build-in-buffer-source "Variables"
	576	:init (lambda ()
	577	(helm-apropos-init
	578	(lambda (x) (and (boundp x) (not (keywordp x)))) default))
	579	:fuzzy-match helm-apropos-fuzzy-match
	580	:filtered-candidate-transformer (and (null helm-apropos-fuzzy-match)
	581	'helm-apropos-default-sort-fn)
	582	:nomark t
	583	:persistent-action (lambda (candidate)
	584	(helm-elisp--persistent-help
	585	candidate 'helm-describe-variable))
	586	:persistent-help "Toggle describe variable"
	587	:action '(("Describe variable" . helm-describe-variable)
	588	("Find variable" . helm-find-variable)
	589	("Info lookup" . helm-info-lookup-symbol)
	590	("Set variable" . helm-set-variable))
	591	:action-transformer 'helm-apropos-action-transformer))
	592
	593	(defun helm-def-source--emacs-faces (&optional default)
	594	"Create `helm' source for faces to be displayed with
	595	`helm-apropos'."
	596	(helm-build-in-buffer-source "Faces"
	597	:init (lambda () (helm-apropos-init-faces default))
	598	:fuzzy-match helm-apropos-fuzzy-match
	599	:filtered-candidate-transformer
	600	(append (and (null helm-apropos-fuzzy-match)
	601	'(helm-apropos-default-sort-fn))
	602	(list
	603	(lambda (candidates _source)
	604	(cl-loop for c in candidates
	605	collect (propertize c 'face (intern c))))))
	606	:persistent-action (lambda (candidate)
	607	(helm-elisp--persistent-help
	608	candidate 'helm-describe-face))
	609	:persistent-help "Toggle describe face"
	610	:action '(("Describe face" . helm-describe-face)
	611	("Find face" . helm-find-face-definition)
	612	("Customize face" . (lambda (candidate)
	613	(customize-face (helm-symbolify candidate)))))))
	614
	615	(defun helm-def-source--emacs-commands (&optional default)
	616	(helm-build-in-buffer-source "Commands"
	617	:init (lambda ()
	618	(helm-apropos-init 'commandp default))
	619	:fuzzy-match helm-apropos-fuzzy-match
	620	:filtered-candidate-transformer (and (null helm-apropos-fuzzy-match)
	621	'helm-apropos-default-sort-fn)
	622	:nomark t
	623	:persistent-action (lambda (candidate)
	624	(helm-elisp--persistent-help
	625	candidate 'helm-describe-function))
	626	:persistent-help "Toggle describe command"
	627	:action '(("Describe function" . helm-describe-function)
	628	("Find function" . helm-find-function)
	629	("Info lookup" . helm-info-lookup-symbol))))
	630
	631	(defun helm-def-source--emacs-functions (&optional default)
	632	(helm-build-in-buffer-source "Functions"
	633	:init (lambda ()
	634	(helm-apropos-init (lambda (x)
	635	(and (fboundp x)
	636	(not (commandp x))
	637	(not (generic-p x))
	638	(not (class-p x))))
	639	default))
	640	:fuzzy-match helm-apropos-fuzzy-match
	641	:filtered-candidate-transformer (and (null helm-apropos-fuzzy-match)
	642	'helm-apropos-default-sort-fn)
	643	:persistent-action (lambda (candidate)
	644	(helm-elisp--persistent-help
	645	candidate 'helm-describe-function))
	646	:persistent-help "Toggle describe function"
	647	:nomark t
	648	:action '(("Describe function" . helm-describe-function)
	649	("Find function" . helm-find-function)
	650	("Info lookup" . helm-info-lookup-symbol))))
	651
	652	(defun helm-def-source--eieio-classes (&optional default)
	653	(helm-build-in-buffer-source "Classes"
	654	:init (lambda ()
	655	(helm-apropos-init (lambda (x)
	656	(class-p x))
	657	default))
	658	:fuzzy-match helm-apropos-fuzzy-match
	659	:filtered-candidate-transformer (and (null helm-apropos-fuzzy-match)
	660	'helm-apropos-default-sort-fn)
	661	:nomark t
	662	:persistent-action (lambda (candidate)
	663	(helm-elisp--persistent-help
	664	candidate 'helm-describe-function))
	665	:persistent-help "Toggle describe class"
	666	:action '(("Describe function" . helm-describe-function)
	667	("Find function" . helm-find-function)
	668	("Info lookup" . helm-info-lookup-symbol))))
	669
	670	(defun helm-def-source--eieio-generic (&optional default)
	671	(helm-build-in-buffer-source "Generic functions"
	672	:init (lambda ()
	673	(helm-apropos-init (lambda (x)
	674	(generic-p x))
	675	default))
	676	:fuzzy-match helm-apropos-fuzzy-match
	677	:filtered-candidate-transformer (and (null helm-apropos-fuzzy-match)
	678	'helm-apropos-default-sort-fn)
	679	:nomark t
	680	:persistent-action (lambda (candidate)
	681	(helm-elisp--persistent-help
	682	candidate 'helm-describe-function))
	683	:persistent-help "Toggle describe generic function"
	684	:action '(("Describe function" . helm-describe-function)
	685	("Find function" . helm-find-function)
	686	("Info lookup" . helm-info-lookup-symbol))))
	687
	688	(defun helm-info-lookup-fallback-source (candidate)
	689	(let ((sym (helm-symbolify candidate))
	690	src-name fn)
	691	(cond ((class-p sym)
	692	(setq fn #'helm-describe-function
	693	src-name "Describe class"))
	694	((generic-p sym)
	695	(setq fn #'helm-describe-function
	696	src-name "Describe generic function"))
	697	((fboundp sym)
	698	(setq fn #'helm-describe-function
	699	src-name "Describe function"))
	700	((facep sym)
	701	(setq fn #'helm-describe-face
	702	src-name "Describe face"))
	703	(t
	704	(setq fn #'helm-describe-variable
	705	src-name "Describe variable")))
	706	(helm-build-sync-source src-name
	707	:candidates (list candidate)
	708	:persistent-action (lambda (candidate)
	709	(helm-elisp--persistent-help
	710	candidate fn))
	711	:persistent-help src-name
	712	:nomark t
	713	:action fn)))
	714
	715	(defun helm-info-lookup-symbol-1 (c)
	716	(let ((helm-execute-action-at-once-if-one 'current-source))
	717	(helm :sources (append helm-apropos-defaut-info-lookup-sources
	718	(list (helm-info-lookup-fallback-source c)))
	719	:resume 'noresume
	720	:buffer "helm lookup"
	721	:input c)))
	722
	723	(defun helm-info-lookup-symbol (candidate)
	724	;; ???:Running an idle-timer allows not catching RET when exiting
	725	;; with the fallback source.
	726	;; (run-with-idle-timer 0.01 nil #'helm-info-lookup-symbol-1 candidate)
	727	(helm-info-lookup-symbol-1 candidate))
	728
	729	;;;###autoload
	730	(defun helm-apropos (default)
	731	"Preconfigured helm to describe commands, functions, variables and faces.
	732	In non interactives calls DEFAULT argument should be provided as a string,
	733	i.e the `symbol-name' of any existing symbol."
	734	(interactive (list (thing-at-point 'symbol)))
	735	(helm :sources
	736	(mapcar (lambda (func)
	737	(funcall func default))
	738	helm-apropos-function-list)
	739	:history 'helm-apropos-history
	740	:buffer "helm apropos"
	741	:preselect (and default (concat "\\_<" (regexp-quote default) "\\_>"))))
	742
	743
	744	;;; Advices
	745	;;
	746	;;
	747	(defvar helm-source-advice
	748	(helm-build-sync-source "Function Advice"
	749	:init (lambda () (require 'advice))
	750	:candidates 'helm-advice-candidates
	751	:action (helm-make-actions "Toggle Enable/Disable" 'helm-advice-toggle)
	752	:persistent-action 'helm-advice-persistent-action
	753	:nomark t
	754	:multiline t
	755	:persistent-help "Toggle describe function / C-u C-j: Toggle advice"))
	756
	757	(defun helm-advice-candidates ()
	758	(cl-loop for (fname) in ad-advised-functions
	759	for function = (intern fname)
	760	append
	761	(cl-loop for class in ad-advice-classes append
	762	(cl-loop for advice in (ad-get-advice-info-field function class)
	763	for enabled = (ad-advice-enabled advice)
	764	collect
	765	(cons (format
	766	"%s %s %s"
	767	(if enabled "Enabled " "Disabled")
	768	(propertize fname 'face 'font-lock-function-name-face)
	769	(ad-make-single-advice-docstring advice class nil))
	770	(list function class advice))))))
	771
	772	(defun helm-advice-persistent-action (func-class-advice)
	773	(if current-prefix-arg
	774	(helm-advice-toggle func-class-advice)
	775	(describe-function (car func-class-advice))))
	776
	777	(defun helm-advice-toggle (func-class-advice)
	778	(cl-destructuring-bind (function _class advice) func-class-advice
	779	(cond ((ad-advice-enabled advice)
	780	(ad-advice-set-enabled advice nil)
	781	(message "Disabled"))
	782	(t
	783	(ad-advice-set-enabled advice t)
	784	(message "Enabled")))
	785	(ad-activate function)
	786	(and helm-in-persistent-action
	787	(helm-advice-update-current-display-string))))
	788
	789	(defun helm-advice-update-current-display-string ()
	790	(helm-edit-current-selection
	791	(let ((newword (cond ((looking-at "Disabled") "Enabled")
	792	((looking-at "Enabled") "Disabled"))))
	793	(when newword
	794	(delete-region (point) (progn (forward-word 1) (point)))
	795	(insert newword)))))
	796
	797	;;;###autoload
	798	(defun helm-manage-advice ()
	799	"Preconfigured `helm' to disable/enable function advices."
	800	(interactive)
	801	(helm-other-buffer 'helm-source-advice "helm advice"))
	802
	803
	804	;;; Locate elisp library
	805	;;
	806	;;
	807	(defun helm-locate-library-scan-list ()
	808	(cl-loop for dir in load-path
	809	with load-suffixes = '(".el")
	810	when (file-directory-p dir)
	811	append (directory-files
	812	dir t (concat (regexp-opt (get-load-suffixes))
	813	"\\'"))))
	814
	815	;;;###autoload
	816	(defun helm-locate-library ()
	817	"Preconfigured helm to locate elisp libraries."
	818	(interactive)
	819	(helm :sources (helm-build-in-buffer-source "Elisp libraries (Scan)"
	820	:data #'helm-locate-library-scan-list
	821	:fuzzy-match helm-locate-library-fuzzy-match
	822	:keymap helm-generic-files-map
	823	:search (unless helm-locate-library-fuzzy-match
	824	(lambda (regexp)
	825	(re-search-forward
	826	(if helm-ff-transformer-show-only-basename
	827	(replace-regexp-in-string
	828	"\\`\\^" "" regexp)
	829	regexp)
	830	nil t)))
	831	:match-part (lambda (candidate)
	832	(if helm-ff-transformer-show-only-basename
	833	(helm-basename candidate) candidate))
	834	:filter-one-by-one (lambda (c)
	835	(if helm-ff-transformer-show-only-basename
	836	(cons (helm-basename c) c) c))
	837	:action (helm-actions-from-type-file))
	838	:ff-transformer-show-only-basename nil
	839	:buffer "helm locate library"))
	840
	841	(defun helm-set-variable (var)
	842	"Set value to VAR interactively."
	843	(let* ((sym (helm-symbolify var))
	844	(val (default-value sym)))
	845	(set-default sym (eval-minibuffer (format "Set `%s': " var)
	846	(if (or (stringp val) (memq val '(nil t)))
	847	(prin1-to-string val)
	848	(format "'%s" (prin1-to-string val)))))))
	849
	850
	851	;;; Elisp Timers.
	852	;;
	853	;;
	854	(defclass helm-absolute-time-timers-class (helm-source-sync helm-type-timers)
	855	((candidates :initform timer-list)
	856	(allow-dups :initform t)
	857	(candidate-transformer
	858	:initform
	859	(lambda (candidates)
	860	(cl-loop for timer in candidates
	861	collect (cons (helm-elisp--format-timer timer) timer))))))
	862
	863	(defvar helm-source-absolute-time-timers
	864	(helm-make-source "Absolute Time Timers" 'helm-absolute-time-timers-class))
	865
	866	(defclass helm-idle-time-timers-class (helm-source-sync helm-type-timers)
	867	((candidates :initform timer-idle-list)
	868	(allow-dups :initform t)
	869	(candidate-transformer
	870	:initform
	871	(lambda (candidates)
	872	(cl-loop for timer in candidates
	873	collect (cons (helm-elisp--format-timer timer) timer))))))
	874
	875	(defvar helm-source-idle-time-timers
	876	(helm-make-source "Idle Time Timers" 'helm-idle-time-timers-class))
	877
	878	(defun helm-elisp--format-timer (timer)
	879	(format "%s repeat=%s %s(%s)"
	880	(let ((time (timer--time timer)))
	881	(if (timer--idle-delay timer)
	882	(format-time-string "idle-for=%5s" time)
	883	(format-time-string "%m/%d %T" time)))
	884	(or (timer--repeat-delay timer) "nil")
	885	(mapconcat 'identity (split-string
	886	(prin1-to-string (timer--function timer))
	887	"\n") " ")
	888	(mapconcat 'prin1-to-string (timer--args timer) " ")))
	889
	890	;;;###autoload
	891	(defun helm-timers ()
	892	"Preconfigured `helm' for timers."
	893	(interactive)
	894	(helm :sources '(helm-source-absolute-time-timers
	895	helm-source-idle-time-timers)
	896	:buffer "helm timers"))
	897
	898
	899	;;; Complex command history
	900	;;
	901	;;
	902	(defun helm-btf--usable-p ()
	903	"Return t if current version of `backtrace-frame' accept 2 arguments."
	904	(condition-case nil
	905	(progn (backtrace-frame 1 'condition-case) t)
	906	(wrong-number-of-arguments nil)))
	907
	908	(if (helm-btf--usable-p) ; Check if BTF accept more than one arg.
	909	;; Emacs 24.4.
	910	(dont-compile
	911	(defvar helm-sexp--last-sexp nil)
	912	;; This wont work compiled.
	913	(defun helm-sexp-eval-1 ()
	914	(interactive)
	915	(unwind-protect
	916	(progn
	917	;; Trick called-interactively-p into thinking that `cand' is
	918	;; an interactive call, See `repeat-complex-command'.
	919	(add-hook 'called-interactively-p-functions
	920	#'helm-complex-command-history--called-interactively-skip)
	921	(eval (read helm-sexp--last-sexp)))
	922	(remove-hook 'called-interactively-p-functions
	923	#'helm-complex-command-history--called-interactively-skip)))
	924
	925	(defun helm-complex-command-history--called-interactively-skip (i _frame1 frame2)
	926	(and (eq 'eval (cadr frame2))
	927	(eq 'helm-sexp-eval-1
	928	(cadr (backtrace-frame (+ i 2) #'called-interactively-p)))
	929	1))
	930
	931	(defun helm-sexp-eval (_candidate)
	932	(call-interactively #'helm-sexp-eval-1)))
	933	;; Emacs 24.3
	934	(defun helm-sexp-eval (cand)
	935	(let ((sexp (read cand)))
	936	(condition-case err
	937	(if (> (length (remove nil sexp)) 1)
	938	(eval sexp)
	939	(apply 'call-interactively sexp))
	940	(error (message "Evaluating gave an error: %S" err)
	941	nil)))))
	942
	943	(defvar helm-source-complex-command-history
	944	(helm-build-sync-source "Complex Command History"
	945	:candidates (lambda ()
	946	;; Use cdr to avoid adding
	947	;; `helm-complex-command-history' here.
	948	(cl-loop for i in command-history
	949	unless (equal i '(helm-complex-command-history))
	950	collect (prin1-to-string i)))
	951	:action (helm-make-actions
	952	"Eval" (lambda (candidate)
	953	(and (boundp 'helm-sexp--last-sexp)
	954	(setq helm-sexp--last-sexp candidate))
	955	(let ((command (read candidate)))
	956	(unless (equal command (car command-history))
	957	(setq command-history (cons command command-history))))
	958	(run-with-timer 0.1 nil #'helm-sexp-eval candidate))
	959	"Edit and eval" (lambda (candidate)
	960	(edit-and-eval-command "Eval: " (read candidate))))
	961	:persistent-action #'helm-sexp-eval
	962	:multiline t))
	963
	964	;;;###autoload
	965	(defun helm-complex-command-history ()
	966	"Preconfigured helm for complex command history."
	967	(interactive)
	968	(helm :sources 'helm-source-complex-command-history
	969	:buffer "helm complex commands"))
	970
	971	(provide 'helm-elisp)
	972
	973	;; Local Variables:
	974	;; byte-compile-warnings: (not obsolete)
	975	;; coding: utf-8
	976	;; indent-tabs-mode: nil
	977	;; End:
	978
	979	;;; helm-elisp.el ends here