]> code.delx.au - gnu-emacs-elpa/blob - counsel.el
(counsel-locate): Allow customizing locate options
[gnu-emacs-elpa] / counsel.el
1 ;;; counsel.el --- Various completion functions using Ivy -*- lexical-binding: t -*-
2
3 ;; Copyright (C) 2015 Free Software Foundation, Inc.
4
5 ;; Author: Oleh Krehel <ohwoeowho@gmail.com>
6 ;; URL: https://github.com/abo-abo/swiper
7 ;; Version: 0.1.0
8 ;; Package-Requires: ((emacs "24.1") (swiper "0.4.0"))
9 ;; Keywords: completion, matching
10
11 ;; This file is part of GNU Emacs.
12
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)
16 ;; any later version.
17
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.
22
23 ;; For a full copy of the GNU General Public License
24 ;; see <http://www.gnu.org/licenses/>.
25
26 ;;; Commentary:
27 ;;
28 ;; Just call one of the interactive functions in this file to complete
29 ;; the corresponding thing using `ivy'.
30 ;;
31 ;; Currently available: Elisp symbols, Clojure symbols, Git files.
32
33 ;;; Code:
34
35 (require 'swiper)
36
37 (defvar counsel-completion-beg nil
38 "Completion bounds start.")
39
40 (defvar counsel-completion-end nil
41 "Completion bounds end.")
42
43 ;;;###autoload
44 (defun counsel-el ()
45 "Elisp completion at point."
46 (interactive)
47 (let* ((bnd (unless (and (looking-at ")")
48 (eq (char-before) ?\())
49 (bounds-of-thing-at-point
50 'symbol)))
51 (str (if bnd
52 (buffer-substring-no-properties
53 (car bnd)
54 (cdr bnd))
55 ""))
56 (ivy-height 7)
57 (funp (eq (char-before (car bnd)) ?\())
58 symbol-names)
59 (if bnd
60 (progn
61 (setq counsel-completion-beg
62 (move-marker (make-marker) (car bnd)))
63 (setq counsel-completion-end
64 (move-marker (make-marker) (cdr bnd))))
65 (setq counsel-completion-beg nil)
66 (setq counsel-completion-end nil))
67 (if (string= str "")
68 (mapatoms
69 (lambda (x)
70 (when (symbolp x)
71 (push (symbol-name x) symbol-names))))
72 (setq symbol-names
73 (all-completions str obarray
74 (and funp
75 (lambda (x)
76 (or (functionp x)
77 (macrop x)
78 (special-form-p x)))))))
79 (ivy-read "Symbol name: " symbol-names
80 :predicate (and funp #'functionp)
81 :initial-input str
82 :action #'counsel--el-action)))
83
84 (defun counsel--el-action (symbol)
85 "Insert SYMBOL, erasing the previous one."
86 (when (stringp symbol)
87 (when counsel-completion-beg
88 (delete-region
89 counsel-completion-beg
90 counsel-completion-end))
91 (setq counsel-completion-beg
92 (move-marker (make-marker) (point)))
93 (insert symbol)
94 (setq counsel-completion-end
95 (move-marker (make-marker) (point)))))
96
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)
101 map))
102
103 (defun counsel-find-symbol ()
104 "Jump to the definition of the current symbol."
105 (interactive)
106 (ivy-set-action #'counsel--find-symbol)
107 (ivy-done))
108
109 (defun counsel--info-lookup-symbol ()
110 "Lookup the current symbol in the info docs."
111 (interactive)
112 (ivy-set-action #'counsel-info-lookup-symbol)
113 (ivy-done))
114
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)))
118 (if full-name
119 (find-library full-name)
120 (let ((sym (read x)))
121 (cond ((boundp sym)
122 (find-variable sym))
123 ((fboundp sym)
124 (find-function sym))
125 ((or (featurep sym)
126 (locate-library
127 (prin1-to-string sym)))
128 (find-library
129 (prin1-to-string sym)))
130 (t
131 (error "Couldn't fild definition of %s"
132 sym)))))))
133
134 (defvar counsel-describe-symbol-history nil
135 "History for `counsel-describe-variable' and `counsel-describe-function'.")
136
137 (defun counsel-symbol-at-point ()
138 "Return current symbol at point as a string."
139 (let ((s (thing-at-point 'symbol)))
140 (and (stringp s)
141 (if (string-match "\\`[`']?\\(.*\\)'?\\'" s)
142 (match-string 1 s)
143 s))))
144
145 (defun counsel-variable-list ()
146 "Return the list of all currently bound variables."
147 (let (cands)
148 (mapatoms
149 (lambda (vv)
150 (when (or (get vv 'variable-documentation)
151 (and (boundp vv) (not (keywordp vv))))
152 (push (symbol-name vv) cands))))
153 cands))
154
155 ;;;###autoload
156 (defun counsel-describe-variable ()
157 "Forward to `describe-variable'."
158 (interactive)
159 (let ((enable-recursive-minibuffers t))
160 (ivy-read
161 "Describe variable: "
162 (counsel-variable-list)
163 :keymap counsel-describe-map
164 :preselect (counsel-symbol-at-point)
165 :history 'counsel-describe-symbol-history
166 :require-match t
167 :sort t
168 :action (lambda (x)
169 (describe-variable
170 (intern x))))))
171
172 (ivy-set-actions
173 'counsel-describe-variable
174 '(("i" counsel-info-lookup-symbol "info")
175 ("d" counsel--find-symbol "definition")))
176
177 (ivy-set-actions
178 'counsel-describe-function
179 '(("i" counsel-info-lookup-symbol "info")
180 ("d" counsel--find-symbol "definition")))
181
182 ;;;###autoload
183 (defun counsel-describe-function ()
184 "Forward to `describe-function'."
185 (interactive)
186 (let ((enable-recursive-minibuffers t))
187 (ivy-read "Describe function: "
188 (let (cands)
189 (mapatoms
190 (lambda (x)
191 (when (fboundp x)
192 (push (symbol-name x) cands))))
193 cands)
194 :keymap counsel-describe-map
195 :preselect (counsel-symbol-at-point)
196 :history 'counsel-describe-symbol-history
197 :require-match t
198 :sort t
199 :action (lambda (x)
200 (describe-function
201 (intern x))))))
202
203 (defvar info-lookup-mode)
204 (declare-function info-lookup->completions "info-look")
205 (declare-function info-lookup->mode-value "info-look")
206 (declare-function info-lookup-select-mode "info-look")
207 (declare-function info-lookup-change-mode "info-look")
208 (declare-function info-lookup "info-look")
209
210 ;;;###autoload
211 (defun counsel-info-lookup-symbol (symbol &optional mode)
212 "Forward to (`info-describe-symbol' SYMBOL MODE) with ivy completion."
213 (interactive
214 (progn
215 (require 'info-look)
216 (let* ((topic 'symbol)
217 (mode (cond (current-prefix-arg
218 (info-lookup-change-mode topic))
219 ((info-lookup->mode-value
220 topic (info-lookup-select-mode))
221 info-lookup-mode)
222 ((info-lookup-change-mode topic))))
223 (completions (info-lookup->completions topic mode))
224 (enable-recursive-minibuffers t)
225 (value (ivy-read
226 "Describe symbol: "
227 (mapcar #'car completions)
228 :sort t)))
229 (list value info-lookup-mode))))
230 (require 'info-look)
231 (info-lookup 'symbol symbol mode))
232
233 ;;;###autoload
234 (defun counsel-unicode-char ()
235 "Insert a Unicode character at point."
236 (interactive)
237 (let ((minibuffer-allow-text-properties t))
238 (ivy-read "Unicode name: "
239 (mapcar (lambda (x)
240 (propertize
241 (format "% -60s%c" (car x) (cdr x))
242 'result (cdr x)))
243 (ucs-names))
244 :action (lambda (char)
245 (insert-char (get-text-property 0 'result char))))))
246
247 (declare-function cider-sync-request:complete "ext:cider-client")
248 ;;;###autoload
249 (defun counsel-clj ()
250 "Clojure completion at point."
251 (interactive)
252 (counsel--generic
253 (lambda (str)
254 (mapcar
255 #'cl-caddr
256 (cider-sync-request:complete str ":same")))))
257
258 ;;;###autoload
259 (defun counsel-git ()
260 "Find file in the current Git repository."
261 (interactive)
262 (let* ((default-directory (locate-dominating-file
263 default-directory ".git"))
264 (cands (split-string
265 (shell-command-to-string
266 "git ls-files --full-name --")
267 "\n"
268 t))
269 (action (lambda (x) (find-file x))))
270 (ivy-read "Find file: " cands
271 :action action)))
272
273 (defvar counsel--git-grep-dir nil
274 "Store the base git directory.")
275
276 (defvar counsel--git-grep-count nil
277 "Store the line count in current repository.")
278
279 (defun counsel-more-chars (n)
280 "Return two fake candidates prompting for at least N input."
281 (list ""
282 (format "%d chars more" (- n (length ivy-text)))))
283
284 (defun counsel-git-grep-function (string &optional _pred &rest _unused)
285 "Grep in the current git repository for STRING."
286 (if (and (> counsel--git-grep-count 20000)
287 (< (length string) 3))
288 (counsel-more-chars 3)
289 (let* ((default-directory counsel--git-grep-dir)
290 (cmd (format "git --no-pager grep --full-name -n --no-color -i -e %S"
291 (ivy--regex string t))))
292 (if (<= counsel--git-grep-count 20000)
293 (split-string (shell-command-to-string cmd) "\n" t)
294 (counsel--gg-candidates (ivy--regex string))
295 nil))))
296
297 (defvar counsel-git-grep-map
298 (let ((map (make-sparse-keymap)))
299 (define-key map (kbd "C-l") 'counsel-git-grep-recenter)
300 map))
301
302 (defun counsel-git-grep-recenter ()
303 (interactive)
304 (with-ivy-window
305 (counsel-git-grep-action ivy--current)
306 (recenter-top-bottom)))
307
308 (defun counsel-git-grep-action (x)
309 (when (string-match "\\`\\(.*?\\):\\([0-9]+\\):\\(.*\\)\\'" x)
310 (with-ivy-window
311 (let ((file-name (match-string-no-properties 1 x))
312 (line-number (match-string-no-properties 2 x)))
313 (find-file (expand-file-name file-name counsel--git-grep-dir))
314 (goto-char (point-min))
315 (forward-line (1- (string-to-number line-number)))
316 (re-search-forward (ivy--regex ivy-text t) (line-end-position) t)
317 (unless (eq ivy-exit 'done)
318 (swiper--cleanup)
319 (swiper--add-overlays (ivy--regex ivy-text)))))))
320
321 (defvar counsel-git-grep-history nil
322 "History for `counsel-git-grep'.")
323
324 ;;;###autoload
325 (defun counsel-git-grep (&optional initial-input)
326 "Grep for a string in the current git repository.
327 INITIAL-INPUT can be given as the initial minibuffer input."
328 (interactive)
329 (setq counsel--git-grep-dir
330 (locate-dominating-file default-directory ".git"))
331 (if (null counsel--git-grep-dir)
332 (error "Not in a git repository")
333 (setq counsel--git-grep-count (counsel--gg-count "" t))
334 (ivy-read "git grep: " 'counsel-git-grep-function
335 :initial-input initial-input
336 :matcher #'counsel-git-grep-matcher
337 :dynamic-collection (> counsel--git-grep-count 20000)
338 :keymap counsel-git-grep-map
339 :action #'counsel-git-grep-action
340 :unwind #'swiper--cleanup
341 :history 'counsel-git-grep-history)))
342
343 (defcustom counsel-find-file-at-point nil
344 "When non-nil, add file-at-point to the list of candidates."
345 :type 'boolean
346 :group 'ivy)
347
348 (declare-function ffap-guesser "ffap")
349
350 (defvar counsel-find-file-map (make-sparse-keymap))
351
352 ;;;###autoload
353 (defun counsel-find-file ()
354 "Forward to `find-file'."
355 (interactive)
356 (ivy-read "Find file: " 'read-file-name-internal
357 :matcher #'counsel--find-file-matcher
358 :action
359 (lambda (x)
360 (with-ivy-window
361 (find-file (expand-file-name x ivy--directory))))
362 :preselect (when counsel-find-file-at-point
363 (require 'ffap)
364 (ffap-guesser))
365 :require-match 'confirm-after-completion
366 :history 'file-name-history
367 :keymap counsel-find-file-map))
368
369 (defcustom counsel-find-file-ignore-regexp nil
370 "A regexp of files to ignore while in `counsel-find-file'.
371 These files are un-ignored if `ivy-text' matches them.
372 The common way to show all files is to start `ivy-text' with a dot.
373 Possible value: \"\\(?:\\`[#.]\\)\\|\\(?:[#~]\\'\\)\"."
374 :group 'ivy)
375
376 (defun counsel--find-file-matcher (regexp candidates)
377 "Return REGEXP-matching CANDIDATES.
378 Skip some dotfiles unless `ivy-text' requires them."
379 (let ((res (cl-remove-if-not
380 (lambda (x)
381 (string-match regexp x))
382 candidates)))
383 (if (or (null counsel-find-file-ignore-regexp)
384 (string-match counsel-find-file-ignore-regexp ivy-text))
385 res
386 (cl-remove-if
387 (lambda (x)
388 (string-match counsel-find-file-ignore-regexp x))
389 res))))
390
391 (defun counsel-git-grep-matcher (regexp candidates)
392 (or (and (equal regexp ivy--old-re)
393 ivy--old-cands)
394 (prog1
395 (setq ivy--old-cands
396 (cl-remove-if-not
397 (lambda (x)
398 (ignore-errors
399 (when (string-match "^[^:]+:[^:]+:" x)
400 (setq x (substring x (match-end 0)))
401 (if (stringp regexp)
402 (string-match regexp x)
403 (let ((res t))
404 (dolist (re regexp)
405 (setq res
406 (and res
407 (ignore-errors
408 (if (cdr re)
409 (string-match (car re) x)
410 (not (string-match (car re) x)))))))
411 res)))))
412 candidates))
413 (setq ivy--old-re regexp))))
414
415 (defun counsel--async-command (cmd)
416 (let* ((counsel--process " *counsel*")
417 (proc (get-process counsel--process))
418 (buff (get-buffer counsel--process)))
419 (when proc
420 (delete-process proc))
421 (when buff
422 (kill-buffer buff))
423 (setq proc (start-process-shell-command
424 counsel--process
425 counsel--process
426 cmd))
427 (set-process-sentinel proc #'counsel--async-sentinel)))
428
429 (defun counsel--async-sentinel (process event)
430 (if (string= event "finished\n")
431 (progn
432 (with-current-buffer (process-buffer process)
433 (setq ivy--all-candidates (split-string (buffer-string) "\n" t))
434 (setq ivy--old-cands ivy--all-candidates))
435 (ivy--exhibit))
436 (if (string= event "exited abnormally with code 1\n")
437 (progn
438 (setq ivy--all-candidates '("Error"))
439 (setq ivy--old-cands ivy--all-candidates)
440 (ivy--exhibit)))))
441
442 (defun counsel-locate-action-extern (x)
443 "Use xdg-open shell command on X."
444 (call-process shell-file-name nil
445 nil nil
446 shell-command-switch
447 (format "xdg-open %s" (shell-quote-argument x))))
448
449 (declare-function dired-jump "dired-x")
450 (defun counsel-locate-action-dired (x)
451 "Use `dired-jump' on X."
452 (dired-jump nil x))
453
454 (defvar counsel-locate-history nil
455 "History for `counsel-locate'.")
456
457 (defcustom counsel-locate-options '("-i" "--regex")
458 "Command line options for `locate`."
459 :group 'ivy
460 :type '(repeat string))
461
462 (ivy-set-actions
463 'counsel-locate
464 '(("x" counsel-locate-action-extern "xdg-open")
465 ("d" counsel-locate-action-dired "dired")))
466
467 (defun counsel-locate-function (str &rest _u)
468 (if (< (length str) 3)
469 (counsel-more-chars 3)
470 (counsel--async-command
471 (concat "locate "
472 (mapconcat #'identity counsel-locate-options " ")
473 " "
474 (ivy--regex str)))
475 '("" "working...")))
476
477 ;;;###autoload
478 (defun counsel-locate ()
479 "Call locate shell command."
480 (interactive)
481 (ivy-read "Locate: " #'counsel-locate-function
482 :dynamic-collection t
483 :history 'counsel-locate-history
484 :action (lambda (file)
485 (when file
486 (find-file file)))))
487
488 (defun counsel--generic (completion-fn)
489 "Complete thing at point with COMPLETION-FN."
490 (let* ((bnd (bounds-of-thing-at-point 'symbol))
491 (str (if bnd
492 (buffer-substring-no-properties
493 (car bnd) (cdr bnd))
494 ""))
495 (candidates (funcall completion-fn str))
496 (ivy-height 7)
497 (res (ivy-read (format "pattern (%s): " str)
498 candidates)))
499 (when (stringp res)
500 (when bnd
501 (delete-region (car bnd) (cdr bnd)))
502 (insert res))))
503
504 (defun counsel-directory-parent (dir)
505 "Return the directory parent of directory DIR."
506 (concat (file-name-nondirectory
507 (directory-file-name dir)) "/"))
508
509 (defun counsel-string-compose (prefix str)
510 "Make PREFIX the display prefix of STR though text properties."
511 (let ((str (copy-sequence str)))
512 (put-text-property
513 0 1 'display
514 (concat prefix (substring str 0 1))
515 str)
516 str))
517
518 ;;;###autoload
519 (defun counsel-load-library ()
520 "Load a selected the Emacs Lisp library.
521 The libraries are offered from `load-path'."
522 (interactive)
523 (let ((dirs load-path)
524 (suffix (concat (regexp-opt '(".el" ".el.gz") t) "\\'"))
525 (cands (make-hash-table :test #'equal))
526 short-name
527 old-val
528 dir-parent
529 res)
530 (dolist (dir dirs)
531 (when (file-directory-p dir)
532 (dolist (file (file-name-all-completions "" dir))
533 (when (string-match suffix file)
534 (unless (string-match "pkg.elc?$" file)
535 (setq short-name (substring file 0 (match-beginning 0)))
536 (if (setq old-val (gethash short-name cands))
537 (progn
538 ;; assume going up directory once will resolve name clash
539 (setq dir-parent (counsel-directory-parent (cdr old-val)))
540 (puthash short-name
541 (cons
542 (counsel-string-compose dir-parent (car old-val))
543 (cdr old-val))
544 cands)
545 (setq dir-parent (counsel-directory-parent dir))
546 (puthash (concat dir-parent short-name)
547 (cons
548 (propertize
549 (counsel-string-compose
550 dir-parent short-name)
551 'full-name (expand-file-name file dir))
552 dir)
553 cands))
554 (puthash short-name
555 (cons (propertize
556 short-name
557 'full-name (expand-file-name file dir))
558 dir) cands)))))))
559 (maphash (lambda (_k v) (push (car v) res)) cands)
560 (ivy-read "Load library: " (nreverse res)
561 :action (lambda (x)
562 (load-library
563 (get-text-property 0 'full-name x)))
564 :keymap counsel-describe-map)))
565
566 (defvar counsel-gg-state nil
567 "The current state of candidates / count sync.")
568
569 (defun counsel--gg-candidates (regex)
570 "Return git grep candidates for REGEX."
571 (setq counsel-gg-state -2)
572 (counsel--gg-count regex)
573 (let* ((default-directory counsel--git-grep-dir)
574 (counsel-gg-process " *counsel-gg*")
575 (proc (get-process counsel-gg-process))
576 (buff (get-buffer counsel-gg-process)))
577 (when proc
578 (delete-process proc))
579 (when buff
580 (kill-buffer buff))
581 (setq proc (start-process-shell-command
582 counsel-gg-process
583 counsel-gg-process
584 (format "git --no-pager grep --full-name -n --no-color -i -e %S | head -n 200"
585 regex)))
586 (set-process-sentinel
587 proc
588 #'counsel--gg-sentinel)))
589
590 (defun counsel--gg-sentinel (process event)
591 (if (string= event "finished\n")
592 (progn
593 (with-current-buffer (process-buffer process)
594 (setq ivy--all-candidates (split-string (buffer-string) "\n" t))
595 (setq ivy--old-cands ivy--all-candidates))
596 (when (= 0 (cl-incf counsel-gg-state))
597 (ivy--exhibit)))
598 (if (string= event "exited abnormally with code 1\n")
599 (progn
600 (setq ivy--all-candidates '("Error"))
601 (setq ivy--old-cands ivy--all-candidates)
602 (ivy--exhibit)))))
603
604 (defun counsel--gg-count (regex &optional no-async)
605 "Quickly and asynchronously count the amount of git grep REGEX matches.
606 When NO-ASYNC is non-nil, do it synchronously."
607 (let ((default-directory counsel--git-grep-dir)
608 (cmd (format "git grep -i -c '%s' | sed 's/.*:\\(.*\\)/\\1/g' | awk '{s+=$1} END {print s}'"
609 regex))
610 (counsel-ggc-process " *counsel-gg-count*"))
611 (if no-async
612 (string-to-number (shell-command-to-string cmd))
613 (let ((proc (get-process counsel-ggc-process))
614 (buff (get-buffer counsel-ggc-process)))
615 (when proc
616 (delete-process proc))
617 (when buff
618 (kill-buffer buff))
619 (setq proc (start-process-shell-command
620 counsel-ggc-process
621 counsel-ggc-process
622 cmd))
623 (set-process-sentinel
624 proc
625 #'(lambda (process event)
626 (when (string= event "finished\n")
627 (with-current-buffer (process-buffer process)
628 (setq ivy--full-length (string-to-number (buffer-string))))
629 (when (= 0 (cl-incf counsel-gg-state))
630 (ivy--exhibit)))))))))
631
632 (defun counsel--M-x-transformer (cmd)
633 "Add a binding to CMD if it's bound in the current window.
634 CMD is a command name."
635 (let ((binding (substitute-command-keys (format "\\[%s]" cmd))))
636 (setq binding (replace-regexp-in-string "C-x 6" "<f2>" binding))
637 (if (string-match "^M-x" binding)
638 cmd
639 (format "%s (%s)" cmd
640 (propertize binding 'face 'font-lock-keyword-face)))))
641
642 (defvar smex-initialized-p)
643 (defvar smex-ido-cache)
644 (declare-function smex-initialize "ext:smex")
645 (declare-function smex-detect-new-commands "ext:smex")
646 (declare-function smex-update "ext:smex")
647 (declare-function smex-rank "ext:smex")
648 (declare-function package-installed-p "package")
649
650 ;;;###autoload
651 (defun counsel-M-x (&optional initial-input)
652 "Ivy version of `execute-extended-command'.
653 Optional INITIAL-INPUT is the initial input in the minibuffer."
654 (interactive)
655 (unless initial-input
656 (setq initial-input (cdr (assoc this-command
657 ivy-initial-inputs-alist))))
658 (let* ((store ivy-format-function)
659 (ivy-format-function
660 (lambda (cands)
661 (funcall
662 store
663 (with-ivy-window
664 (mapcar #'counsel--M-x-transformer cands)))))
665 (cands obarray)
666 (pred 'commandp)
667 (sort t))
668 (when (or (featurep 'smex)
669 (package-installed-p 'smex))
670 (require 'smex)
671 (unless smex-initialized-p
672 (smex-initialize))
673 (smex-detect-new-commands)
674 (smex-update)
675 (setq cands smex-ido-cache)
676 (setq pred nil)
677 (setq sort nil))
678 (ivy-read "M-x " cands
679 :predicate pred
680 :require-match t
681 :history 'extended-command-history
682 :action
683 (lambda (cmd)
684 (when (featurep 'smex)
685 (smex-rank (intern cmd)))
686 (let ((prefix-arg current-prefix-arg))
687 (command-execute (intern cmd) 'record)))
688 :sort sort
689 :keymap counsel-describe-map
690 :initial-input initial-input)))
691
692 (declare-function powerline-reset "ext:powerline")
693
694 (defun counsel--load-theme-action (x)
695 "Disable current themes and load theme X."
696 (condition-case nil
697 (progn
698 (mapc #'disable-theme custom-enabled-themes)
699 (load-theme (intern x))
700 (when (fboundp 'powerline-reset)
701 (powerline-reset)))
702 (error "Problem loading theme %s" x)))
703
704 ;;;###autoload
705 (defun counsel-load-theme ()
706 "Forward to `load-theme'.
707 Usable with `ivy-resume', `ivy-next-line-and-call' and
708 `ivy-previous-line-and-call'."
709 (interactive)
710 (ivy-read "Load custom theme: "
711 (mapcar 'symbol-name
712 (custom-available-themes))
713 :action #'counsel--load-theme-action))
714
715 (defvar rhythmbox-library)
716 (declare-function rhythmbox-load-library "ext:helm-rhythmbox")
717 (declare-function dbus-call-method "dbus")
718 (declare-function rhythmbox-song-uri "ext:helm-rhythmbox")
719 (declare-function helm-rhythmbox-candidates "ext:helm-rhythmbox")
720
721 (defun counsel-rhythmbox-enqueue-song (song)
722 "Let Rhythmbox enqueue SONG."
723 (let ((service "org.gnome.Rhythmbox3")
724 (path "/org/gnome/Rhythmbox3/PlayQueue")
725 (interface "org.gnome.Rhythmbox3.PlayQueue"))
726 (dbus-call-method :session service path interface
727 "AddToQueue" (rhythmbox-song-uri song))))
728
729 (defvar counsel-rhythmbox-history nil
730 "History for `counsel-rhythmbox'.")
731
732 ;;;###autoload
733 (defun counsel-rhythmbox ()
734 "Choose a song from the Rhythmbox library to play or enqueue."
735 (interactive)
736 (unless (require 'helm-rhythmbox nil t)
737 (error "Please install `helm-rhythmbox'"))
738 (unless rhythmbox-library
739 (rhythmbox-load-library)
740 (while (null rhythmbox-library)
741 (sit-for 0.1)))
742 (ivy-read "Rhythmbox: "
743 (helm-rhythmbox-candidates)
744 :history 'counsel-rhythmbox-history
745 :action
746 '(1
747 ("p" helm-rhythmbox-play-song "Play song")
748 ("e" counsel-rhythmbox-enqueue-song "Enqueue song"))))
749
750 (defvar counsel-org-tags nil
751 "Store the current list of tags.")
752
753 (defvar org-outline-regexp)
754 (defvar org-indent-mode)
755 (defvar org-indent-indentation-per-level)
756 (defvar org-tags-column)
757 (declare-function org-get-tags-string "org")
758 (declare-function org-move-to-column "org")
759
760 (defun counsel-org-change-tags (tags)
761 (let ((current (org-get-tags-string))
762 (col (current-column))
763 level)
764 ;; Insert new tags at the correct column
765 (beginning-of-line 1)
766 (setq level (or (and (looking-at org-outline-regexp)
767 (- (match-end 0) (point) 1))
768 1))
769 (cond
770 ((and (equal current "") (equal tags "")))
771 ((re-search-forward
772 (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$")
773 (point-at-eol) t)
774 (if (equal tags "")
775 (delete-region
776 (match-beginning 0)
777 (match-end 0))
778 (goto-char (match-beginning 0))
779 (let* ((c0 (current-column))
780 ;; compute offset for the case of org-indent-mode active
781 (di (if (bound-and-true-p org-indent-mode)
782 (* (1- org-indent-indentation-per-level) (1- level))
783 0))
784 (p0 (if (equal (char-before) ?*) (1+ (point)) (point)))
785 (tc (+ org-tags-column (if (> org-tags-column 0) (- di) di)))
786 (c1 (max (1+ c0) (if (> tc 0) tc (- (- tc) (string-width tags)))))
787 (rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags)))
788 (replace-match rpl t t)
789 (and c0 indent-tabs-mode (tabify p0 (point)))
790 tags)))
791 (t (error "Tags alignment failed")))
792 (org-move-to-column col)))
793
794 (defun counsel-org-tag-action (x)
795 (if (member x counsel-org-tags)
796 (progn
797 (setq counsel-org-tags (delete x counsel-org-tags)))
798 (setq counsel-org-tags (append counsel-org-tags (list x)))
799 (unless (member x ivy--all-candidates)
800 (setq ivy--all-candidates (append ivy--all-candidates (list x)))))
801 (let ((prompt (counsel-org-tag-prompt)))
802 (setf (ivy-state-prompt ivy-last) prompt)
803 (setq ivy--prompt (concat "%-4d " prompt)))
804 (cond ((memq this-command '(ivy-done ivy-alt-done))
805 (counsel-org-change-tags
806 (if counsel-org-tags
807 (format ":%s:"
808 (mapconcat #'identity counsel-org-tags ":"))
809 "")))
810 ((eq this-command 'ivy-call)
811 (delete-minibuffer-contents))))
812
813 (defun counsel-org-tag-prompt ()
814 (format "Tags (%s): "
815 (mapconcat #'identity counsel-org-tags ", ")))
816
817 (defvar org-setting-tags)
818 (defvar org-last-tags-completion-table)
819 (defvar org-tag-persistent-alist)
820 (defvar org-tag-alist)
821 (defvar org-complete-tags-always-offer-all-agenda-tags)
822
823 (declare-function org-at-heading-p "org")
824 (declare-function org-back-to-heading "org")
825 (declare-function org-get-buffer-tags "org")
826 (declare-function org-global-tags-completion-table "org")
827 (declare-function org-agenda-files "org")
828 (declare-function org-agenda-set-tags "org-agenda")
829
830 ;;;###autoload
831 (defun counsel-org-tag ()
832 "Add or remove tags in org-mode."
833 (interactive)
834 (save-excursion
835 (unless (org-at-heading-p)
836 (org-back-to-heading t))
837 (setq counsel-org-tags (split-string (org-get-tags-string) ":" t))
838 (let ((org-setting-tags t)
839 (org-last-tags-completion-table
840 (append org-tag-persistent-alist
841 (or org-tag-alist (org-get-buffer-tags))
842 (and
843 org-complete-tags-always-offer-all-agenda-tags
844 (org-global-tags-completion-table
845 (org-agenda-files))))))
846 (ivy-read (counsel-org-tag-prompt)
847 (lambda (str &rest _unused)
848 (delete-dups
849 (all-completions str 'org-tags-completion-function)))
850 :history 'org-tags-history
851 :action 'counsel-org-tag-action))))
852
853 ;;;###autoload
854 (defun counsel-org-tag-agenda ()
855 "Set tags for the current agenda item."
856 (interactive)
857 (let ((store (symbol-function 'org-set-tags)))
858 (unwind-protect
859 (progn
860 (fset 'org-set-tags
861 (symbol-function 'counsel-org-tag))
862 (org-agenda-set-tags nil nil))
863 (fset 'org-set-tags store))))
864
865 (defun counsel-ag-function (string &optional _pred &rest _unused)
866 "Grep in the current directory for STRING."
867 (if (< (length string) 3)
868 (counsel-more-chars 3)
869 (let ((regex (replace-regexp-in-string
870 "\\\\)" ")"
871 (replace-regexp-in-string
872 "\\\\(" "("
873 (ivy--regex string)))))
874 (counsel--async-command
875 (format "ag --noheading --nocolor %S" regex))
876 nil)))
877
878 (defun counsel-ag (&optional initial-input)
879 "Grep for a string in the current directory using ag.
880 INITIAL-INPUT can be given as the initial minibuffer input."
881 (interactive)
882 (setq counsel--git-grep-dir default-directory)
883 (ivy-read "ag: " 'counsel-ag-function
884 :initial-input initial-input
885 :dynamic-collection t
886 :history 'counsel-git-grep-history
887 :action #'counsel-git-grep-action
888 :unwind #'swiper--cleanup))
889
890 (defun counsel-recoll-function (string &optional _pred &rest _unused)
891 "Grep in the current directory for STRING."
892 (if (< (length string) 3)
893 (counsel-more-chars 3)
894 (counsel--async-command
895 (format "recoll -t -b '%s'" string))
896 nil))
897
898 ;; This command uses the recollq command line tool that comes together
899 ;; with the recoll (the document indexing database) source:
900 ;; http://www.lesbonscomptes.com/recoll/download.html
901 ;; You need to build it yourself (together with recoll):
902 ;; cd ./query && make && sudo cp recollq /usr/local/bin
903 ;; You can try the GUI version of recoll with:
904 ;; sudo apt-get install recoll
905 ;; Unfortunately, that does not install recollq.
906 (defun counsel-recoll (&optional initial-input)
907 "Search for a string in the recoll database.
908 You'll be given a list of files that match.
909 Selecting a file will launch `swiper' for that file.
910 INITIAL-INPUT can be given as the initial minibuffer input."
911 (interactive)
912 (ivy-read "recoll: " 'counsel-recoll-function
913 :initial-input initial-input
914 :dynamic-collection t
915 :history 'counsel-git-grep-history
916 :action (lambda (x)
917 (when (string-match "file://\\(.*\\)\\'" x)
918 (let ((file-name (match-string 1 x)))
919 (find-file file-name)
920 (unless (string-match "pdf$" x)
921 (swiper ivy-text)))))))
922
923 (provide 'counsel)
924
925 ;;; counsel.el ends here