1 ;;; counsel.el --- Various completion functions using Ivy -*- lexical-binding: t -*-
3 ;; Copyright (C) 2015 Free Software Foundation, Inc.
5 ;; Author: Oleh Krehel <ohwoeowho@gmail.com>
6 ;; URL: https://github.com/abo-abo/swiper
8 ;; Package-Requires: ((emacs "24.1") (swiper "0.4.0"))
9 ;; Keywords: completion, matching
11 ;; This file is part of GNU Emacs.
13 ;; This file is free software; you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation; either version 3, or (at your option)
18 ;; This program is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; For a full copy of the GNU General Public License
24 ;; see <http://www.gnu.org/licenses/>.
28 ;; Just call one of the interactive functions in this file to complete
29 ;; the corresponding thing using `ivy'.
31 ;; Currently available: Elisp symbols, Clojure symbols, Git files.
39 "Elisp completion at point."
41 (let* ((bnd (unless (and (looking-at ")")
42 (eq (char-before) ?\())
43 (bounds-of-thing-at-point
46 (buffer-substring-no-properties
51 (funp (eq (char-before (car bnd)) ?\())
55 (setq counsel-completion-beg
56 (move-marker (make-marker) (car bnd)))
57 (setq counsel-completion-end
58 (move-marker (make-marker) (cdr bnd))))
59 (setq counsel-completion-beg nil)
60 (setq counsel-completion-end nil))
65 (push (symbol-name x) symbol-names))))
67 (all-completions str obarray
72 (special-form-p x)))))))
73 (ivy-read "Symbol name: " symbol-names
74 :predicate (and funp #'functionp)
76 :action #'counsel--el-action)))
78 (defvar counsel-completion-beg nil
79 "Completion bounds start.")
81 (defvar counsel-completion-end nil
82 "Completion bounds end.")
84 (defun counsel--el-action (symbol)
85 "Insert SYMBOL, erasing the previous one."
86 (when (stringp symbol)
87 (when counsel-completion-beg
89 counsel-completion-beg
90 counsel-completion-end))
91 (setq counsel-completion-beg
92 (move-marker (make-marker) (point)))
94 (setq counsel-completion-end
95 (move-marker (make-marker) (point)))))
97 (defvar counsel-describe-map
98 (let ((map (make-sparse-keymap)))
99 (define-key map (kbd "C-.") #'counsel-find-symbol)
100 (define-key map (kbd "C-,") #'counsel--info-lookup-symbol)
103 (defun counsel-find-symbol ()
104 "Jump to the definition of the current symbol."
106 (ivy-set-action #'counsel--find-symbol)
109 (defun counsel--info-lookup-symbol ()
110 "Lookup the current symbol in the info docs."
112 (ivy-set-action #'counsel-info-lookup-symbol)
115 (defun counsel--find-symbol (x)
116 "Find symbol definition that corresponds to string X."
117 (let ((full-name (get-text-property 0 'full-name x)))
119 (find-library full-name)
120 (let ((sym (read x)))
127 (prin1-to-string sym)))
129 (prin1-to-string sym)))
131 (error "Couldn't fild definition of %s"
134 (defvar counsel-describe-symbol-history nil
135 "History for `counsel-describe-variable' and `counsel-describe-function'.")
137 (defun counsel-symbol-at-point ()
138 "Return current symbol at point as a string."
139 (let ((s (thing-at-point 'symbol)))
141 (if (string-match "\\`[`']?\\(.*\\)'?\\'" s)
146 (defun counsel-describe-variable ()
147 "Forward to `describe-variable'."
149 (let ((enable-recursive-minibuffers t))
151 "Describe variable: "
155 (when (or (get vv 'variable-documentation)
156 (and (boundp vv) (not (keywordp vv))))
157 (push (symbol-name vv) cands))))
159 :keymap counsel-describe-map
160 :preselect (counsel-symbol-at-point)
161 :history 'counsel-describe-symbol-history
169 (defun counsel-describe-function ()
170 "Forward to `describe-function'."
172 (let ((enable-recursive-minibuffers t))
173 (ivy-read "Describe function: "
178 (push (symbol-name x) cands))))
180 :keymap counsel-describe-map
181 :preselect (counsel-symbol-at-point)
182 :history 'counsel-describe-symbol-history
189 (defvar info-lookup-mode)
190 (declare-function info-lookup->completions "info-look")
191 (declare-function info-lookup->mode-value "info-look")
192 (declare-function info-lookup-select-mode "info-look")
193 (declare-function info-lookup-change-mode "info-look")
194 (declare-function info-lookup "info-look")
197 (defun counsel-info-lookup-symbol (symbol &optional mode)
198 "Forward to (`info-describe-symbol' SYMBOL MODE) with ivy completion."
202 (let* ((topic 'symbol)
203 (mode (cond (current-prefix-arg
204 (info-lookup-change-mode topic))
205 ((info-lookup->mode-value
206 topic (info-lookup-select-mode))
208 ((info-lookup-change-mode topic))))
209 (completions (info-lookup->completions topic mode))
210 (enable-recursive-minibuffers t)
213 (mapcar #'car completions)
215 (list value info-lookup-mode))))
217 (info-lookup 'symbol symbol mode))
220 (defun counsel-unicode-char ()
221 "Insert a Unicode character at point."
223 (let ((minibuffer-allow-text-properties t))
224 (ivy-read "Unicode name: "
227 (format "% -60s%c" (car x) (cdr x))
230 :action (lambda (char)
231 (insert-char (get-text-property 0 'result char))))))
233 (declare-function cider-sync-request:complete "ext:cider-client")
235 (defun counsel-clj ()
236 "Clojure completion at point."
242 (cider-sync-request:complete str ":same")))))
245 (defun counsel-git ()
246 "Find file in the current Git repository."
248 (let* ((default-directory (locate-dominating-file
249 default-directory ".git"))
251 (shell-command-to-string
252 "git ls-files --full-name --")
255 (action (lambda (x) (find-file x))))
256 (ivy-read "Find file: " cands
259 (defvar counsel--git-grep-dir nil
260 "Store the base git directory.")
262 (defvar counsel--git-grep-count nil
263 "Store the line count in current repository.")
265 (defun counsel-git-grep-function (string &optional _pred &rest _unused)
266 "Grep in the current git repository for STRING."
267 (if (and (> counsel--git-grep-count 20000)
268 (< (length string) 3))
270 (setq ivy--full-length counsel--git-grep-count)
272 (format "%d chars more" (- 3 (length ivy-text)))))
273 (let* ((default-directory counsel--git-grep-dir)
274 (cmd (format "git --no-pager grep --full-name -n --no-color -i -e %S"
275 (ivy--regex string t)))
277 (if (<= counsel--git-grep-count 20000)
279 (setq res (shell-command-to-string cmd))
280 (setq ivy--full-length nil)
281 (split-string res "\n" t))
282 (setq ivy--full-length -1)
283 (counsel--gg-candidates (ivy--regex string))
286 (defvar counsel-git-grep-map
287 (let ((map (make-sparse-keymap)))
288 (define-key map (kbd "C-l") 'counsel-git-grep-recenter)
291 (defun counsel-git-grep-recenter ()
293 (with-selected-window (ivy-state-window ivy-last)
294 (counsel-git-grep-action ivy--current)
295 (recenter-top-bottom)))
297 (defun counsel-git-grep-action (x)
298 (when (string-match "\\`\\(.*?\\):\\([0-9]+\\):\\(.*\\)\\'" x)
299 (let ((file-name (match-string-no-properties 1 x))
300 (line-number (match-string-no-properties 2 x)))
301 (find-file (expand-file-name file-name counsel--git-grep-dir))
302 (goto-char (point-min))
303 (forward-line (1- (string-to-number line-number)))
304 (re-search-forward (ivy--regex ivy-text t) (line-end-position) t)
305 (unless (eq ivy-exit 'done)
306 (setq swiper--window (selected-window))
308 (swiper--add-overlays (ivy--regex ivy-text))))))
310 (defvar counsel-git-grep-history nil
311 "History for `counsel-git-grep'.")
314 (defun counsel-git-grep (&optional initial-input)
315 "Grep for a string in the current git repository."
317 (setq counsel--git-grep-dir
318 (locate-dominating-file default-directory ".git"))
319 (if (null counsel--git-grep-dir)
320 (error "Not in a git repository")
321 (setq counsel--git-grep-count (counsel--gg-count "" t))
322 (ivy-read "pattern: " 'counsel-git-grep-function
323 :initial-input initial-input
324 :matcher #'counsel-git-grep-matcher
325 :dynamic-collection (when (> counsel--git-grep-count 20000)
326 'counsel-git-grep-function)
327 :keymap counsel-git-grep-map
328 :action #'counsel-git-grep-action
329 :unwind #'swiper--cleanup
330 :history 'counsel-git-grep-history)))
332 (defcustom counsel-find-file-at-point nil
333 "When non-nil, add file-at-point to the list of candidates."
337 (declare-function ffap-guesser "ffap")
340 (defun counsel-find-file ()
341 "Forward to `find-file'."
343 (ivy-read "Find file: " 'read-file-name-internal
344 :matcher #'counsel--find-file-matcher
347 (find-file (expand-file-name x ivy--directory)))
348 :preselect (when counsel-find-file-at-point
351 :require-match 'confirm-after-completion
352 :history 'file-name-history))
354 (defcustom counsel-find-file-ignore-regexp nil
355 "A regexp of files to ignore while in `counsel-find-file'.
356 These files are un-ignored if `ivy-text' matches them.
357 The common way to show all files is to start `ivy-text' with a dot.
358 Possible value: \"\\(?:\\`[#.]\\)\\|\\(?:[#~]\\'\\)\"."
361 (defun counsel--find-file-matcher (regexp candidates)
362 "Return REGEXP-matching CANDIDATES.
363 Skip some dotfiles unless `ivy-text' requires them."
364 (let ((res (cl-remove-if-not
366 (string-match regexp x))
368 (if (or (null counsel-find-file-ignore-regexp)
369 (string-match counsel-find-file-ignore-regexp ivy-text))
373 (string-match counsel-find-file-ignore-regexp x))
376 (defun counsel-git-grep-matcher (regexp candidates)
377 (or (and (equal regexp ivy--old-re)
384 (when (string-match "^[^:]+:[^:]+:" x)
385 (setq x (substring x (match-end 0)))
387 (string-match regexp x)
394 (string-match (car re) x)
395 (not (string-match (car re) x)))))))
398 (setq ivy--old-re regexp))))
400 (defun counsel-locate-function (str &rest _u)
401 (if (< (length str) 3)
403 (format "%d chars more" (- 3 (length ivy-text))))
404 (counsel--async-command
405 (concat "locate -i --regex " (ivy--regex str)))))
407 (defun counsel--async-command (cmd)
408 (let* ((counsel--process " *counsel*")
409 (proc (get-process counsel--process))
410 (buff (get-buffer counsel--process)))
412 (delete-process proc))
415 (setq proc (start-process-shell-command
419 (set-process-sentinel proc #'counsel--async-sentinel)))
421 (defun counsel--async-sentinel (process event)
422 (if (string= event "finished\n")
424 (with-current-buffer (process-buffer process)
425 (setq ivy--all-candidates (split-string (buffer-string) "\n" t))
426 (setq ivy--old-cands ivy--all-candidates))
427 (ivy--insert-minibuffer
428 (ivy--format ivy--all-candidates)))
429 (if (string= event "exited abnormally with code 1\n")
433 (defun counsel-locate ()
436 (ivy-read "pattern: " nil
437 :dynamic-collection #'counsel-locate-function
438 :action (lambda (val)
442 (defun counsel--generic (completion-fn)
443 "Complete thing at point with COMPLETION-FN."
444 (let* ((bnd (bounds-of-thing-at-point 'symbol))
446 (buffer-substring-no-properties
449 (candidates (funcall completion-fn str))
451 (res (ivy-read (format "pattern (%s): " str)
455 (delete-region (car bnd) (cdr bnd)))
458 (defun counsel-directory-parent (dir)
459 "Return the directory parent of directory DIR."
460 (concat (file-name-nondirectory
461 (directory-file-name dir)) "/"))
463 (defun counsel-string-compose (prefix str)
464 "Make PREFIX the display prefix of STR though text properties."
465 (let ((str (copy-sequence str)))
468 (concat prefix (substring str 0 1))
473 (defun counsel-load-library ()
474 "Load a selected the Emacs Lisp library.
475 The libraries are offered from `load-path'."
477 (let ((dirs load-path)
478 (suffix (concat (regexp-opt '(".el" ".el.gz") t) "\\'"))
479 (cands (make-hash-table :test #'equal))
485 (when (file-directory-p dir)
486 (dolist (file (file-name-all-completions "" dir))
487 (when (string-match suffix file)
488 (unless (string-match "pkg.elc?$" file)
489 (setq short-name (substring file 0 (match-beginning 0)))
490 (if (setq old-val (gethash short-name cands))
492 ;; assume going up directory once will resolve name clash
493 (setq dir-parent (counsel-directory-parent (cdr old-val)))
496 (counsel-string-compose dir-parent (car old-val))
499 (setq dir-parent (counsel-directory-parent dir))
500 (puthash (concat dir-parent short-name)
503 (counsel-string-compose
504 dir-parent short-name)
505 'full-name (expand-file-name file dir))
511 'full-name (expand-file-name file dir))
513 (maphash (lambda (_k v) (push (car v) res)) cands)
514 (ivy-read "Load library: " (nreverse res)
517 (get-text-property 0 'full-name x)))
518 :keymap counsel-describe-map)))
520 (defun counsel--gg-candidates (regex)
521 "Return git grep candidates for REGEX."
522 (counsel--gg-count regex)
523 (let* ((default-directory counsel--git-grep-dir)
524 (counsel-gg-process " *counsel-gg*")
525 (proc (get-process counsel-gg-process))
526 (buff (get-buffer counsel-gg-process)))
528 (delete-process proc))
531 (setq proc (start-process-shell-command
534 (format "git --no-pager grep --full-name -n --no-color -i -e %S | head -n 200"
536 (set-process-sentinel
538 #'counsel--gg-sentinel)))
540 (defun counsel--gg-sentinel (process event)
541 (if (string= event "finished\n")
543 (with-current-buffer (process-buffer process)
544 (setq ivy--all-candidates (split-string (buffer-string) "\n" t))
545 (setq ivy--old-cands ivy--all-candidates))
546 (unless (eq ivy--full-length -1)
547 (ivy--insert-minibuffer
548 (ivy--format ivy--all-candidates))))
549 (if (string= event "exited abnormally with code 1\n")
552 (defun counsel--gg-count (regex &optional no-async)
553 "Quickly and asynchronously count the amount of git grep REGEX matches.
554 When NO-ASYNC is non-nil, do it synchronously."
555 (let ((default-directory counsel--git-grep-dir)
556 (cmd (format "git grep -i -c '%s' | sed 's/.*:\\(.*\\)/\\1/g' | awk '{s+=$1} END {print s}'"
558 (counsel-ggc-process " *counsel-gg-count*"))
560 (string-to-number (shell-command-to-string cmd))
561 (let ((proc (get-process counsel-ggc-process))
562 (buff (get-buffer counsel-ggc-process)))
564 (delete-process proc))
567 (setq proc (start-process-shell-command
571 (set-process-sentinel
573 #'(lambda (process event)
574 (when (string= event "finished\n")
575 (with-current-buffer (process-buffer process)
576 (setq ivy--full-length (string-to-number (buffer-string))))
577 (ivy--insert-minibuffer
578 (ivy--format ivy--all-candidates)))))))))
580 (defun counsel--M-x-transformer (cmd)
581 "Add a binding to CMD if it's bound in the current window.
582 CMD is a command name."
583 (let ((binding (substitute-command-keys (format "\\[%s]" cmd))))
584 (setq binding (replace-regexp-in-string "C-x 6" "<f2>" binding))
585 (if (string-match "^M-x" binding)
587 (format "%s (%s)" cmd
588 (propertize binding 'face 'font-lock-keyword-face)))))
590 (defvar smex-initialized-p)
591 (defvar smex-ido-cache)
592 (declare-function smex-initialize "ext:smex")
593 (declare-function smex-detect-new-commands "ext:smex")
594 (declare-function smex-update "ext:smex")
595 (declare-function smex-rank "ext:smex")
596 (declare-function package-installed-p "package")
599 (defun counsel-M-x (&optional initial-input)
600 "Ivy version of `execute-extended-command'.
601 Optional INITIAL-INPUT is the initial input in the minibuffer."
603 (unless initial-input
604 (setq initial-input (cdr (assoc this-command
605 ivy-initial-inputs-alist))))
606 (let* ((store ivy-format-function)
611 (with-selected-window (ivy-state-window ivy-last)
612 (mapcar #'counsel--M-x-transformer cands)))))
616 (when (or (featurep 'smex)
617 (package-installed-p 'smex))
619 (unless smex-initialized-p
621 (smex-detect-new-commands)
623 (setq cands smex-ido-cache)
626 (ivy-read "M-x " cands
629 :history 'extended-command-history
632 (when (featurep 'smex)
633 (smex-rank (intern cmd)))
634 (let ((prefix-arg current-prefix-arg))
635 (command-execute (intern cmd) 'record)))
637 :keymap counsel-describe-map
638 :initial-input initial-input)))
640 (declare-function powerline-reset "ext:powerline")
642 (defun counsel--load-theme-action (x)
643 "Disable current themes and load theme X."
646 (mapc #'disable-theme custom-enabled-themes)
647 (load-theme (intern x))
648 (when (fboundp 'powerline-reset)
650 (error "Problem loading theme %s" x)))
653 (defun counsel-load-theme ()
654 "Forward to `load-theme'.
655 Usable with `ivy-resume', `ivy-next-line-and-call' and
656 `ivy-previous-line-and-call'."
658 (ivy-read "Load custom theme: "
660 (custom-available-themes))
661 :action #'counsel--load-theme-action))
666 ;;; counsel.el ends here