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