+ (when (= 0 (cl-incf counsel-gg-state))
+ (ivy--exhibit)))))))))
+
+(defun counsel-git-grep-occur ()
+ "Generate a custom occur buffer for `counsel-git-grep'.
+When REVERT is non-nil, regenerate the current *ivy-occur* buffer."
+ (unless (eq major-mode 'ivy-occur-grep-mode)
+ (ivy-occur-grep-mode)
+ (setq default-directory counsel--git-grep-dir))
+ (let ((cands (split-string
+ (shell-command-to-string
+ (format counsel-git-grep-cmd
+ (setq ivy--old-re (ivy--regex ivy-text t))))
+ "\n"
+ t)))
+ ;; Need precise number of header lines for `wgrep' to work.
+ (insert (format "-*- mode:grep; default-directory: %S -*-\n\n\n"
+ default-directory))
+ (insert (format "%d candidates:\n" (length cands)))
+ (ivy--occur-insert-lines
+ (mapcar
+ (lambda (cand) (concat "./" cand))
+ cands))))
+
+(defun counsel-git-grep-query-replace ()
+ "Start `query-replace' with string to replace from last search string."
+ (interactive)
+ (if (null (window-minibuffer-p))
+ (user-error
+ "Should only be called in the minibuffer through `counsel-git-grep-map'")
+ (let* ((enable-recursive-minibuffers t)
+ (from (ivy--regex ivy-text))
+ (to (query-replace-read-to from "Query replace" t)))
+ (ivy-exit-with-action
+ (lambda (_)
+ (let (done-buffers)
+ (dolist (cand ivy--old-cands)
+ (when (string-match "\\`\\(.*?\\):\\([0-9]+\\):\\(.*\\)\\'" cand)
+ (with-ivy-window
+ (let ((file-name (match-string-no-properties 1 cand)))
+ (setq file-name (expand-file-name file-name counsel--git-grep-dir))
+ (unless (member file-name done-buffers)
+ (push file-name done-buffers)
+ (find-file file-name)
+ (goto-char (point-min)))
+ (perform-replace from to t t nil)))))))))))
+
+(defun counsel-git-grep-recenter ()
+ (interactive)
+ (with-ivy-window
+ (counsel-git-grep-action ivy--current)
+ (recenter-top-bottom)))
+
+;;** `counsel-git-stash'
+(defun counsel-git-stash-kill-action (x)
+ (when (string-match "\\([^:]+\\):" x)
+ (kill-new (message (format "git stash apply %s" (match-string 1 x))))))
+
+;;;###autoload
+(defun counsel-git-stash ()
+ "Search through all available git stashes."
+ (interactive)
+ (let ((dir (locate-dominating-file default-directory ".git")))
+ (if (null dir)
+ (error "Not in a git repository")
+ (let ((cands (split-string (shell-command-to-string
+ "IFS=$'\n'
+for i in `git stash list --format=\"%gd\"`; do
+ git stash show -p $i | grep -H --label=\"$i\" \"$1\"
+done") "\n" t)))
+ (ivy-read "git stash: " cands
+ :action 'counsel-git-stash-kill-action
+ :caller 'counsel-git-stash)))))
+;;** `counsel-git-log'
+(defun counsel-git-log-function (input)
+ (if (< (length input) 3)
+ (counsel-more-chars 3)
+ ;; `counsel--yank-pop-format-function' uses this
+ (setq ivy--old-re (funcall ivy--regex-function input))
+ (counsel--async-command
+ ;; "git log --grep" likes to have groups quoted e.g. \(foo\).
+ ;; But it doesn't like the non-greedy ".*?".
+ (format "GIT_PAGER=cat git log --grep '%s'"
+ (replace-regexp-in-string
+ "\\.\\*\\?" ".*"
+ ivy--old-re)))
+ nil))
+
+(defun counsel-git-log-action (x)
+ (message "%S" (kill-new x)))
+
+(defcustom counsel-yank-pop-truncate-radius 2
+ "When non-nil, truncate the display of long strings."
+ :type 'integer
+ :group 'ivy)
+
+;;;###autoload
+(defun counsel-git-log ()
+ "Call the \"git log --grep\" shell command."
+ (interactive)
+ (let ((counsel-async-split-string-re "\ncommit ")
+ (counsel-yank-pop-truncate-radius 5)
+ (ivy-format-function #'counsel--yank-pop-format-function)
+ (ivy-height 4))
+ (ivy-read "Grep log: " #'counsel-git-log-function
+ :dynamic-collection t
+ :action #'counsel-git-log-action
+ :unwind #'counsel-delete-process
+ :caller 'counsel-git-log)))
+
+;;* File
+;;** `counsel-find-file'
+(defvar counsel-find-file-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-DEL") 'counsel-up-directory)
+ (define-key map (kbd "C-<backspace>") 'counsel-up-directory)
+ map))
+
+(add-to-list 'ivy-ffap-url-functions 'counsel-github-url-p)
+(add-to-list 'ivy-ffap-url-functions 'counsel-emacs-url-p)
+(ivy-set-actions
+ 'counsel-find-file
+ '(("f" find-file-other-window "other window")))
+
+(defcustom counsel-find-file-at-point nil
+ "When non-nil, add file-at-point to the list of candidates."
+ :type 'boolean
+ :group 'ivy)
+
+(defcustom counsel-find-file-ignore-regexp nil
+ "A regexp of files to ignore while in `counsel-find-file'.
+These files are un-ignored if `ivy-text' matches them. The
+common way to show all files is to start `ivy-text' with a dot.
+
+Example value: \"\\(?:\\`[#.]\\)\\|\\(?:[#~]\\'\\)\". This will hide
+temporary and lock files.
+\\<ivy-minibuffer-map>
+Choosing the dotfiles option, \"\\`\\.\", might be convenient,
+since you can still access the dotfiles if your input starts with
+a dot. The generic way to toggle ignored files is \\[ivy-toggle-ignore],
+but the leading dot is a lot faster."
+ :group 'ivy
+ :type '(choice
+ (const :tag "None" nil)
+ (const :tag "Dotfiles" "\\`\\.")
+ (regexp :tag "Regex")))
+
+(defun counsel--find-file-matcher (regexp candidates)
+ "Return REGEXP-matching CANDIDATES.
+Skip some dotfiles unless `ivy-text' requires them."
+ (let ((res (ivy--re-filter regexp candidates)))
+ (if (or (null ivy-use-ignore)
+ (null counsel-find-file-ignore-regexp)
+ (string-match "\\`\\." ivy-text))
+ res
+ (or (cl-remove-if
+ (lambda (x)
+ (and
+ (string-match counsel-find-file-ignore-regexp x)
+ (not (member x ivy-extra-directories))))
+ res)
+ res))))
+
+(declare-function ffap-guesser "ffap")
+
+;;;###autoload
+(defun counsel-find-file (&optional initial-input)
+ "Forward to `find-file'.
+When INITIAL-INPUT is non-nil, use it in the minibuffer during completion."
+ (interactive)
+ (ivy-read "Find file: " 'read-file-name-internal
+ :matcher #'counsel--find-file-matcher
+ :initial-input initial-input
+ :action
+ (lambda (x)
+ (with-ivy-window
+ (find-file (expand-file-name x ivy--directory))))
+ :preselect (when counsel-find-file-at-point
+ (require 'ffap)
+ (let ((f (ffap-guesser)))
+ (when f (expand-file-name f))))
+ :require-match 'confirm-after-completion
+ :history 'file-name-history
+ :keymap counsel-find-file-map
+ :caller 'counsel-find-file))
+
+(defun counsel-up-directory ()
+ "Go to the parent directory preselecting the current one."
+ (interactive)
+ (let ((dir-file-name
+ (directory-file-name (expand-file-name ivy--directory))))
+ (ivy--cd (file-name-directory dir-file-name))
+ (setf (ivy-state-preselect ivy-last)
+ (file-name-as-directory (file-name-nondirectory dir-file-name)))))
+
+(defun counsel-at-git-issue-p ()
+ "Whe point is at an issue in a Git-versioned file, return the issue string."
+ (and (looking-at "#[0-9]+")
+ (or
+ (eq (vc-backend (buffer-file-name)) 'Git)
+ (memq major-mode '(magit-commit-mode)))
+ (match-string-no-properties 0)))
+
+(defun counsel-github-url-p ()
+ "Return a Github issue URL at point."
+ (let ((url (counsel-at-git-issue-p)))
+ (when url
+ (let ((origin (shell-command-to-string
+ "git remote get-url origin"))
+ user repo)
+ (cond ((string-match "\\`git@github.com:\\([^/]+\\)/\\(.*\\)\\.git$"
+ origin)
+ (setq user (match-string 1 origin))
+ (setq repo (match-string 2 origin)))
+ ((string-match "\\`https://github.com/\\([^/]+\\)/\\(.*\\)$"
+ origin)
+ (setq user (match-string 1 origin))
+ (setq repo (match-string 2 origin))))
+ (when user
+ (setq url (format "https://github.com/%s/%s/issues/%s"
+ user repo (substring url 1))))))))
+
+(defun counsel-emacs-url-p ()
+ "Return a Debbugs issue URL at point."
+ (let ((url (counsel-at-git-issue-p)))
+ (when url
+ (let ((origin (shell-command-to-string
+ "git remote get-url origin")))
+ (when (string-match "git.sv.gnu.org:/srv/git/emacs.git" origin)
+ (format "http://debbugs.gnu.org/cgi/bugreport.cgi?bug=%s"
+ (substring url 1)))))))
+
+;;** `counsel-locate'
+(defcustom counsel-locate-options nil
+ "Command line options for `locate`."
+ :group 'ivy
+ :type '(repeat string))
+
+(make-obsolete-variable 'counsel-locate-options 'counsel-locate-cmd "0.7.0")
+
+(defcustom counsel-locate-cmd (cond ((eq system-type 'darwin)
+ 'counsel-locate-cmd-noregex)
+ ((and (eq system-type 'windows-nt)
+ (executable-find "es.exe"))
+ 'counsel-locate-cmd-es)
+ (t
+ 'counsel-locate-cmd-default))
+ "The function for producing a locate command string from the input.
+
+The function takes a string - the current input, and returns a
+string - the full shell command to run."
+ :group 'ivy
+ :type '(choice
+ (const :tag "Default" counsel-locate-cmd-default)
+ (const :tag "No regex" counsel-locate-cmd-noregex)
+ (const :tag "mdfind" counsel-locate-cmd-mdfind)
+ (const :tag "everything" counsel-locate-cmd-es)))
+
+(ivy-set-actions
+ 'counsel-locate
+ '(("x" counsel-locate-action-extern "xdg-open")
+ ("d" counsel-locate-action-dired "dired")))
+
+(counsel-set-async-exit-code 'counsel-locate 1 "Nothing found")
+
+(defvar counsel-locate-history nil
+ "History for `counsel-locate'.")
+
+(defun counsel-locate-action-extern (x)
+ "Use xdg-open shell command on X."
+ (call-process shell-file-name nil
+ nil nil
+ shell-command-switch
+ (format "%s %s"
+ (if (eq system-type 'darwin)
+ "open"
+ "xdg-open")
+ (shell-quote-argument x))))
+
+(declare-function dired-jump "dired-x")
+
+(defun counsel-locate-action-dired (x)
+ "Use `dired-jump' on X."
+ (dired-jump nil x))
+
+(defun counsel-locate-cmd-default (input)
+ "Return a shell command based on INPUT."
+ (format "locate -i --regex '%s'"
+ (counsel-unquote-regex-parens
+ (ivy--regex input))))
+
+(defun counsel-locate-cmd-noregex (input)
+ "Return a shell command based on INPUT."
+ (format "locate -i '%s'" input))
+
+(defun counsel-locate-cmd-mdfind (input)
+ "Return a shell command based on INPUT."
+ (format "mdfind -name '%s'" input))
+
+(defun counsel-locate-cmd-es (input)
+ "Return a shell command based on INPUT."
+ (format "es.exe -i -r %s"
+ (counsel-unquote-regex-parens
+ (ivy--regex input t))))
+
+(defun counsel-locate-function (input)
+ (if (< (length input) 3)
+ (counsel-more-chars 3)
+ (counsel--async-command
+ (funcall counsel-locate-cmd input))
+ '("" "working...")))
+
+;;;###autoload
+(defun counsel-locate (&optional initial-input)
+ "Call the \"locate\" shell command.
+INITIAL-INPUT can be given as the initial minibuffer input."
+ (interactive)
+ (ivy-read "Locate: " #'counsel-locate-function
+ :initial-input initial-input
+ :dynamic-collection t
+ :history 'counsel-locate-history
+ :action (lambda (file)
+ (with-ivy-window
+ (when file
+ (find-file file))))
+ :unwind #'counsel-delete-process
+ :caller 'counsel-locate))
+
+;;* Grep
+;;** `counsel-ag'
+(defvar counsel-ag-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-l") 'counsel-git-grep-recenter)
+ (define-key map (kbd "M-q") 'counsel-git-grep-query-replace)
+ map))
+
+(defcustom counsel-ag-base-command "ag --nocolor --nogroup %s -- ."
+ "Format string to use in `cousel-ag-function' to construct the
+command. %S will be replaced by the regex string. The default is
+\"ag --nocolor --nogroup %s -- .\"."
+ :type 'string
+ :group 'ivy)
+
+(counsel-set-async-exit-code 'counsel-ag 1 "No matches found")
+(ivy-set-occur 'counsel-ag 'counsel-ag-occur)
+(ivy-set-display-transformer 'counsel-ag 'counsel-git-grep-transformer)
+
+(defun counsel-ag-function (string)
+ "Grep in the current directory for STRING."
+ (if (< (length string) 3)
+ (counsel-more-chars 3)
+ (let ((default-directory counsel--git-grep-dir)
+ (regex (counsel-unquote-regex-parens
+ (setq ivy--old-re
+ (ivy--regex string)))))
+ (counsel--async-command
+ (format counsel-ag-base-command (shell-quote-argument regex)))
+ nil)))
+
+;;;###autoload
+(defun counsel-ag (&optional initial-input initial-directory)
+ "Grep for a string in the current directory using ag.
+INITIAL-INPUT can be given as the initial minibuffer input."
+ (interactive
+ (list nil
+ (when current-prefix-arg
+ (read-directory-name (concat
+ (car (split-string counsel-ag-base-command))
+ " in directory: ")))))
+ (setq counsel--git-grep-dir (or initial-directory default-directory))
+ (ivy-read (funcall counsel-prompt-function
+ (car (split-string counsel-ag-base-command)))
+ 'counsel-ag-function
+ :initial-input initial-input
+ :dynamic-collection t
+ :keymap counsel-ag-map
+ :history 'counsel-git-grep-history
+ :action #'counsel-git-grep-action
+ :unwind (lambda ()
+ (counsel-delete-process)
+ (swiper--cleanup))
+ :caller 'counsel-ag))
+
+(defun counsel-ag-occur ()
+ "Generate a custom occur buffer for `counsel-ag'."
+ (unless (eq major-mode 'ivy-occur-grep-mode)
+ (ivy-occur-grep-mode))
+ (setq default-directory counsel--git-grep-dir)
+ (let* ((regex (counsel-unquote-regex-parens
+ (setq ivy--old-re
+ (ivy--regex
+ (progn (string-match "\"\\(.*\\)\"" (buffer-name))
+ (match-string 1 (buffer-name)))))))
+ (cands (split-string
+ (shell-command-to-string
+ (format counsel-ag-base-command (shell-quote-argument regex)))
+ "\n"
+ t)))
+ ;; Need precise number of header lines for `wgrep' to work.
+ (insert (format "-*- mode:grep; default-directory: %S -*-\n\n\n"
+ default-directory))
+ (insert (format "%d candidates:\n" (length cands)))
+ (ivy--occur-insert-lines
+ (mapcar
+ (lambda (cand) (concat "./" cand))
+ cands))))
+
+;;** `counsel-pt'
+(defcustom counsel-pt-base-command "pt --nocolor --nogroup -e %s -- ."
+ "Used to in place of `counsel-ag-base-command' to search with
+pt using `counsel-ag'."
+ :type 'string
+ :group 'ivy)
+
+;;;###autoload
+(defun counsel-pt ()
+ "Grep for a string in the current directory using pt.
+This uses `counsel-ag' with `counsel-pt-base-command' replacing
+`counsel-ag-base-command'."
+ (interactive)
+ (let ((counsel-ag-base-command counsel-pt-base-command))
+ (call-interactively 'counsel-ag)))
+
+;;** `counsel-grep'
+(defcustom counsel-grep-base-command "grep -nE --ignore-case \"%s\" %s"
+ "Format string to use in `cousel-grep-function' to construct
+the command."
+ :type 'string
+ :group 'ivy)
+
+(defun counsel-grep-function (string)
+ "Grep in the current directory for STRING."
+ (if (< (length string) 2)
+ (counsel-more-chars 2)
+ (let ((regex (counsel-unquote-regex-parens
+ (setq ivy--old-re
+ (ivy--regex string)))))
+ (counsel--async-command
+ (format counsel-grep-base-command regex counsel--git-grep-dir))
+ nil)))
+
+(defun counsel-grep-action (x)
+ (with-ivy-window
+ (swiper--cleanup)
+ (when (string-match "\\`\\([0-9]+\\):\\(.*\\)\\'" x)
+ (let ((file-name counsel--git-grep-dir)
+ (line-number (match-string-no-properties 1 x)))
+ (find-file file-name)
+ (goto-char (point-min))
+ (forward-line (1- (string-to-number line-number)))
+ (re-search-forward (ivy--regex ivy-text t) (line-end-position) t)
+ (if (eq ivy-exit 'done)
+ (swiper--ensure-visible)
+ (unless (eq ivy-exit 'done)
+ (isearch-range-invisible (line-beginning-position)
+ (line-end-position))
+ (swiper--add-overlays (ivy--regex ivy-text))))))))
+
+(defun counsel-grep-occur ()
+ "Generate a custom occur buffer for `counsel-grep'."
+ (unless (eq major-mode 'ivy-occur-grep-mode)
+ (ivy-occur-grep-mode))
+ (let ((cands
+ (split-string
+ (shell-command-to-string
+ (format counsel-grep-base-command
+ (counsel-unquote-regex-parens
+ (setq ivy--old-re
+ (ivy--regex
+ (progn (string-match "\"\\(.*\\)\"" (buffer-name))
+ (match-string 1 (buffer-name))) t)))
+ counsel--git-grep-dir))
+ "\n" t))
+ (file (file-name-nondirectory counsel--git-grep-dir)))
+ ;; Need precise number of header lines for `wgrep' to work.
+ (insert (format "-*- mode:grep; default-directory: %S -*-\n\n\n"
+ default-directory))
+ (insert (format "%d candidates:\n" (length cands)))
+ (ivy--occur-insert-lines
+ (mapcar
+ (lambda (cand) (concat "./" file ":" cand))
+ cands))))
+
+(ivy-set-occur 'counsel-grep 'counsel-grep-occur)
+(counsel-set-async-exit-code 'counsel-grep 1 "")
+
+;;;###autoload
+(defun counsel-grep ()
+ "Grep for a string in the current file."
+ (interactive)
+ (setq counsel--git-grep-dir (buffer-file-name))
+ (let ((init-point (point))
+ res)
+ (unwind-protect
+ (setq res (ivy-read "grep: " 'counsel-grep-function
+ :dynamic-collection t
+ :preselect (format "%d:%s"
+ (line-number-at-pos)
+ (buffer-substring-no-properties
+ (line-beginning-position)
+ (line-end-position)))
+ :history 'counsel-git-grep-history
+ :update-fn (lambda ()
+ (counsel-grep-action ivy--current))
+ :action #'counsel-grep-action
+ :unwind (lambda ()
+ (counsel-delete-process)
+ (swiper--cleanup))
+ :caller 'counsel-grep))
+ (unless res
+ (goto-char init-point)))))
+
+;;** `counsel-recoll'
+(defun counsel-recoll-function (string)
+ "Grep in the current directory for STRING."
+ (if (< (length string) 3)
+ (counsel-more-chars 3)
+ (counsel--async-command
+ (format "recoll -t -b '%s'" string))
+ nil))
+
+;; This command uses the recollq command line tool that comes together
+;; with the recoll (the document indexing database) source:
+;; http://www.lesbonscomptes.com/recoll/download.html
+;; You need to build it yourself (together with recoll):
+;; cd ./query && make && sudo cp recollq /usr/local/bin
+;; You can try the GUI version of recoll with:
+;; sudo apt-get install recoll
+;; Unfortunately, that does not install recollq.
+(defun counsel-recoll (&optional initial-input)
+ "Search for a string in the recoll database.
+You'll be given a list of files that match.
+Selecting a file will launch `swiper' for that file.
+INITIAL-INPUT can be given as the initial minibuffer input."
+ (interactive)
+ (ivy-read "recoll: " 'counsel-recoll-function
+ :initial-input initial-input
+ :dynamic-collection t
+ :history 'counsel-git-grep-history
+ :action (lambda (x)
+ (when (string-match "file://\\(.*\\)\\'" x)
+ (let ((file-name (match-string 1 x)))
+ (find-file file-name)
+ (unless (string-match "pdf$" x)
+ (swiper ivy-text)))))
+ :unwind #'counsel-delete-process
+ :caller 'counsel-recoll))
+;;* Misc Emacs
+;;** `counsel-org-tag'
+(defvar counsel-org-tags nil
+ "Store the current list of tags.")
+
+(defvar org-outline-regexp)
+(defvar org-indent-mode)
+(defvar org-indent-indentation-per-level)
+(defvar org-tags-column)
+(declare-function org-get-tags-string "org")
+(declare-function org-move-to-column "org-compat")
+
+(defun counsel-org-change-tags (tags)
+ (let ((current (org-get-tags-string))
+ (col (current-column))
+ level)
+ ;; Insert new tags at the correct column
+ (beginning-of-line 1)
+ (setq level (or (and (looking-at org-outline-regexp)
+ (- (match-end 0) (point) 1))
+ 1))
+ (cond
+ ((and (equal current "") (equal tags "")))
+ ((re-search-forward
+ (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$")
+ (point-at-eol) t)
+ (if (equal tags "")
+ (delete-region
+ (match-beginning 0)
+ (match-end 0))
+ (goto-char (match-beginning 0))
+ (let* ((c0 (current-column))
+ ;; compute offset for the case of org-indent-mode active
+ (di (if (bound-and-true-p org-indent-mode)
+ (* (1- org-indent-indentation-per-level) (1- level))
+ 0))
+ (p0 (if (equal (char-before) ?*) (1+ (point)) (point)))
+ (tc (+ org-tags-column (if (> org-tags-column 0) (- di) di)))
+ (c1 (max (1+ c0) (if (> tc 0) tc (- (- tc) (string-width tags)))))
+ (rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags)))
+ (replace-match rpl t t)
+ (and c0 indent-tabs-mode (tabify p0 (point)))
+ tags)))
+ (t (error "Tags alignment failed")))
+ (org-move-to-column col)))
+
+(defun counsel-org--set-tags ()
+ (counsel-org-change-tags
+ (if counsel-org-tags
+ (format ":%s:"
+ (mapconcat #'identity counsel-org-tags ":"))
+ "")))
+
+(defvar org-agenda-bulk-marked-entries)
+
+(declare-function org-get-at-bol "org")
+(declare-function org-agenda-error "org-agenda")
+
+(defun counsel-org-tag-action (x)
+ (if (member x counsel-org-tags)
+ (progn
+ (setq counsel-org-tags (delete x counsel-org-tags)))
+ (unless (equal x "")
+ (setq counsel-org-tags (append counsel-org-tags (list x)))
+ (unless (member x ivy--all-candidates)
+ (setq ivy--all-candidates (append ivy--all-candidates (list x))))))
+ (let ((prompt (counsel-org-tag-prompt)))
+ (setf (ivy-state-prompt ivy-last) prompt)
+ (setq ivy--prompt (concat "%-4d " prompt)))
+ (cond ((memq this-command '(ivy-done
+ ivy-alt-done
+ ivy-immediate-done))
+ (if (eq major-mode 'org-agenda-mode)
+ (if (null org-agenda-bulk-marked-entries)
+ (let ((hdmarker (or (org-get-at-bol 'org-hd-marker)
+ (org-agenda-error))))
+ (with-current-buffer (marker-buffer hdmarker)
+ (goto-char hdmarker)
+ (counsel-org--set-tags)))
+ (let ((add-tags (copy-sequence counsel-org-tags)))
+ (dolist (m org-agenda-bulk-marked-entries)
+ (with-current-buffer (marker-buffer m)
+ (save-excursion
+ (goto-char m)
+ (setq counsel-org-tags
+ (delete-dups
+ (append (split-string (org-get-tags-string) ":" t)
+ add-tags)))
+ (counsel-org--set-tags))))))
+ (counsel-org--set-tags)))
+ ((eq this-command 'ivy-call)
+ (delete-minibuffer-contents))))
+
+(defun counsel-org-tag-prompt ()
+ (format "Tags (%s): "
+ (mapconcat #'identity counsel-org-tags ", ")))
+
+(defvar org-setting-tags)
+(defvar org-last-tags-completion-table)
+(defvar org-tag-persistent-alist)
+(defvar org-tag-alist)
+(defvar org-complete-tags-always-offer-all-agenda-tags)
+
+(declare-function org-at-heading-p "org")
+(declare-function org-back-to-heading "org")
+(declare-function org-get-buffer-tags "org")
+(declare-function org-global-tags-completion-table "org")
+(declare-function org-agenda-files "org")
+(declare-function org-agenda-set-tags "org-agenda")
+
+;;;###autoload
+(defun counsel-org-tag ()
+ "Add or remove tags in org-mode."
+ (interactive)
+ (save-excursion
+ (if (eq major-mode 'org-agenda-mode)
+ (if org-agenda-bulk-marked-entries
+ (setq counsel-org-tags nil)
+ (let ((hdmarker (or (org-get-at-bol 'org-hd-marker)
+ (org-agenda-error))))
+ (with-current-buffer (marker-buffer hdmarker)
+ (goto-char hdmarker)
+ (setq counsel-org-tags
+ (split-string (org-get-tags-string) ":" t)))))
+ (unless (org-at-heading-p)
+ (org-back-to-heading t))
+ (setq counsel-org-tags (split-string (org-get-tags-string) ":" t)))
+ (let ((org-setting-tags t)
+ (org-last-tags-completion-table
+ (append org-tag-persistent-alist
+ (or org-tag-alist (org-get-buffer-tags))
+ (and
+ (or org-complete-tags-always-offer-all-agenda-tags
+ (eq major-mode 'org-agenda-mode))
+ (org-global-tags-completion-table
+ (org-agenda-files))))))
+ (ivy-read (counsel-org-tag-prompt)
+ (lambda (str &rest _unused)
+ (delete-dups
+ (all-completions str 'org-tags-completion-function)))
+ :history 'org-tags-history
+ :action 'counsel-org-tag-action
+ :caller 'counsel-org-tag))))
+
+;;;###autoload
+(defun counsel-org-tag-agenda ()
+ "Set tags for the current agenda item."
+ (interactive)
+ (let ((store (symbol-function 'org-set-tags)))
+ (unwind-protect
+ (progn
+ (fset 'org-set-tags
+ (symbol-function 'counsel-org-tag))
+ (org-agenda-set-tags nil nil))
+ (fset 'org-set-tags store))))
+
+;;** `counsel-tmm'
+(defvar tmm-km-list nil)
+(declare-function tmm-get-keymap "tmm")
+(declare-function tmm--completion-table "tmm")
+(declare-function tmm-get-keybind "tmm")
+
+(defun counsel-tmm-prompt (menu)
+ "Select and call an item from the MENU keymap."
+ (let (out
+ choice
+ chosen-string)
+ (setq tmm-km-list nil)
+ (map-keymap (lambda (k v) (tmm-get-keymap (cons k v))) menu)
+ (setq tmm-km-list (nreverse tmm-km-list))
+ (setq out (ivy-read "Menu bar: " (tmm--completion-table tmm-km-list)
+ :require-match t
+ :sort nil))
+ (setq choice (cdr (assoc out tmm-km-list)))
+ (setq chosen-string (car choice))
+ (setq choice (cdr choice))
+ (cond ((keymapp choice)
+ (counsel-tmm-prompt choice))
+ ((and choice chosen-string)
+ (setq last-command-event chosen-string)
+ (call-interactively choice)))))
+
+(defvar tmm-table-undef)
+
+;;;###autoload
+(defun counsel-tmm ()
+ "Text-mode emulation of looking and choosing from a menubar."
+ (interactive)
+ (require 'tmm)
+ (run-hooks 'menu-bar-update-hook)
+ (setq tmm-table-undef nil)
+ (counsel-tmm-prompt (tmm-get-keybind [menu-bar])))
+
+;;** `counsel-yank-pop'
+(defun counsel--yank-pop-truncate (str)
+ (condition-case nil
+ (let* ((lines (split-string str "\n" t))
+ (n (length lines))
+ (first-match (cl-position-if
+ (lambda (s) (string-match ivy--old-re s))
+ lines))
+ (beg (max 0 (- first-match
+ counsel-yank-pop-truncate-radius)))
+ (end (min n (+ first-match
+ counsel-yank-pop-truncate-radius
+ 1)))
+ (seq (cl-subseq lines beg end)))
+ (if (null first-match)
+ (error "Could not match %s" str)
+ (when (> beg 0)
+ (setcar seq (concat "[...] " (car seq))))
+ (when (< end n)
+ (setcar (last seq)
+ (concat (car (last seq)) " [...]")))
+ (mapconcat #'identity seq "\n")))
+ (error str)))
+
+(defun counsel--yank-pop-format-function (cand-pairs)
+ (ivy--format-function-generic
+ (lambda (str)
+ (mapconcat
+ (lambda (s)
+ (ivy--add-face s 'ivy-current-match))
+ (split-string
+ (counsel--yank-pop-truncate str) "\n" t)
+ "\n"))
+ (lambda (str)
+ (counsel--yank-pop-truncate str))
+ cand-pairs
+ "\n"))
+
+(defun counsel-yank-pop-action (s)
+ "Insert S into the buffer, overwriting the previous yank."
+ (with-ivy-window
+ (delete-region ivy-completion-beg
+ ivy-completion-end)
+ (insert (substring-no-properties s))
+ (setq ivy-completion-end (point))))
+
+;;;###autoload
+(defun counsel-yank-pop ()
+ "Ivy replacement for `yank-pop'."
+ (interactive)
+ (if (eq last-command 'yank)
+ (progn
+ (setq ivy-completion-end (point))
+ (setq ivy-completion-beg
+ (save-excursion
+ (search-backward (car kill-ring))
+ (point))))
+ (setq ivy-completion-beg (point))
+ (setq ivy-completion-end (point)))
+ (let ((candidates (cl-remove-if
+ (lambda (s)
+ (or (< (length s) 3)
+ (string-match "\\`[\n[:blank:]]+\\'" s)))
+ (delete-dups kill-ring))))
+ (let ((ivy-format-function #'counsel--yank-pop-format-function)
+ (ivy-height 5))
+ (ivy-read "kill-ring: " candidates
+ :action 'counsel-yank-pop-action
+ :caller 'counsel-yank-pop))))
+
+;;** `counsel-imenu'
+(defvar imenu-auto-rescan)
+(declare-function imenu--subalist-p "imenu")
+(declare-function imenu--make-index-alist "imenu")
+
+(defun counsel-imenu-get-candidates-from (alist &optional prefix)
+ "Create a list of (key . value) from ALIST.
+PREFIX is used to create the key."
+ (cl-mapcan (lambda (elm)
+ (if (imenu--subalist-p elm)
+ (counsel-imenu-get-candidates-from
+ (cl-loop for (e . v) in (cdr elm) collect
+ (cons e (if (integerp v) (copy-marker v) v)))
+ ;; pass the prefix to next recursive call
+ (concat prefix (if prefix ".") (car elm)))
+ (let ((key (concat prefix (if prefix ".") (car elm))))
+ (list (cons key
+ ;; create a imenu candidate here
+ (cons key (if (overlayp (cdr elm))
+ (overlay-start (cdr elm))
+ (cdr elm))))))))
+ alist))
+
+;;;###autoload
+(defun counsel-imenu ()
+ "Jump to a buffer position indexed by imenu."
+ (interactive)
+ (unless (featurep 'imenu)
+ (require 'imenu nil t))
+ (let* ((imenu-auto-rescan t)
+ (items (imenu--make-index-alist t))
+ (items (delete (assoc "*Rescan*" items) items)))
+ (ivy-read "imenu items:" (counsel-imenu-get-candidates-from items)
+ :preselect (thing-at-point 'symbol)
+ :require-match t
+ :action (lambda (candidate)
+ (with-ivy-window
+ ;; In org-mode, (imenu candidate) will expand child node
+ ;; after jump to the candidate position
+ (imenu candidate)))
+ :caller 'counsel-imenu)))
+
+;;** `counsel-list-processes'
+(defun counsel-list-processes-action-delete (x)
+ (delete-process x)
+ (setf (ivy-state-collection ivy-last)
+ (setq ivy--all-candidates
+ (delete x ivy--all-candidates))))
+
+(defun counsel-list-processes-action-switch (x)
+ (let* ((proc (get-process x))
+ (buf (and proc (process-buffer proc))))
+ (if buf
+ (switch-to-buffer buf)
+ (message "Process %s doesn't have a buffer" x))))
+
+;;;###autoload
+(defun counsel-list-processes ()
+ "Offer completion for `process-list'
+The default action deletes the selected process.
+An extra action allows to switch to the process buffer."
+ (interactive)
+ (list-processes--refresh)
+ (ivy-read "Process: " (mapcar #'process-name (process-list))
+ :require-match t
+ :action
+ '(1
+ ("o" counsel-list-processes-action-delete "kill")
+ ("s" counsel-list-processes-action-switch "switch"))
+ :caller 'counsel-list-processes))
+
+;;** `counsel-ace-link'
+(defun counsel-ace-link ()
+ "Use Ivy completion for `ace-link'."
+ (interactive)
+ (let (collection action)
+ (cond ((eq major-mode 'Info-mode)
+ (setq collection 'ace-link--info-collect)
+ (setq action 'ace-link--info-action))
+ ((eq major-mode 'help-mode)
+ (setq collection 'ace-link--help-collect)
+ (setq action 'ace-link--help-action))
+ ((eq major-mode 'woman-mode)
+ (setq collection 'ace-link--woman-collect)
+ (setq action 'ace-link--woman-action))
+ ((eq major-mode 'eww-mode)
+ (setq collection 'ace-link--eww-collect)
+ (setq action 'ace-link--eww-action))
+ ((eq major-mode 'compilation-mode)
+ (setq collection 'ace-link--eww-collect)
+ (setq action 'ace-link--compilation-action))
+ ((eq major-mode 'org-mode)
+ (setq collection 'ace-link--org-collect)
+ (setq action 'ace-link--org-action)))
+ (if (null collection)
+ (error "%S is not supported" major-mode)
+ (ivy-read "Ace-Link: " (funcall collection)
+ :action action
+ :require-match t
+ :caller 'counsel-ace-link))))
+
+;;* Misc OS
+;;** `counsel-rhythmbox'
+(defvar helm-rhythmbox-library)
+(declare-function helm-rhythmbox-load-library "ext:helm-rhythmbox")
+(declare-function dbus-call-method "dbus")
+(declare-function dbus-get-property "dbus")
+(declare-function helm-rhythmbox-song-uri "ext:helm-rhythmbox")
+(declare-function helm-rhythmbox-candidates "ext:helm-rhythmbox")
+
+(defun counsel-rhythmbox-enqueue-song (song)
+ "Let Rhythmbox enqueue SONG."
+ (let ((service "org.gnome.Rhythmbox3")
+ (path "/org/gnome/Rhythmbox3/PlayQueue")
+ (interface "org.gnome.Rhythmbox3.PlayQueue"))
+ (dbus-call-method :session service path interface
+ "AddToQueue" (helm-rhythmbox-song-uri song))))
+
+(defvar counsel-rhythmbox-history nil
+ "History for `counsel-rhythmbox'.")
+
+(defun counsel-rhythmbox-current-song ()
+ "Return the currently playing song title."
+ (ignore-errors
+ (let* ((entry (dbus-get-property
+ :session
+ "org.mpris.MediaPlayer2.rhythmbox"
+ "/org/mpris/MediaPlayer2"
+ "org.mpris.MediaPlayer2.Player"
+ "Metadata"))
+ (artist (caar (cadr (assoc "xesam:artist" entry))))
+ (album (cl-caadr (assoc "xesam:album" entry)))
+ (title (cl-caadr (assoc "xesam:title" entry))))
+ (format "%s - %s - %s" artist album title))))
+
+;;;###autoload
+(defun counsel-rhythmbox ()
+ "Choose a song from the Rhythmbox library to play or enqueue."
+ (interactive)
+ (unless (require 'helm-rhythmbox nil t)
+ (error "Please install `helm-rhythmbox'"))
+ (unless helm-rhythmbox-library
+ (helm-rhythmbox-load-library)
+ (while (null helm-rhythmbox-library)
+ (sit-for 0.1)))
+ (ivy-read "Rhythmbox: "
+ (helm-rhythmbox-candidates)
+ :history 'counsel-rhythmbox-history
+ :preselect (counsel-rhythmbox-current-song)
+ :action
+ '(1
+ ("p" helm-rhythmbox-play-song "Play song")
+ ("e" counsel-rhythmbox-enqueue-song "Enqueue song"))
+ :caller 'counsel-rhythmbox))
+;;** `counsel-linux-app'
+(defvar counsel-linux-apps-alist nil
+ "List of data located in /usr/share/applications.")
+
+(defvar counsel-linux-apps-faulty nil
+ "List of faulty data located in /usr/share/applications.")
+
+(defun counsel-linux-apps-list ()
+ (let ((files
+ (delete
+ ".." (delete
+ "." (file-expand-wildcards "/usr/share/applications/*.desktop")))))
+ (dolist (file (cl-set-difference files (append (mapcar 'car counsel-linux-apps-alist)
+ counsel-linux-apps-faulty)
+ :test 'equal))
+ (with-temp-buffer
+ (insert-file-contents (expand-file-name file "/usr/share/applications"))
+ (let (name comment exec)
+ (goto-char (point-min))
+ (if (re-search-forward "^Name *= *\\(.*\\)$" nil t)
+ (setq name (match-string 1))
+ (error "File %s has no Name" file))
+ (goto-char (point-min))
+ (when (re-search-forward "^Comment *= *\\(.*\\)$" nil t)
+ (setq comment (match-string 1)))
+ (goto-char (point-min))
+ (when (re-search-forward "^Exec *= *\\(.*\\)$" nil t)
+ (setq exec (match-string 1)))
+ (if (and exec (not (equal exec "")))
+ (add-to-list
+ 'counsel-linux-apps-alist
+ (cons (format "% -45s: %s%s"
+ (propertize exec 'face 'font-lock-builtin-face)
+ name
+ (if comment
+ (concat " - " comment)
+ ""))
+ file))
+ (add-to-list 'counsel-linux-apps-faulty file))))))
+ counsel-linux-apps-alist)
+
+(defun counsel-linux-app-action-default (desktop-shortcut)
+ "Launch DESKTOP-SHORTCUT."
+ (call-process-shell-command
+ (format "gtk-launch %s" (file-name-nondirectory desktop-shortcut))))
+
+(defun counsel-linux-app-action-file (desktop-shortcut)
+ "Launch DESKTOP-SHORTCUT with a selected file."
+ (let* ((entry (rassoc desktop-shortcut counsel-linux-apps-alist))
+ (short-name (and entry
+ (string-match "\\([^ ]*\\) " (car entry))
+ (match-string 1 (car entry))))
+ (file (and short-name
+ (read-file-name
+ (format "Run %s on: " short-name)))))
+ (if file
+ (call-process-shell-command
+ (format "gtk-launch %s %s"
+ (file-name-nondirectory desktop-shortcut)
+ file))
+ (user-error "cancelled"))))
+
+(ivy-set-actions
+ 'counsel-linux-app
+ '(("f" counsel-linux-app-action-file "run on a file")))
+
+;;;###autoload
+(defun counsel-linux-app ()
+ "Launch a Linux desktop application, similar to Alt-<F2>."
+ (interactive)
+ (ivy-read "Run a command: " (counsel-linux-apps-list)
+ :action #'counsel-linux-app-action-default
+ :caller 'counsel-linux-app))
+
+;;** `counsel-mode'
+(defvar counsel-mode-map
+ (let ((map (make-sparse-keymap)))
+ (dolist (binding
+ '((execute-extended-command . counsel-M-x)
+ (describe-bindings . counsel-descbinds)
+ (describe-function . counsel-describe-function)
+ (describe-variable . counsel-describe-variable)
+ (find-file . counsel-find-file)
+ (imenu . counsel-imenu)
+ (load-library . counsel-load-library)
+ (load-theme . counsel-load-theme)
+ (yank-pop . counsel-yank-pop)))
+ (define-key map (vector 'remap (car binding)) (cdr binding)))
+ map)
+ "Map for `counsel-mode'. Remaps built-in functions to counsel
+replacements.")
+
+(defcustom counsel-mode-override-describe-bindings nil
+ "Whether to override `describe-bindings' when `counsel-mode' is
+active."
+ :group 'ivy
+ :type 'boolean)
+
+;;;###autoload
+(define-minor-mode counsel-mode
+ "Toggle Counsel mode on or off.
+Turn Counsel mode on if ARG is positive, off otherwise. Counsel
+mode remaps built-in emacs functions that have counsel
+replacements. "
+ :group 'ivy
+ :global t
+ :keymap counsel-mode-map
+ :lighter " counsel"
+ (if counsel-mode
+ (when (and (fboundp 'advice-add)
+ counsel-mode-override-describe-bindings)
+ (advice-add #'describe-bindings :override #'counsel-descbinds))
+ (when (fboundp 'advice-remove)
+ (advice-remove #'describe-bindings #'counsel-descbinds))))