mirror of https://github.com/Chizi123/.emacs.d.git

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