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
7 ;; Package-Requires: ((emacs "24.1") (swiper "0.4.0"))
8 ;; Keywords: completion, matching
10 ;; This file is part of GNU Emacs.
12 ;; This file is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 3, or (at your option)
17 ;; This program is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; For a full copy of the GNU General Public License
23 ;; see <http://www.gnu.org/licenses/>.
27 ;; Just call one of the interactive functions in this file to complete
28 ;; the corresponding thing using `ivy'.
30 ;; Currently available: Elisp symbols, Clojure symbols, Git files.
39 (defun counsel-more-chars (n)
40 "Return two fake candidates prompting for at least N input."
42 (format "%d chars more" (- n (length ivy-text)))))
44 (defun counsel-unquote-regex-parens (str)
47 (while (setq start (string-match "\\\\)\\|\\\\(\\|[()]" str start))
48 (setq ms (match-string-no-properties 0 str))
49 (cond ((equal ms "\\(")
50 (setq str (replace-match "(" nil t str))
51 (setq start (+ start 1)))
53 (setq str (replace-match ")" nil t str))
54 (setq start (+ start 1)))
56 (setq str (replace-match "\\(" nil t str))
57 (setq start (+ start 2)))
59 (setq str (replace-match "\\)" nil t str))
60 (setq start (+ start 2)))
62 (error "unexpected"))))
65 (defun counsel-directory-parent (dir)
66 "Return the directory parent of directory DIR."
67 (concat (file-name-nondirectory
68 (directory-file-name dir)) "/"))
70 (defun counsel-string-compose (prefix str)
71 "Make PREFIX the display prefix of STR though text properties."
72 (let ((str (copy-sequence str)))
75 (concat prefix (substring str 0 1))
80 (defvar counsel--async-time nil
81 "Store the time when a new process was started.
82 Or the time of the last minibuffer update.")
84 (defvar counsel--async-start nil
85 "Store the time when a new process was started.
86 Or the time of the last minibuffer update.")
88 (defvar counsel--async-duration nil
89 "Store the time in seconds between starting a process and
90 receiving all candidates.")
92 (defvar counsel--async-exit-code-plist nil
93 "Associates exit codes with reasons.")
95 (defun counsel-set-async-exit-code (cmd number str)
96 "For CMD, associate NUMBER exit code with STR."
97 (let ((plist (plist-get counsel--async-exit-code-plist cmd)))
98 (setq counsel--async-exit-code-plist
100 counsel--async-exit-code-plist
102 (plist-put plist number str)))))
104 (defvar counsel-async-split-string-re "\n"
105 "Store the regexp for splitting shell command output.")
107 (defun counsel--async-command (cmd &optional process-sentinel process-filter)
108 (let* ((counsel--process " *counsel*")
109 (proc (get-process counsel--process))
110 (buff (get-buffer counsel--process)))
112 (delete-process proc))
115 (setq proc (start-process-shell-command
119 (setq counsel--async-start
120 (setq counsel--async-time (current-time)))
121 (set-process-sentinel proc (or process-sentinel #'counsel--async-sentinel))
122 (set-process-filter proc (or process-filter #'counsel--async-filter))))
124 (defun counsel--async-sentinel (process event)
126 (cond ((string= event "finished\n")
127 (with-current-buffer (process-buffer process)
130 counsel-async-split-string-re
132 ((string-match "exited abnormally with code \\([0-9]+\\)\n" event)
133 (let* ((exit-code-plist (plist-get counsel--async-exit-code-plist
134 (ivy-state-caller ivy-last)))
135 (exit-num (read (match-string 1 event)))
136 (exit-code (plist-get exit-code-plist exit-num)))
139 (format "error code %d" exit-num))))))))
140 (cond ((string= event "finished\n")
144 (setq counsel--async-duration
145 (time-to-seconds (time-since counsel--async-start)))
146 (let ((re (funcall ivy--regex-function ivy-text)))
149 (if (null ivy--old-cands)
150 (unless (setq ivy--index (ivy--preselect-index
151 (ivy-state-preselect ivy-last)
152 ivy--all-candidates))
153 (ivy--recompute-index
154 ivy-text re ivy--all-candidates))
155 (ivy--recompute-index
156 ivy-text re ivy--all-candidates)))
157 (setq ivy--old-cands ivy--all-candidates)
158 (if (null ivy--all-candidates)
159 (ivy--insert-minibuffer "")
161 ((string-match "exited abnormally with code \\([0-9]+\\)\n" event)
162 (setq ivy--all-candidates cands)
163 (setq ivy--old-cands ivy--all-candidates)
166 (defun counsel--async-filter (process str)
167 "Receive from PROCESS the output STR.
168 Update the minibuffer with the amount of lines collected every
169 0.5 seconds since the last update."
170 (with-current-buffer (process-buffer process)
176 (time-since counsel--async-time))
177 (with-current-buffer (process-buffer process)
178 (goto-char (point-min))
179 (setq size (- (buffer-size) (forward-line (buffer-size))))
183 counsel-async-split-string-re
185 (let ((ivy--prompt (format
186 (concat "%d++ " (ivy-state-prompt ivy-last))
188 (ivy--insert-minibuffer
189 (ivy--format ivy--all-candidates)))
190 (setq counsel--async-time (current-time)))))
192 (defcustom counsel-prompt-function 'counsel-prompt-function-default
193 "A function to return a full prompt string from a basic prompt string."
196 (const :tag "Plain" counsel-prompt-function-default)
197 (const :tag "Directory" counsel-prompt-function-dir)
198 (function :tag "Custom"))
201 (defun counsel-prompt-function-default (prompt)
202 "Return PROMPT appended with a semicolon."
203 (format "%s: " prompt))
205 (defun counsel-delete-process ()
206 (let ((process (get-process " *counsel*")))
208 (delete-process process))))
210 ;;* Completion at point
214 "Elisp completion at point."
216 (let* ((bnd (unless (and (looking-at ")")
217 (eq (char-before) ?\())
218 (bounds-of-thing-at-point
221 (buffer-substring-no-properties
226 (funp (eq (char-before (car bnd)) ?\())
230 (setq ivy-completion-beg
231 (move-marker (make-marker) (car bnd)))
232 (setq ivy-completion-end
233 (move-marker (make-marker) (cdr bnd))))
234 (setq ivy-completion-beg nil)
235 (setq ivy-completion-end nil))
240 (push (symbol-name x) symbol-names))))
242 (all-completions str obarray
247 (special-form-p x)))))))
248 (ivy-read "Symbol name: " symbol-names
249 :predicate (and funp #'functionp)
251 :action #'ivy-completion-in-region-action)))
254 (declare-function slime-symbol-start-pos "ext:slime")
255 (declare-function slime-symbol-end-pos "ext:slime")
256 (declare-function slime-contextual-completions "ext:slime-c-p-c")
260 "Common Lisp completion at point."
262 (setq ivy-completion-beg (slime-symbol-start-pos))
263 (setq ivy-completion-end (slime-symbol-end-pos))
264 (ivy-read "Symbol name: "
265 (car (slime-contextual-completions
268 :action #'ivy-completion-in-region-action))
271 (declare-function deferred:sync! "ext:deferred")
272 (declare-function jedi:complete-request "ext:jedi-core")
273 (declare-function jedi:ac-direct-matches "ext:jedi")
275 (defun counsel-jedi ()
276 "Python completion at point."
278 (let ((bnd (bounds-of-thing-at-point 'symbol)))
281 (setq ivy-completion-beg (car bnd))
282 (setq ivy-completion-end (cdr bnd)))
283 (setq ivy-completion-beg nil)
284 (setq ivy-completion-end nil)))
286 (jedi:complete-request))
287 (ivy-read "Symbol name: " (jedi:ac-direct-matches)
288 :action #'counsel--py-action))
290 (defun counsel--py-action (symbol)
291 "Insert SYMBOL, erasing the previous one."
292 (when (stringp symbol)
294 (when ivy-completion-beg
298 (setq ivy-completion-beg
299 (move-marker (make-marker) (point)))
301 (setq ivy-completion-end
302 (move-marker (make-marker) (point)))
303 (when (equal (get-text-property 0 'symbol symbol) "f")
305 (setq ivy-completion-end
306 (move-marker (make-marker) (point)))
307 (backward-char 1)))))
310 (declare-function cider-sync-request:complete "ext:cider-client")
311 (defun counsel--generic (completion-fn)
312 "Complete thing at point with COMPLETION-FN."
313 (let* ((bnd (or (bounds-of-thing-at-point 'symbol)
314 (cons (point) (point))))
315 (str (buffer-substring-no-properties
316 (car bnd) (cdr bnd)))
317 (candidates (funcall completion-fn str))
319 (res (ivy-read (format "pattern (%s): " str)
323 (delete-region (car bnd) (cdr bnd)))
327 (defun counsel-clj ()
328 "Clojure completion at point."
334 (cider-sync-request:complete str ":same")))))
336 ;;** `counsel-unicode-char'
337 (defvar counsel-unicode-char-history nil
338 "History for `counsel-unicode-char'.")
341 (defun counsel-unicode-char ()
342 "Insert a Unicode character at point."
344 (let ((minibuffer-allow-text-properties t))
345 (setq ivy-completion-beg (point))
346 (setq ivy-completion-end (point))
347 (ivy-read "Unicode name: "
350 (format "% -6X% -60s%c" (cdr x) (car x) (cdr x))
353 :action (lambda (char)
355 (delete-region ivy-completion-beg ivy-completion-end)
356 (setq ivy-completion-beg (point))
357 (insert-char (get-text-property 0 'result char))
358 (setq ivy-completion-end (point))))
359 :history 'counsel-unicode-char-history)))
362 ;;** `counsel-describe-variable'
363 (defvar counsel-describe-map
364 (let ((map (make-sparse-keymap)))
365 (define-key map (kbd "C-.") #'counsel-find-symbol)
366 (define-key map (kbd "C-,") #'counsel--info-lookup-symbol)
370 'counsel-describe-variable
371 '(("i" counsel-info-lookup-symbol "info")
372 ("d" counsel--find-symbol "definition")))
374 (defvar counsel-describe-symbol-history nil
375 "History for `counsel-describe-variable' and `counsel-describe-function'.")
377 (defun counsel-find-symbol ()
378 "Jump to the definition of the current symbol."
380 (ivy-exit-with-action #'counsel--find-symbol))
382 (defun counsel--info-lookup-symbol ()
383 "Lookup the current symbol in the info docs."
385 (ivy-exit-with-action #'counsel-info-lookup-symbol))
387 (defun counsel--find-symbol (x)
388 "Find symbol definition that corresponds to string X."
391 (ring-insert find-tag-marker-ring (point-marker)))
392 (let ((full-name (get-text-property 0 'full-name x)))
394 (find-library full-name)
395 (let ((sym (read x)))
396 (cond ((and (eq (ivy-state-caller ivy-last)
397 'counsel-describe-variable)
406 (prin1-to-string sym)))
408 (prin1-to-string sym)))
410 (error "Couldn't fild definition of %s"
413 (define-obsolete-function-alias 'counsel-symbol-at-point
414 'ivy-thing-at-point "0.7.0")
416 (defun counsel-variable-list ()
417 "Return the list of all currently bound variables."
421 (when (or (get vv 'variable-documentation)
422 (and (boundp vv) (not (keywordp vv))))
423 (push (symbol-name vv) cands))))
427 (defun counsel-describe-variable ()
428 "Forward to `describe-variable'."
430 (let ((enable-recursive-minibuffers t))
432 "Describe variable: "
433 (counsel-variable-list)
434 :keymap counsel-describe-map
435 :preselect (ivy-thing-at-point)
436 :history 'counsel-describe-symbol-history
442 :caller 'counsel-describe-variable)))
444 ;;** `counsel-describe-function'
446 'counsel-describe-function
447 '(("i" counsel-info-lookup-symbol "info")
448 ("d" counsel--find-symbol "definition")))
451 (defun counsel-describe-function ()
452 "Forward to `describe-function'."
454 (let ((enable-recursive-minibuffers t))
455 (ivy-read "Describe function: "
460 (push (symbol-name x) cands))))
462 :keymap counsel-describe-map
463 :preselect (ivy-thing-at-point)
464 :history 'counsel-describe-symbol-history
470 :caller 'counsel-describe-function)))
472 ;;** `counsel-info-lookup-symbol'
473 (defvar info-lookup-mode)
474 (declare-function info-lookup->completions "info-look")
475 (declare-function info-lookup->mode-value "info-look")
476 (declare-function info-lookup-select-mode "info-look")
477 (declare-function info-lookup-change-mode "info-look")
478 (declare-function info-lookup "info-look")
481 (defun counsel-info-lookup-symbol (symbol &optional mode)
482 "Forward to (`info-describe-symbol' SYMBOL MODE) with ivy completion."
486 (let* ((topic 'symbol)
487 (mode (cond (current-prefix-arg
488 (info-lookup-change-mode topic))
489 ((info-lookup->mode-value
490 topic (info-lookup-select-mode))
492 ((info-lookup-change-mode topic))))
493 (completions (info-lookup->completions topic mode))
494 (enable-recursive-minibuffers t)
497 (mapcar #'car completions)
499 (list value info-lookup-mode))))
501 (info-lookup 'symbol symbol mode))
506 '(("d" counsel--find-symbol "definition")
507 ("h" (lambda (x) (describe-function (intern x))) "help")))
509 (ivy-set-display-transformer
511 'counsel-M-x-transformer)
513 (defun counsel-M-x-transformer (cmd)
514 "Return CMD appended with the corresponding binding in the current window."
515 (let ((binding (substitute-command-keys (format "\\[%s]" cmd))))
516 (setq binding (replace-regexp-in-string "C-x 6" "<f2>" binding))
517 (if (string-match "^M-x" binding)
520 cmd (propertize binding 'face 'font-lock-keyword-face)))))
522 (defvar smex-initialized-p)
523 (defvar smex-ido-cache)
524 (declare-function smex-initialize "ext:smex")
525 (declare-function smex-detect-new-commands "ext:smex")
526 (declare-function smex-update "ext:smex")
527 (declare-function smex-rank "ext:smex")
529 (defun counsel--M-x-prompt ()
530 "M-x plus the string representation of `current-prefix-arg'."
531 (if (not current-prefix-arg)
534 (if (eq current-prefix-arg '-)
536 (if (integerp current-prefix-arg)
537 (format "%d " current-prefix-arg)
538 (if (= (car current-prefix-arg) 4)
540 (format "%d " (car current-prefix-arg)))))
544 (defun counsel-M-x (&optional initial-input)
545 "Ivy version of `execute-extended-command'.
546 Optional INITIAL-INPUT is the initial input in the minibuffer."
548 (unless initial-input
549 (setq initial-input (cdr (assoc this-command
550 ivy-initial-inputs-alist))))
551 (let* ((cands obarray)
554 (when (require 'smex nil 'noerror)
555 (unless smex-initialized-p
557 (smex-detect-new-commands)
559 (setq cands smex-ido-cache)
562 (ivy-read (counsel--M-x-prompt) cands
565 :history 'extended-command-history
568 (when (featurep 'smex)
569 (smex-rank (intern cmd)))
570 (let ((prefix-arg current-prefix-arg)
571 (this-command (intern cmd)))
572 (command-execute (intern cmd) 'record)))
574 :keymap counsel-describe-map
575 :initial-input initial-input
576 :caller 'counsel-M-x)))
578 ;;** `counsel-load-library'
580 (defun counsel-load-library ()
581 "Load a selected the Emacs Lisp library.
582 The libraries are offered from `load-path'."
584 (let ((dirs load-path)
585 (suffix (concat (regexp-opt '(".el" ".el.gz") t) "\\'"))
586 (cands (make-hash-table :test #'equal))
592 (when (file-directory-p dir)
593 (dolist (file (file-name-all-completions "" dir))
594 (when (string-match suffix file)
595 (unless (string-match "pkg.elc?$" file)
596 (setq short-name (substring file 0 (match-beginning 0)))
597 (if (setq old-val (gethash short-name cands))
599 ;; assume going up directory once will resolve name clash
600 (setq dir-parent (counsel-directory-parent (cdr old-val)))
603 (counsel-string-compose dir-parent (car old-val))
606 (setq dir-parent (counsel-directory-parent dir))
607 (puthash (concat dir-parent short-name)
610 (counsel-string-compose
611 dir-parent short-name)
612 'full-name (expand-file-name file dir))
618 'full-name (expand-file-name file dir))
620 (maphash (lambda (_k v) (push (car v) res)) cands)
621 (ivy-read "Load library: " (nreverse res)
624 (get-text-property 0 'full-name x)))
625 :keymap counsel-describe-map)))
627 ;;** `counsel-load-theme'
628 (declare-function powerline-reset "ext:powerline")
630 (defun counsel-load-theme-action (x)
631 "Disable current themes and load theme X."
634 (mapc #'disable-theme custom-enabled-themes)
635 (load-theme (intern x))
636 (when (fboundp 'powerline-reset)
638 (error "Problem loading theme %s" x)))
641 (defun counsel-load-theme ()
642 "Forward to `load-theme'.
643 Usable with `ivy-resume', `ivy-next-line-and-call' and
644 `ivy-previous-line-and-call'."
646 (ivy-read "Load custom theme: "
648 (custom-available-themes))
649 :action #'counsel-load-theme-action
650 :caller 'counsel-load-theme))
652 ;;** `counsel-descbinds'
655 '(("d" counsel-descbinds-action-find "definition")
656 ("i" counsel-descbinds-action-info "info")))
658 (defvar counsel-descbinds-history nil
659 "History for `counsel-descbinds'.")
661 (defun counsel--descbinds-cands (&optional prefix buffer)
662 (let ((buffer (or buffer (current-buffer)))
663 (re-exclude (regexp-opt
664 '("<vertical-line>" "<bottom-divider>" "<right-divider>"
665 "<mode-line>" "<C-down-mouse-2>" "<left-fringe>"
666 "<right-fringe>" "<header-line>"
667 "<vertical-scroll-bar>" "<horizontal-scroll-bar>")))
670 (let ((indent-tabs-mode t))
671 (describe-buffer-bindings buffer prefix))
672 (goto-char (point-min))
673 ;; Skip the "Key translations" section
674 (re-search-forward "
\f")
677 (when (looking-at "^\\([^\t\n]+\\)\t+\\(.*\\)$")
678 (let ((key (match-string 1))
679 (fun (match-string 2))
681 (unless (or (member fun '("??" "self-insert-command"))
682 (string-match re-exclude key)
683 (not (or (commandp (setq cmd (intern-soft fun)))
684 (member fun '("Prefix Command")))))
688 (propertize key 'face 'font-lock-builtin-face)
695 (defun counsel-descbinds-action-describe (x)
697 (describe-function cmd)))
699 (defun counsel-descbinds-action-find (x)
701 (counsel--find-symbol (symbol-name cmd))))
703 (defun counsel-descbinds-action-info (x)
705 (counsel-info-lookup-symbol (symbol-name cmd))))
708 (defun counsel-descbinds (&optional prefix buffer)
709 "Show a list of all defined keys, and their definitions.
710 Describe the selected candidate."
712 (ivy-read "Bindings: " (counsel--descbinds-cands prefix buffer)
713 :action #'counsel-descbinds-action-describe
714 :history 'counsel-descbinds-history
715 :caller 'counsel-descbinds))
718 (defvar counsel--git-dir nil
719 "Store the base git directory.")
724 find-file-other-window
728 (defun counsel-git ()
729 "Find file in the current Git repository."
731 (setq counsel--git-dir (expand-file-name
732 (locate-dominating-file
733 default-directory ".git")))
734 (let* ((default-directory counsel--git-dir)
736 (shell-command-to-string
737 "git ls-files --full-name --")
740 (ivy-read (funcall counsel-prompt-function "Find file")
742 :action #'counsel-git-action)))
744 (defun counsel-git-action (x)
746 (let ((default-directory counsel--git-dir))
749 ;;** `counsel-git-grep'
750 (defvar counsel-git-grep-map
751 (let ((map (make-sparse-keymap)))
752 (define-key map (kbd "C-l") 'counsel-git-grep-recenter)
753 (define-key map (kbd "M-q") 'counsel-git-grep-query-replace)
754 (define-key map (kbd "C-c C-m") 'counsel-git-grep-switch-cmd)
757 (ivy-set-occur 'counsel-git-grep 'counsel-git-grep-occur)
758 (ivy-set-display-transformer 'counsel-git-grep 'counsel-git-grep-transformer)
760 (defvar counsel-git-grep-cmd "git --no-pager grep --full-name -n --no-color -i -e %S"
761 "Store the command for `counsel-git-grep'.")
763 (defvar counsel--git-grep-dir nil
764 "Store the base git directory.")
766 (defvar counsel--git-grep-count nil
767 "Store the line count in current repository.")
769 (defvar counsel-git-grep-history nil
770 "History for `counsel-git-grep'.")
772 (defvar counsel-git-grep-cmd-history
773 '("git --no-pager grep --full-name -n --no-color -i -e %S")
774 "History for `counsel-git-grep' shell commands.")
776 (defun counsel-prompt-function-dir (prompt)
777 "Return PROMPT appended with the parent directory."
778 (let ((directory counsel--git-grep-dir))
781 (let ((dir-list (eshell-split-path directory)))
782 (if (> (length dir-list) 3)
785 (cl-subseq dir-list (- (length dir-list) 3))))
788 (defun counsel-git-grep-function (string &optional _pred &rest _unused)
789 "Grep in the current git repository for STRING."
790 (if (and (> counsel--git-grep-count 20000)
791 (< (length string) 3))
792 (counsel-more-chars 3)
793 (let* ((default-directory counsel--git-grep-dir)
794 (cmd (format counsel-git-grep-cmd
795 (setq ivy--old-re (ivy--regex string t)))))
796 (if (<= counsel--git-grep-count 20000)
797 (split-string (shell-command-to-string cmd) "\n" t)
798 (counsel--gg-candidates (ivy--regex string))
801 (defun counsel-git-grep-action (x)
802 (when (string-match "\\`\\(.*?\\):\\([0-9]+\\):\\(.*\\)\\'" x)
804 (let ((file-name (match-string-no-properties 1 x))
805 (line-number (match-string-no-properties 2 x)))
806 (find-file (expand-file-name file-name counsel--git-grep-dir))
807 (goto-char (point-min))
808 (forward-line (1- (string-to-number line-number)))
809 (re-search-forward (ivy--regex ivy-text t) (line-end-position) t)
810 (unless (eq ivy-exit 'done)
812 (swiper--add-overlays (ivy--regex ivy-text)))))))
814 (defun counsel-git-grep-matcher (regexp candidates)
815 (or (and (equal regexp ivy--old-re)
822 (when (string-match "^[^:]+:[^:]+:" x)
823 (setq x (substring x (match-end 0)))
825 (string-match regexp x)
832 (string-match (car re) x)
833 (not (string-match (car re) x)))))))
836 (setq ivy--old-re regexp))))
838 (defun counsel-git-grep-transformer (str)
839 "Higlight file and line number in STR."
840 (when (string-match "\\`\\([^:]+\\):\\([^:]+\\):" str)
841 (set-text-properties (match-beginning 1)
843 '(face compilation-info)
845 (set-text-properties (match-beginning 2)
847 '(face compilation-line-number)
852 (defun counsel-git-grep (&optional cmd initial-input)
853 "Grep for a string in the current git repository.
854 When CMD is a string, use it as a \"git grep\" command.
855 When CMD is non-nil, prompt for a specific \"git grep\" command.
856 INITIAL-INPUT can be given as the initial minibuffer input."
860 (setq counsel-git-grep-cmd cmd))
862 (setq counsel-git-grep-cmd
863 (ivy-read "cmd: " counsel-git-grep-cmd-history
864 :history 'counsel-git-grep-cmd-history))
865 (setq counsel-git-grep-cmd-history
866 (delete-dups counsel-git-grep-cmd-history)))
868 (setq counsel-git-grep-cmd "git --no-pager grep --full-name -n --no-color -i -e %S")))
869 (setq counsel--git-grep-dir
870 (locate-dominating-file default-directory ".git"))
871 (if (null counsel--git-grep-dir)
872 (error "Not in a git repository")
873 (setq counsel--git-grep-count (counsel--gg-count "" t))
875 (funcall counsel-prompt-function "git grep")
876 'counsel-git-grep-function
877 :initial-input initial-input
878 :matcher #'counsel-git-grep-matcher
879 :dynamic-collection (> counsel--git-grep-count 20000)
880 :keymap counsel-git-grep-map
881 :action #'counsel-git-grep-action
882 :unwind #'swiper--cleanup
883 :history 'counsel-git-grep-history
884 :caller 'counsel-git-grep)))
886 (defun counsel-git-grep-switch-cmd ()
887 "Set `counsel-git-grep-cmd' to a different value."
889 (setq counsel-git-grep-cmd
890 (ivy-read "cmd: " counsel-git-grep-cmd-history
891 :history 'counsel-git-grep-cmd-history))
892 (setq counsel-git-grep-cmd-history
893 (delete-dups counsel-git-grep-cmd-history))
894 (unless (ivy-state-dynamic-collection ivy-last)
895 (setq ivy--all-candidates
896 (all-completions "" 'counsel-git-grep-function))))
898 (defvar counsel-gg-state nil
899 "The current state of candidates / count sync.")
901 (defun counsel--gg-candidates (regex)
902 "Return git grep candidates for REGEX."
903 (setq counsel-gg-state -2)
904 (counsel--gg-count regex)
905 (let* ((default-directory counsel--git-grep-dir)
906 (counsel-gg-process " *counsel-gg*")
907 (proc (get-process counsel-gg-process))
908 (buff (get-buffer counsel-gg-process)))
910 (delete-process proc))
913 (setq proc (start-process-shell-command
917 (format counsel-git-grep-cmd regex)
919 (set-process-sentinel
921 #'counsel--gg-sentinel)))
923 (defun counsel--gg-sentinel (process event)
924 (if (string= event "finished\n")
926 (with-current-buffer (process-buffer process)
927 (setq ivy--all-candidates
928 (or (split-string (buffer-string) "\n" t)
930 (setq ivy--old-cands ivy--all-candidates))
931 (when (= 0 (cl-incf counsel-gg-state))
933 (if (string= event "exited abnormally with code 1\n")
935 (setq ivy--all-candidates '("Error"))
936 (setq ivy--old-cands ivy--all-candidates)
939 (defun counsel--gg-count (regex &optional no-async)
940 "Quickly and asynchronously count the amount of git grep REGEX matches.
941 When NO-ASYNC is non-nil, do it synchronously."
942 (let ((default-directory counsel--git-grep-dir)
946 (replace-regexp-in-string
948 counsel-git-grep-cmd)
949 ;; "git grep -i -c '%s'"
950 (replace-regexp-in-string
952 (replace-regexp-in-string "'" "''" regex)))
953 " | sed 's/.*:\\(.*\\)/\\1/g' | awk '{s+=$1} END {print s}'"))
954 (counsel-ggc-process " *counsel-gg-count*"))
956 (string-to-number (shell-command-to-string cmd))
957 (let ((proc (get-process counsel-ggc-process))
958 (buff (get-buffer counsel-ggc-process)))
960 (delete-process proc))
963 (setq proc (start-process-shell-command
967 (set-process-sentinel
969 #'(lambda (process event)
970 (when (string= event "finished\n")
971 (with-current-buffer (process-buffer process)
972 (setq ivy--full-length (string-to-number (buffer-string))))
973 (when (= 0 (cl-incf counsel-gg-state))
974 (ivy--exhibit)))))))))
976 (defun counsel-git-grep-occur ()
977 "Generate a custom occur buffer for `counsel-git-grep'.
978 When REVERT is non-nil, regenerate the current *ivy-occur* buffer."
979 (unless (eq major-mode 'ivy-occur-grep-mode)
980 (ivy-occur-grep-mode)
981 (setq default-directory counsel--git-grep-dir))
982 (let ((cands (split-string
983 (shell-command-to-string
984 (format counsel-git-grep-cmd
985 (setq ivy--old-re (ivy--regex ivy-text t))))
988 ;; Need precise number of header lines for `wgrep' to work.
989 (insert (format "-*- mode:grep; default-directory: %S -*-\n\n\n"
991 (insert (format "%d candidates:\n" (length cands)))
992 (ivy--occur-insert-lines
994 (lambda (cand) (concat "./" cand))
997 (defun counsel-git-grep-query-replace ()
998 "Start `query-replace' with string to replace from last search string."
1000 (if (null (window-minibuffer-p))
1002 "Should only be called in the minibuffer through `counsel-git-grep-map'")
1003 (let* ((enable-recursive-minibuffers t)
1004 (from (ivy--regex ivy-text))
1005 (to (query-replace-read-to from "Query replace" t)))
1006 (ivy-exit-with-action
1009 (dolist (cand ivy--old-cands)
1010 (when (string-match "\\`\\(.*?\\):\\([0-9]+\\):\\(.*\\)\\'" cand)
1012 (let ((file-name (match-string-no-properties 1 cand)))
1013 (setq file-name (expand-file-name file-name counsel--git-grep-dir))
1014 (unless (member file-name done-buffers)
1015 (push file-name done-buffers)
1016 (find-file file-name)
1017 (goto-char (point-min)))
1018 (perform-replace from to t t nil)))))))))))
1020 (defun counsel-git-grep-recenter ()
1023 (counsel-git-grep-action ivy--current)
1024 (recenter-top-bottom)))
1026 ;;** `counsel-git-stash'
1027 (defun counsel-git-stash-kill-action (x)
1028 (when (string-match "\\([^:]+\\):" x)
1029 (kill-new (message (format "git stash apply %s" (match-string 1 x))))))
1032 (defun counsel-git-stash ()
1033 "Search through all available git stashes."
1035 (let ((dir (locate-dominating-file default-directory ".git")))
1037 (error "Not in a git repository")
1038 (let ((cands (split-string (shell-command-to-string
1040 for i in `git stash list --format=\"%gd\"`; do
1041 git stash show -p $i | grep -H --label=\"$i\" \"$1\"
1043 (ivy-read "git stash: " cands
1044 :action 'counsel-git-stash-kill-action
1045 :caller 'counsel-git-stash)))))
1046 ;;** `counsel-git-log'
1047 (defun counsel-git-log-function (input)
1048 (if (< (length input) 3)
1049 (counsel-more-chars 3)
1050 ;; `counsel--yank-pop-format-function' uses this
1051 (setq ivy--old-re (funcall ivy--regex-function input))
1052 (counsel--async-command
1053 ;; "git log --grep" likes to have groups quoted e.g. \(foo\).
1054 ;; But it doesn't like the non-greedy ".*?".
1055 (format "GIT_PAGER=cat git log --grep '%s'"
1056 (replace-regexp-in-string
1061 (defun counsel-git-log-action (x)
1062 (message "%S" (kill-new x)))
1064 (defcustom counsel-yank-pop-truncate-radius 2
1065 "When non-nil, truncate the display of long strings."
1070 (defun counsel-git-log ()
1071 "Call the \"git log --grep\" shell command."
1073 (let ((counsel-async-split-string-re "\ncommit ")
1074 (counsel-yank-pop-truncate-radius 5)
1075 (ivy-format-function #'counsel--yank-pop-format-function)
1077 (ivy-read "Grep log: " #'counsel-git-log-function
1078 :dynamic-collection t
1079 :action #'counsel-git-log-action
1080 :unwind #'counsel-delete-process
1081 :caller 'counsel-git-log)))
1084 ;;** `counsel-find-file'
1085 (defvar counsel-find-file-map
1086 (let ((map (make-sparse-keymap)))
1087 (define-key map (kbd "C-DEL") 'counsel-up-directory)
1088 (define-key map (kbd "C-<backspace>") 'counsel-up-directory)
1091 (add-to-list 'ivy-ffap-url-functions 'counsel-github-url-p)
1092 (add-to-list 'ivy-ffap-url-functions 'counsel-emacs-url-p)
1095 '(("f" find-file-other-window "other window")))
1097 (defcustom counsel-find-file-at-point nil
1098 "When non-nil, add file-at-point to the list of candidates."
1102 (defcustom counsel-find-file-ignore-regexp nil
1103 "A regexp of files to ignore while in `counsel-find-file'.
1104 These files are un-ignored if `ivy-text' matches them. The
1105 common way to show all files is to start `ivy-text' with a dot.
1107 Example value: \"\\(?:\\`[#.]\\)\\|\\(?:[#~]\\'\\)\". This will hide
1108 temporary and lock files.
1109 \\<ivy-minibuffer-map>
1110 Choosing the dotfiles option, \"\\`\\.\", might be convenient,
1111 since you can still access the dotfiles if your input starts with
1112 a dot. The generic way to toggle ignored files is \\[ivy-toggle-ignore],
1113 but the leading dot is a lot faster."
1116 (const :tag "None" nil)
1117 (const :tag "Dotfiles" "\\`\\.")
1118 (regexp :tag "Regex")))
1120 (defun counsel--find-file-matcher (regexp candidates)
1121 "Return REGEXP-matching CANDIDATES.
1122 Skip some dotfiles unless `ivy-text' requires them."
1123 (let ((res (ivy--re-filter regexp candidates)))
1124 (if (or (null ivy-use-ignore)
1125 (null counsel-find-file-ignore-regexp)
1126 (string-match "\\`\\." ivy-text))
1131 (string-match counsel-find-file-ignore-regexp x)
1132 (not (member x ivy-extra-directories))))
1136 (declare-function ffap-guesser "ffap")
1139 (defun counsel-find-file (&optional initial-input)
1140 "Forward to `find-file'.
1141 When INITIAL-INPUT is non-nil, use it in the minibuffer during completion."
1143 (ivy-read "Find file: " 'read-file-name-internal
1144 :matcher #'counsel--find-file-matcher
1145 :initial-input initial-input
1149 (find-file (expand-file-name x ivy--directory))))
1150 :preselect (when counsel-find-file-at-point
1152 (let ((f (ffap-guesser)))
1153 (when f (expand-file-name f))))
1154 :require-match 'confirm-after-completion
1155 :history 'file-name-history
1156 :keymap counsel-find-file-map
1157 :caller 'counsel-find-file))
1159 (defun counsel-up-directory ()
1160 "Go to the parent directory preselecting the current one."
1162 (let ((dir-file-name
1163 (directory-file-name (expand-file-name ivy--directory))))
1164 (ivy--cd (file-name-directory dir-file-name))
1165 (setf (ivy-state-preselect ivy-last)
1166 (file-name-as-directory (file-name-nondirectory dir-file-name)))))
1168 (defun counsel-at-git-issue-p ()
1169 "Whe point is at an issue in a Git-versioned file, return the issue string."
1170 (and (looking-at "#[0-9]+")
1172 (eq (vc-backend (buffer-file-name)) 'Git)
1173 (memq major-mode '(magit-commit-mode)))
1174 (match-string-no-properties 0)))
1176 (defun counsel-github-url-p ()
1177 "Return a Github issue URL at point."
1178 (let ((url (counsel-at-git-issue-p)))
1180 (let ((origin (shell-command-to-string
1181 "git remote get-url origin"))
1183 (cond ((string-match "\\`git@github.com:\\([^/]+\\)/\\(.*\\)\\.git$"
1185 (setq user (match-string 1 origin))
1186 (setq repo (match-string 2 origin)))
1187 ((string-match "\\`https://github.com/\\([^/]+\\)/\\(.*\\)$"
1189 (setq user (match-string 1 origin))
1190 (setq repo (match-string 2 origin))))
1192 (setq url (format "https://github.com/%s/%s/issues/%s"
1193 user repo (substring url 1))))))))
1195 (defun counsel-emacs-url-p ()
1196 "Return a Debbugs issue URL at point."
1197 (let ((url (counsel-at-git-issue-p)))
1199 (let ((origin (shell-command-to-string
1200 "git remote get-url origin")))
1201 (when (string-match "git.sv.gnu.org:/srv/git/emacs.git" origin)
1202 (format "http://debbugs.gnu.org/cgi/bugreport.cgi?bug=%s"
1203 (substring url 1)))))))
1205 ;;** `counsel-locate'
1206 (defcustom counsel-locate-options nil
1207 "Command line options for `locate`."
1209 :type '(repeat string))
1211 (make-obsolete-variable 'counsel-locate-options 'counsel-locate-cmd "0.7.0")
1213 (defcustom counsel-locate-cmd (cond ((eq system-type 'darwin)
1214 'counsel-locate-cmd-noregex)
1215 ((and (eq system-type 'windows-nt)
1216 (executable-find "es.exe"))
1217 'counsel-locate-cmd-es)
1219 'counsel-locate-cmd-default))
1220 "The function for producing a locate command string from the input.
1222 The function takes a string - the current input, and returns a
1223 string - the full shell command to run."
1226 (const :tag "Default" counsel-locate-cmd-default)
1227 (const :tag "No regex" counsel-locate-cmd-noregex)
1228 (const :tag "mdfind" counsel-locate-cmd-mdfind)
1229 (const :tag "everything" counsel-locate-cmd-es)))
1233 '(("x" counsel-locate-action-extern "xdg-open")
1234 ("d" counsel-locate-action-dired "dired")))
1236 (counsel-set-async-exit-code 'counsel-locate 1 "Nothing found")
1238 (defvar counsel-locate-history nil
1239 "History for `counsel-locate'.")
1241 (defun counsel-locate-action-extern (x)
1242 "Use xdg-open shell command on X."
1243 (call-process shell-file-name nil
1245 shell-command-switch
1247 (if (eq system-type 'darwin)
1250 (shell-quote-argument x))))
1252 (declare-function dired-jump "dired-x")
1254 (defun counsel-locate-action-dired (x)
1255 "Use `dired-jump' on X."
1258 (defun counsel-locate-cmd-default (input)
1259 "Return a shell command based on INPUT."
1260 (format "locate -i --regex '%s'"
1261 (counsel-unquote-regex-parens
1262 (ivy--regex input))))
1264 (defun counsel-locate-cmd-noregex (input)
1265 "Return a shell command based on INPUT."
1266 (format "locate -i '%s'" input))
1268 (defun counsel-locate-cmd-mdfind (input)
1269 "Return a shell command based on INPUT."
1270 (format "mdfind -name '%s'" input))
1272 (defun counsel-locate-cmd-es (input)
1273 "Return a shell command based on INPUT."
1274 (format "es.exe -i -r %s"
1275 (counsel-unquote-regex-parens
1276 (ivy--regex input t))))
1278 (defun counsel-locate-function (input)
1279 (if (< (length input) 3)
1280 (counsel-more-chars 3)
1281 (counsel--async-command
1282 (funcall counsel-locate-cmd input))
1283 '("" "working...")))
1286 (defun counsel-locate (&optional initial-input)
1287 "Call the \"locate\" shell command.
1288 INITIAL-INPUT can be given as the initial minibuffer input."
1290 (ivy-read "Locate: " #'counsel-locate-function
1291 :initial-input initial-input
1292 :dynamic-collection t
1293 :history 'counsel-locate-history
1294 :action (lambda (file)
1298 :unwind #'counsel-delete-process
1299 :caller 'counsel-locate))
1303 (defvar counsel-ag-map
1304 (let ((map (make-sparse-keymap)))
1305 (define-key map (kbd "C-l") 'counsel-git-grep-recenter)
1306 (define-key map (kbd "M-q") 'counsel-git-grep-query-replace)
1309 (defcustom counsel-ag-base-command "ag --nocolor --nogroup %s -- ."
1310 "Format string to use in `cousel-ag-function' to construct the
1311 command. %S will be replaced by the regex string. The default is
1312 \"ag --nocolor --nogroup %s -- .\"."
1316 (counsel-set-async-exit-code 'counsel-ag 1 "No matches found")
1317 (ivy-set-occur 'counsel-ag 'counsel-ag-occur)
1318 (ivy-set-display-transformer 'counsel-ag 'counsel-git-grep-transformer)
1320 (defun counsel-ag-function (string)
1321 "Grep in the current directory for STRING."
1322 (if (< (length string) 3)
1323 (counsel-more-chars 3)
1324 (let ((default-directory counsel--git-grep-dir)
1325 (regex (counsel-unquote-regex-parens
1327 (ivy--regex string)))))
1328 (counsel--async-command
1329 (format counsel-ag-base-command (shell-quote-argument regex)))
1333 (defun counsel-ag (&optional initial-input initial-directory)
1334 "Grep for a string in the current directory using ag.
1335 INITIAL-INPUT can be given as the initial minibuffer input."
1338 (when current-prefix-arg
1339 (read-directory-name (concat
1340 (car (split-string counsel-ag-base-command))
1341 " in directory: ")))))
1342 (setq counsel--git-grep-dir (or initial-directory default-directory))
1343 (ivy-read (funcall counsel-prompt-function
1344 (car (split-string counsel-ag-base-command)))
1345 'counsel-ag-function
1346 :initial-input initial-input
1347 :dynamic-collection t
1348 :keymap counsel-ag-map
1349 :history 'counsel-git-grep-history
1350 :action #'counsel-git-grep-action
1352 (counsel-delete-process)
1354 :caller 'counsel-ag))
1356 (defun counsel-ag-occur ()
1357 "Generate a custom occur buffer for `counsel-ag'."
1358 (unless (eq major-mode 'ivy-occur-grep-mode)
1359 (ivy-occur-grep-mode))
1360 (setq default-directory counsel--git-grep-dir)
1361 (let* ((regex (counsel-unquote-regex-parens
1364 (progn (string-match "\"\\(.*\\)\"" (buffer-name))
1365 (match-string 1 (buffer-name)))))))
1366 (cands (split-string
1367 (shell-command-to-string
1368 (format counsel-ag-base-command (shell-quote-argument regex)))
1371 ;; Need precise number of header lines for `wgrep' to work.
1372 (insert (format "-*- mode:grep; default-directory: %S -*-\n\n\n"
1374 (insert (format "%d candidates:\n" (length cands)))
1375 (ivy--occur-insert-lines
1377 (lambda (cand) (concat "./" cand))
1381 (defcustom counsel-pt-base-command "pt --nocolor --nogroup -e %s -- ."
1382 "Used to in place of `counsel-ag-base-command' to search with
1383 pt using `counsel-ag'."
1388 (defun counsel-pt ()
1389 "Grep for a string in the current directory using pt.
1390 This uses `counsel-ag' with `counsel-pt-base-command' replacing
1391 `counsel-ag-base-command'."
1393 (let ((counsel-ag-base-command counsel-pt-base-command))
1394 (call-interactively 'counsel-ag)))
1397 (defcustom counsel-grep-base-command "grep -nE \"%s\" %s"
1398 "Format string to use in `cousel-grep-function' to construct
1403 (defun counsel-grep-function (string)
1404 "Grep in the current directory for STRING."
1405 (if (< (length string) 2)
1406 (counsel-more-chars 2)
1407 (let ((regex (counsel-unquote-regex-parens
1409 (ivy--regex string)))))
1410 (counsel--async-command
1411 (format counsel-grep-base-command regex counsel--git-grep-dir))
1414 (defun counsel-grep-action (x)
1417 (let ((default-directory (file-name-directory counsel--git-grep-dir))
1418 file-name line-number)
1419 (when (cond ((string-match "\\`\\([0-9]+\\):\\(.*\\)\\'" x)
1420 (setq file-name counsel--git-grep-dir)
1421 (setq line-number (match-string-no-properties 1 x)))
1422 ((string-match "\\`\\([^:]+\\):\\([0-9]+\\):\\(.*\\)\\'" x)
1423 (setq file-name (match-string-no-properties 1 x))
1424 (setq line-number (match-string-no-properties 2 x)))
1426 (find-file file-name)
1427 (goto-char (point-min))
1428 (forward-line (1- (string-to-number line-number)))
1429 (re-search-forward (ivy--regex ivy-text t) (line-end-position) t)
1430 (if (eq ivy-exit 'done)
1431 (swiper--ensure-visible)
1432 (isearch-range-invisible (line-beginning-position)
1433 (line-end-position))
1434 (swiper--add-overlays (ivy--regex ivy-text)))))))
1436 (defun counsel-grep-occur ()
1437 "Generate a custom occur buffer for `counsel-grep'."
1438 (unless (eq major-mode 'ivy-occur-grep-mode)
1439 (ivy-occur-grep-mode))
1442 (shell-command-to-string
1443 (format counsel-grep-base-command
1444 (counsel-unquote-regex-parens
1447 (progn (string-match "\"\\(.*\\)\"" (buffer-name))
1448 (match-string 1 (buffer-name))) t)))
1449 counsel--git-grep-dir))
1451 (file (file-name-nondirectory counsel--git-grep-dir)))
1452 ;; Need precise number of header lines for `wgrep' to work.
1453 (insert (format "-*- mode:grep; default-directory: %S -*-\n\n\n"
1455 (insert (format "%d candidates:\n" (length cands)))
1456 (ivy--occur-insert-lines
1458 (lambda (cand) (concat "./" file ":" cand))
1461 (ivy-set-occur 'counsel-grep 'counsel-grep-occur)
1462 (counsel-set-async-exit-code 'counsel-grep 1 "")
1465 (defun counsel-grep ()
1466 "Grep for a string in the current file."
1468 (setq counsel--git-grep-dir (buffer-file-name))
1469 (let ((init-point (point))
1472 (setq res (ivy-read "grep: " 'counsel-grep-function
1473 :dynamic-collection t
1474 :preselect (format "%d:%s"
1475 (line-number-at-pos)
1476 (buffer-substring-no-properties
1477 (line-beginning-position)
1478 (line-end-position)))
1479 :history 'counsel-git-grep-history
1480 :update-fn (lambda ()
1481 (counsel-grep-action ivy--current))
1482 :action #'counsel-grep-action
1484 (counsel-delete-process)
1486 :caller 'counsel-grep))
1488 (goto-char init-point)))))
1490 ;;** `counsel-recoll'
1491 (defun counsel-recoll-function (string)
1492 "Grep in the current directory for STRING."
1493 (if (< (length string) 3)
1494 (counsel-more-chars 3)
1495 (counsel--async-command
1496 (format "recoll -t -b '%s'" string))
1499 ;; This command uses the recollq command line tool that comes together
1500 ;; with the recoll (the document indexing database) source:
1501 ;; http://www.lesbonscomptes.com/recoll/download.html
1502 ;; You need to build it yourself (together with recoll):
1503 ;; cd ./query && make && sudo cp recollq /usr/local/bin
1504 ;; You can try the GUI version of recoll with:
1505 ;; sudo apt-get install recoll
1506 ;; Unfortunately, that does not install recollq.
1507 (defun counsel-recoll (&optional initial-input)
1508 "Search for a string in the recoll database.
1509 You'll be given a list of files that match.
1510 Selecting a file will launch `swiper' for that file.
1511 INITIAL-INPUT can be given as the initial minibuffer input."
1513 (ivy-read "recoll: " 'counsel-recoll-function
1514 :initial-input initial-input
1515 :dynamic-collection t
1516 :history 'counsel-git-grep-history
1518 (when (string-match "file://\\(.*\\)\\'" x)
1519 (let ((file-name (match-string 1 x)))
1520 (find-file file-name)
1521 (unless (string-match "pdf$" x)
1522 (swiper ivy-text)))))
1523 :unwind #'counsel-delete-process
1524 :caller 'counsel-recoll))
1526 ;;** `counsel-org-tag'
1527 (defvar counsel-org-tags nil
1528 "Store the current list of tags.")
1530 (defvar org-outline-regexp)
1531 (defvar org-indent-mode)
1532 (defvar org-indent-indentation-per-level)
1533 (defvar org-tags-column)
1534 (declare-function org-get-tags-string "org")
1535 (declare-function org-move-to-column "org-compat")
1537 (defun counsel-org-change-tags (tags)
1538 (let ((current (org-get-tags-string))
1539 (col (current-column))
1541 ;; Insert new tags at the correct column
1542 (beginning-of-line 1)
1543 (setq level (or (and (looking-at org-outline-regexp)
1544 (- (match-end 0) (point) 1))
1547 ((and (equal current "") (equal tags "")))
1549 (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$")
1555 (goto-char (match-beginning 0))
1556 (let* ((c0 (current-column))
1557 ;; compute offset for the case of org-indent-mode active
1558 (di (if (bound-and-true-p org-indent-mode)
1559 (* (1- org-indent-indentation-per-level) (1- level))
1561 (p0 (if (equal (char-before) ?*) (1+ (point)) (point)))
1562 (tc (+ org-tags-column (if (> org-tags-column 0) (- di) di)))
1563 (c1 (max (1+ c0) (if (> tc 0) tc (- (- tc) (string-width tags)))))
1564 (rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags)))
1565 (replace-match rpl t t)
1566 (and c0 indent-tabs-mode (tabify p0 (point)))
1568 (t (error "Tags alignment failed")))
1569 (org-move-to-column col)))
1571 (defun counsel-org--set-tags ()
1572 (counsel-org-change-tags
1573 (if counsel-org-tags
1575 (mapconcat #'identity counsel-org-tags ":"))
1578 (defvar org-agenda-bulk-marked-entries)
1580 (declare-function org-get-at-bol "org")
1581 (declare-function org-agenda-error "org-agenda")
1583 (defun counsel-org-tag-action (x)
1584 (if (member x counsel-org-tags)
1586 (setq counsel-org-tags (delete x counsel-org-tags)))
1587 (unless (equal x "")
1588 (setq counsel-org-tags (append counsel-org-tags (list x)))
1589 (unless (member x ivy--all-candidates)
1590 (setq ivy--all-candidates (append ivy--all-candidates (list x))))))
1591 (let ((prompt (counsel-org-tag-prompt)))
1592 (setf (ivy-state-prompt ivy-last) prompt)
1593 (setq ivy--prompt (concat "%-4d " prompt)))
1594 (cond ((memq this-command '(ivy-done
1596 ivy-immediate-done))
1597 (if (eq major-mode 'org-agenda-mode)
1598 (if (null org-agenda-bulk-marked-entries)
1599 (let ((hdmarker (or (org-get-at-bol 'org-hd-marker)
1600 (org-agenda-error))))
1601 (with-current-buffer (marker-buffer hdmarker)
1602 (goto-char hdmarker)
1603 (counsel-org--set-tags)))
1604 (let ((add-tags (copy-sequence counsel-org-tags)))
1605 (dolist (m org-agenda-bulk-marked-entries)
1606 (with-current-buffer (marker-buffer m)
1609 (setq counsel-org-tags
1611 (append (split-string (org-get-tags-string) ":" t)
1613 (counsel-org--set-tags))))))
1614 (counsel-org--set-tags)))
1615 ((eq this-command 'ivy-call)
1616 (delete-minibuffer-contents))))
1618 (defun counsel-org-tag-prompt ()
1619 (format "Tags (%s): "
1620 (mapconcat #'identity counsel-org-tags ", ")))
1622 (defvar org-setting-tags)
1623 (defvar org-last-tags-completion-table)
1624 (defvar org-tag-persistent-alist)
1625 (defvar org-tag-alist)
1626 (defvar org-complete-tags-always-offer-all-agenda-tags)
1628 (declare-function org-at-heading-p "org")
1629 (declare-function org-back-to-heading "org")
1630 (declare-function org-get-buffer-tags "org")
1631 (declare-function org-global-tags-completion-table "org")
1632 (declare-function org-agenda-files "org")
1633 (declare-function org-agenda-set-tags "org-agenda")
1636 (defun counsel-org-tag ()
1637 "Add or remove tags in org-mode."
1640 (if (eq major-mode 'org-agenda-mode)
1641 (if org-agenda-bulk-marked-entries
1642 (setq counsel-org-tags nil)
1643 (let ((hdmarker (or (org-get-at-bol 'org-hd-marker)
1644 (org-agenda-error))))
1645 (with-current-buffer (marker-buffer hdmarker)
1646 (goto-char hdmarker)
1647 (setq counsel-org-tags
1648 (split-string (org-get-tags-string) ":" t)))))
1649 (unless (org-at-heading-p)
1650 (org-back-to-heading t))
1651 (setq counsel-org-tags (split-string (org-get-tags-string) ":" t)))
1652 (let ((org-setting-tags t)
1653 (org-last-tags-completion-table
1654 (append org-tag-persistent-alist
1655 (or org-tag-alist (org-get-buffer-tags))
1657 (or org-complete-tags-always-offer-all-agenda-tags
1658 (eq major-mode 'org-agenda-mode))
1659 (org-global-tags-completion-table
1660 (org-agenda-files))))))
1661 (ivy-read (counsel-org-tag-prompt)
1662 (lambda (str &rest _unused)
1664 (all-completions str 'org-tags-completion-function)))
1665 :history 'org-tags-history
1666 :action 'counsel-org-tag-action
1667 :caller 'counsel-org-tag))))
1670 (defun counsel-org-tag-agenda ()
1671 "Set tags for the current agenda item."
1673 (let ((store (symbol-function 'org-set-tags)))
1677 (symbol-function 'counsel-org-tag))
1678 (org-agenda-set-tags nil nil))
1679 (fset 'org-set-tags store))))
1682 (defvar tmm-km-list nil)
1683 (declare-function tmm-get-keymap "tmm")
1684 (declare-function tmm--completion-table "tmm")
1685 (declare-function tmm-get-keybind "tmm")
1687 (defun counsel-tmm-prompt (menu)
1688 "Select and call an item from the MENU keymap."
1692 (setq tmm-km-list nil)
1693 (map-keymap (lambda (k v) (tmm-get-keymap (cons k v))) menu)
1694 (setq tmm-km-list (nreverse tmm-km-list))
1695 (setq out (ivy-read "Menu bar: " (tmm--completion-table tmm-km-list)
1698 (setq choice (cdr (assoc out tmm-km-list)))
1699 (setq chosen-string (car choice))
1700 (setq choice (cdr choice))
1701 (cond ((keymapp choice)
1702 (counsel-tmm-prompt choice))
1703 ((and choice chosen-string)
1704 (setq last-command-event chosen-string)
1705 (call-interactively choice)))))
1707 (defvar tmm-table-undef)
1710 (defun counsel-tmm ()
1711 "Text-mode emulation of looking and choosing from a menubar."
1714 (run-hooks 'menu-bar-update-hook)
1715 (setq tmm-table-undef nil)
1716 (counsel-tmm-prompt (tmm-get-keybind [menu-bar])))
1718 ;;** `counsel-yank-pop'
1719 (defun counsel--yank-pop-truncate (str)
1721 (let* ((lines (split-string str "\n" t))
1723 (first-match (cl-position-if
1724 (lambda (s) (string-match ivy--old-re s))
1726 (beg (max 0 (- first-match
1727 counsel-yank-pop-truncate-radius)))
1728 (end (min n (+ first-match
1729 counsel-yank-pop-truncate-radius
1731 (seq (cl-subseq lines beg end)))
1732 (if (null first-match)
1733 (error "Could not match %s" str)
1735 (setcar seq (concat "[...] " (car seq))))
1738 (concat (car (last seq)) " [...]")))
1739 (mapconcat #'identity seq "\n")))
1742 (defun counsel--yank-pop-format-function (cand-pairs)
1743 (ivy--format-function-generic
1747 (ivy--add-face s 'ivy-current-match))
1749 (counsel--yank-pop-truncate str) "\n" t)
1752 (counsel--yank-pop-truncate str))
1756 (defun counsel-yank-pop-action (s)
1757 "Insert S into the buffer, overwriting the previous yank."
1759 (delete-region ivy-completion-beg
1761 (insert (substring-no-properties s))
1762 (setq ivy-completion-end (point))))
1765 (defun counsel-yank-pop ()
1766 "Ivy replacement for `yank-pop'."
1768 (if (eq last-command 'yank)
1770 (setq ivy-completion-end (point))
1771 (setq ivy-completion-beg
1773 (search-backward (car kill-ring))
1775 (setq ivy-completion-beg (point))
1776 (setq ivy-completion-end (point)))
1777 (let ((candidates (cl-remove-if
1779 (or (< (length s) 3)
1780 (string-match "\\`[\n[:blank:]]+\\'" s)))
1781 (delete-dups kill-ring))))
1782 (let ((ivy-format-function #'counsel--yank-pop-format-function)
1784 (ivy-read "kill-ring: " candidates
1785 :action 'counsel-yank-pop-action
1786 :caller 'counsel-yank-pop))))
1788 ;;** `counsel-imenu'
1789 (defvar imenu-auto-rescan)
1790 (declare-function imenu--subalist-p "imenu")
1791 (declare-function imenu--make-index-alist "imenu")
1793 (defun counsel-imenu-get-candidates-from (alist &optional prefix)
1794 "Create a list of (key . value) from ALIST.
1795 PREFIX is used to create the key."
1796 (cl-mapcan (lambda (elm)
1797 (if (imenu--subalist-p elm)
1798 (counsel-imenu-get-candidates-from
1799 (cl-loop for (e . v) in (cdr elm) collect
1800 (cons e (if (integerp v) (copy-marker v) v)))
1801 ;; pass the prefix to next recursive call
1802 (concat prefix (if prefix ".") (car elm)))
1803 (let ((key (concat prefix (if prefix ".") (car elm))))
1805 ;; create a imenu candidate here
1806 (cons key (if (overlayp (cdr elm))
1807 (overlay-start (cdr elm))
1812 (defun counsel-imenu ()
1813 "Jump to a buffer position indexed by imenu."
1815 (unless (featurep 'imenu)
1816 (require 'imenu nil t))
1817 (let* ((imenu-auto-rescan t)
1818 (items (imenu--make-index-alist t))
1819 (items (delete (assoc "*Rescan*" items) items)))
1820 (ivy-read "imenu items:" (counsel-imenu-get-candidates-from items)
1821 :preselect (thing-at-point 'symbol)
1823 :action (lambda (candidate)
1825 ;; In org-mode, (imenu candidate) will expand child node
1826 ;; after jump to the candidate position
1828 :caller 'counsel-imenu)))
1830 ;;** `counsel-list-processes'
1831 (defun counsel-list-processes-action-delete (x)
1833 (setf (ivy-state-collection ivy-last)
1834 (setq ivy--all-candidates
1835 (delete x ivy--all-candidates))))
1837 (defun counsel-list-processes-action-switch (x)
1838 (let* ((proc (get-process x))
1839 (buf (and proc (process-buffer proc))))
1841 (switch-to-buffer buf)
1842 (message "Process %s doesn't have a buffer" x))))
1845 (defun counsel-list-processes ()
1846 "Offer completion for `process-list'
1847 The default action deletes the selected process.
1848 An extra action allows to switch to the process buffer."
1850 (list-processes--refresh)
1851 (ivy-read "Process: " (mapcar #'process-name (process-list))
1855 ("o" counsel-list-processes-action-delete "kill")
1856 ("s" counsel-list-processes-action-switch "switch"))
1857 :caller 'counsel-list-processes))
1859 ;;** `counsel-ace-link'
1860 (defun counsel-ace-link ()
1861 "Use Ivy completion for `ace-link'."
1863 (let (collection action)
1864 (cond ((eq major-mode 'Info-mode)
1865 (setq collection 'ace-link--info-collect)
1866 (setq action 'ace-link--info-action))
1867 ((eq major-mode 'help-mode)
1868 (setq collection 'ace-link--help-collect)
1869 (setq action 'ace-link--help-action))
1870 ((eq major-mode 'woman-mode)
1871 (setq collection 'ace-link--woman-collect)
1872 (setq action 'ace-link--woman-action))
1873 ((eq major-mode 'eww-mode)
1874 (setq collection 'ace-link--eww-collect)
1875 (setq action 'ace-link--eww-action))
1876 ((eq major-mode 'compilation-mode)
1877 (setq collection 'ace-link--eww-collect)
1878 (setq action 'ace-link--compilation-action))
1879 ((eq major-mode 'org-mode)
1880 (setq collection 'ace-link--org-collect)
1881 (setq action 'ace-link--org-action)))
1882 (if (null collection)
1883 (error "%S is not supported" major-mode)
1884 (ivy-read "Ace-Link: " (funcall collection)
1887 :caller 'counsel-ace-link))))
1888 ;;** `counsel-expression-history'
1890 (defun counsel-expression-history ()
1891 "Select an element of `read-expression-history'.
1892 And insert it into the minibuffer. Useful during
1895 (let ((enable-recursive-minibuffers t))
1896 (ivy-read "Expr: " (delete-dups read-expression-history)
1900 ;;** `counsel-rhythmbox'
1901 (defvar helm-rhythmbox-library)
1902 (declare-function helm-rhythmbox-load-library "ext:helm-rhythmbox")
1903 (declare-function dbus-call-method "dbus")
1904 (declare-function dbus-get-property "dbus")
1905 (declare-function helm-rhythmbox-song-uri "ext:helm-rhythmbox")
1906 (declare-function helm-rhythmbox-candidates "ext:helm-rhythmbox")
1908 (defun counsel-rhythmbox-enqueue-song (song)
1909 "Let Rhythmbox enqueue SONG."
1910 (let ((service "org.gnome.Rhythmbox3")
1911 (path "/org/gnome/Rhythmbox3/PlayQueue")
1912 (interface "org.gnome.Rhythmbox3.PlayQueue"))
1913 (dbus-call-method :session service path interface
1914 "AddToQueue" (helm-rhythmbox-song-uri song))))
1916 (defvar counsel-rhythmbox-history nil
1917 "History for `counsel-rhythmbox'.")
1919 (defun counsel-rhythmbox-current-song ()
1920 "Return the currently playing song title."
1922 (let* ((entry (dbus-get-property
1924 "org.mpris.MediaPlayer2.rhythmbox"
1925 "/org/mpris/MediaPlayer2"
1926 "org.mpris.MediaPlayer2.Player"
1928 (artist (caar (cadr (assoc "xesam:artist" entry))))
1929 (album (cl-caadr (assoc "xesam:album" entry)))
1930 (title (cl-caadr (assoc "xesam:title" entry))))
1931 (format "%s - %s - %s" artist album title))))
1934 (defun counsel-rhythmbox ()
1935 "Choose a song from the Rhythmbox library to play or enqueue."
1937 (unless (require 'helm-rhythmbox nil t)
1938 (error "Please install `helm-rhythmbox'"))
1939 (unless helm-rhythmbox-library
1940 (helm-rhythmbox-load-library)
1941 (while (null helm-rhythmbox-library)
1943 (ivy-read "Rhythmbox: "
1944 (helm-rhythmbox-candidates)
1945 :history 'counsel-rhythmbox-history
1946 :preselect (counsel-rhythmbox-current-song)
1949 ("p" helm-rhythmbox-play-song "Play song")
1950 ("e" counsel-rhythmbox-enqueue-song "Enqueue song"))
1951 :caller 'counsel-rhythmbox))
1952 ;;** `counsel-linux-app'
1953 (defvar counsel-linux-apps-alist nil
1954 "List of data located in /usr/share/applications.")
1956 (defvar counsel-linux-apps-faulty nil
1957 "List of faulty data located in /usr/share/applications.")
1959 (defun counsel-linux-apps-list ()
1963 "." (file-expand-wildcards "/usr/share/applications/*.desktop")))))
1964 (dolist (file (cl-set-difference files (append (mapcar 'car counsel-linux-apps-alist)
1965 counsel-linux-apps-faulty)
1968 (insert-file-contents (expand-file-name file "/usr/share/applications"))
1969 (let (name comment exec)
1970 (goto-char (point-min))
1971 (if (re-search-forward "^Name *= *\\(.*\\)$" nil t)
1972 (setq name (match-string 1))
1973 (error "File %s has no Name" file))
1974 (goto-char (point-min))
1975 (when (re-search-forward "^Comment *= *\\(.*\\)$" nil t)
1976 (setq comment (match-string 1)))
1977 (goto-char (point-min))
1978 (when (re-search-forward "^Exec *= *\\(.*\\)$" nil t)
1979 (setq exec (match-string 1)))
1980 (if (and exec (not (equal exec "")))
1982 'counsel-linux-apps-alist
1983 (cons (format "% -45s: %s%s"
1984 (propertize exec 'face 'font-lock-builtin-face)
1987 (concat " - " comment)
1990 (add-to-list 'counsel-linux-apps-faulty file))))))
1991 counsel-linux-apps-alist)
1993 (defun counsel-linux-app-action-default (desktop-shortcut)
1994 "Launch DESKTOP-SHORTCUT."
1995 (call-process-shell-command
1996 (format "gtk-launch %s" (file-name-nondirectory desktop-shortcut))))
1998 (defun counsel-linux-app-action-file (desktop-shortcut)
1999 "Launch DESKTOP-SHORTCUT with a selected file."
2000 (let* ((entry (rassoc desktop-shortcut counsel-linux-apps-alist))
2001 (short-name (and entry
2002 (string-match "\\([^ ]*\\) " (car entry))
2003 (match-string 1 (car entry))))
2004 (file (and short-name
2006 (format "Run %s on: " short-name)))))
2008 (call-process-shell-command
2009 (format "gtk-launch %s %s"
2010 (file-name-nondirectory desktop-shortcut)
2012 (user-error "cancelled"))))
2016 '(("f" counsel-linux-app-action-file "run on a file")))
2019 (defun counsel-linux-app ()
2020 "Launch a Linux desktop application, similar to Alt-<F2>."
2022 (ivy-read "Run a command: " (counsel-linux-apps-list)
2023 :action #'counsel-linux-app-action-default
2024 :caller 'counsel-linux-app))
2027 (defvar counsel-mode-map
2028 (let ((map (make-sparse-keymap)))
2030 '((execute-extended-command . counsel-M-x)
2031 (describe-bindings . counsel-descbinds)
2032 (describe-function . counsel-describe-function)
2033 (describe-variable . counsel-describe-variable)
2034 (find-file . counsel-find-file)
2035 (imenu . counsel-imenu)
2036 (load-library . counsel-load-library)
2037 (load-theme . counsel-load-theme)
2038 (yank-pop . counsel-yank-pop)))
2039 (define-key map (vector 'remap (car binding)) (cdr binding)))
2041 "Map for `counsel-mode'. Remaps built-in functions to counsel
2044 (defcustom counsel-mode-override-describe-bindings nil
2045 "Whether to override `describe-bindings' when `counsel-mode' is
2051 (define-minor-mode counsel-mode
2052 "Toggle Counsel mode on or off.
2053 Turn Counsel mode on if ARG is positive, off otherwise. Counsel
2054 mode remaps built-in emacs functions that have counsel
2058 :keymap counsel-mode-map
2061 (when (and (fboundp 'advice-add)
2062 counsel-mode-override-describe-bindings)
2063 (advice-add #'describe-bindings :override #'counsel-descbinds))
2064 (when (fboundp 'advice-remove)
2065 (advice-remove #'describe-bindings #'counsel-descbinds))))
2069 ;;; counsel.el ends here