Klimi's new dotfiles with stow.
Você não pode selecionar mais de 25 tópicos Os tópicos devem começar com uma letra ou um número, podem incluir traços ('-') e podem ter até 35 caracteres.

967 linhas
39 KiB

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