[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/ivy c822a6d 1/2: Filter out the files not relevant for
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] externals/ivy c822a6d 1/2: Filter out the files not relevant for the `ivy` package |
|
Date: |
Wed, 2 Dec 2020 14:02:54 -0500 (EST) |
branch: externals/ivy
commit c822a6de94b3413e7d77c3b213f1484841d55898
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
Filter out the files not relevant for the `ivy` package
---
.elpaignore | 6 +
.github/FUNDING.yml | 3 -
.gitignore | 3 +-
counsel.el | 6040 --------------------------------------------
elpa.el | 6 -
swiper.el | 1673 ------------
targets/checkdoc.el | 6 -
targets/install-deps.el | 38 -
targets/obsolete-config.el | 3 -
targets/plain.el | 9 -
10 files changed, 8 insertions(+), 7779 deletions(-)
diff --git a/.elpaignore b/.elpaignore
new file mode 100644
index 0000000..0f36850
--- /dev/null
+++ b/.elpaignore
@@ -0,0 +1,6 @@
+doc/ivy-help.org
+doc/Changelog.org
+doc/gpl-3.0.txt
+doc/fdl-1.3.txt
+ivy-test.el
+tests
diff --git a/.github/FUNDING.yml b/.github/FUNDING.yml
deleted file mode 100644
index baf06fb..0000000
--- a/.github/FUNDING.yml
+++ /dev/null
@@ -1,3 +0,0 @@
-github: abo-abo
-liberapay: abo-abo
-patreon: abo_abo
diff --git a/.gitignore b/.gitignore
index a2fa335..3398f81 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,6 +1,7 @@
+/*-pkg.el
*.elc
*~
/doc/dir
*.info
-*-autoloads.el
+/*-autoloads.el
.dir-locals-2.el
diff --git a/counsel.el b/counsel.el
deleted file mode 100644
index 109a215..0000000
--- a/counsel.el
+++ /dev/null
@@ -1,6040 +0,0 @@
-;;; counsel.el --- Various completion functions using Ivy -*- lexical-binding:
t -*-
-
-;; Copyright (C) 2015-2019 Free Software Foundation, Inc.
-
-;; Author: Oleh Krehel <ohwoeowho@gmail.com>
-;; URL: https://github.com/abo-abo/swiper
-;; Version: 0.12.0
-;; Package-Requires: ((emacs "24.3") (swiper "0.12.0"))
-;; Keywords: convenience, matching, tools
-
-;; This file is part of GNU Emacs.
-
-;; This file is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; For a full copy of the GNU General Public License
-;; see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Just call one of the interactive functions in this file to complete
-;; the corresponding thing using `ivy'.
-;;
-;; Currently available:
-;; - Symbol completion for Elisp, Common Lisp, Python, Clojure, C, C++.
-;; - Describe functions for Elisp: function, variable, library, command,
-;; bindings, theme.
-;; - Navigation functions: imenu, ace-line, semantic, outline.
-;; - Git utilities: git-files, git-grep, git-log, git-stash, git-checkout.
-;; - Grep utilities: grep, ag, pt, recoll, ack, rg.
-;; - System utilities: process list, rhythmbox, linux-app.
-;; - Many more.
-
-;;; Code:
-
-(require 'swiper)
-(require 'compile)
-(require 'dired)
-
-(defgroup counsel nil
- "Completion functions using Ivy."
- :group 'matching
- :prefix "counsel-")
-
-;;* Utility
-(defun counsel--elisp-to-pcre (regex &optional look-around)
- "Convert REGEX from Elisp format to PCRE format, on best-effort basis.
-REGEX may be of any format returned by an Ivy regex function,
-namely a string or a list. The return value is always a string.
-
-Note that incorrect results may be returned for sufficiently
-complex regexes."
- (if (consp regex)
- (if (and look-around
- (or (cdr regex)
- (not (cdar regex))))
- (concat
- "^"
- (mapconcat
- (lambda (pair)
- (let ((subexp (counsel--elisp-to-pcre (car pair))))
- (format "(?%c.*%s)"
- (if (cdr pair) ?= ?!)
- subexp)))
- regex
- ""))
- (mapconcat
- (lambda (pair)
- (let ((subexp (counsel--elisp-to-pcre (car pair))))
- (if (string-match-p "|" subexp)
- (format "(?:%s)" subexp)
- subexp)))
- (cl-remove-if-not #'cdr regex)
- ".*"))
- (replace-regexp-in-string
- "\\\\[(){}|`']\\|[()]"
- (lambda (s)
- (or (cdr (assoc s '(("\\(" . "(")
- ("\\)" . ")")
- ("(" . "\\(")
- (")" . "\\)")
- ("\\{" . "{")
- ("\\}" . "}")
- ("\\|" . "|")
- ("\\`" . "^")
- ("\\'" . "$"))))
- (error
- "Unexpected error in `counsel--elisp-to-pcre' (got match %S)" s)))
- regex t t)))
-
-(defun counsel-directory-name (dir)
- "Return the name of directory DIR with a slash."
- (file-name-as-directory
- (file-name-nondirectory
- (directory-file-name dir))))
-
-(defun counsel-string-compose (prefix str)
- "Make PREFIX the display prefix of STR through text properties."
- (let ((str (copy-sequence str)))
- (put-text-property
- 0 1 'display
- (concat prefix (substring str 0 1))
- str)
- str))
-
-(defun counsel-require-program (cmd)
- "Check system for program used in CMD, printing error if not found.
-CMD is either a string or a list of strings.
-To skip the `executable-find' check, start the string with a space."
- (unless (and (stringp cmd) (string-match-p "^ " cmd))
- (let ((program (if (listp cmd)
- (car cmd)
- (car (split-string cmd)))))
- (or (and (stringp program)
- (not (string= program ""))
- (executable-find program))
- (user-error "Required program \"%s\" not found in your path"
program)))))
-
-(declare-function eshell-split-path "esh-util")
-
-(defun counsel-prompt-function-dir ()
- "Return prompt appended with the parent directory."
- (require 'esh-util)
- (let* ((dir (ivy-state-directory ivy-last))
- (parts (nthcdr 3 (eshell-split-path dir)))
- (dir (format " [%s]: " (if parts (apply #'concat "..." parts) dir))))
- (ivy-add-prompt-count
- (replace-regexp-in-string ; Insert dir before any trailing colon.
- "\\(?:: ?\\)?\\'" dir (ivy-state-prompt ivy-last) t t))))
-
-;;* Async Utility
-(defvar counsel--async-time nil
- "Store the time when a new process was started.
-Or the time of the last minibuffer update.")
-
-(defvar counsel--async-start nil
- "Store the time when a new process was started.
-Or the time of the last minibuffer update.")
-
-(defvar counsel--async-duration nil
- "Store the time a process takes to gather all its candidates.
-The time is measured in seconds.")
-
-(defvar counsel--async-exit-code-plist ()
- "Associate commands with their exit code descriptions.
-This plist maps commands to a plist mapping their exit codes to
-descriptions.")
-
-(defvar counsel--async-last-error-string nil
- "When the process returned non-0, store the output here.")
-
-(defun counsel-set-async-exit-code (cmd number str)
- "For CMD, associate NUMBER exit code with STR."
- (let ((plist (plist-get counsel--async-exit-code-plist cmd)))
- (setq counsel--async-exit-code-plist
- (plist-put counsel--async-exit-code-plist
- cmd
- (plist-put plist number str)))))
-
-(defvar counsel-async-split-string-re-alist '((t . "\n"))
- "Store the regexp for splitting shell command output.")
-
-(defvar counsel-async-ignore-re-alist nil
- "An alist of regexp matching candidates to ignore in
`counsel--async-filter'.")
-
-(defvar counsel--async-last-command nil
- "Store the last command ran by `counsel--async-command'.")
-
-(defun counsel--async-command (cmd &optional sentinel filter name)
- "Start and return new counsel process by calling CMD.
-CMD can be either a shell command as a string, or a list of the
-program name to be called directly, followed by its arguments.
-If the default counsel process or one with NAME already exists,
-kill it and its associated buffer before starting a new one.
-Give the process the functions SENTINEL and FILTER, which default
-to `counsel--async-sentinel' and `counsel--async-filter',
-respectively."
- (counsel-delete-process name)
- (setq name (or name " *counsel*"))
- (when (get-buffer name)
- (kill-buffer name))
- (setq counsel--async-last-command cmd)
- (let* ((buf (get-buffer-create name))
- (proc (if (listp cmd)
- (apply #'start-file-process name buf cmd)
- (start-file-process-shell-command name buf cmd))))
- (setq counsel--async-time (current-time))
- (setq counsel--async-start counsel--async-time)
- (set-process-sentinel proc (or sentinel #'counsel--async-sentinel))
- (set-process-filter proc (or filter #'counsel--async-filter))
- proc))
-
-(defun counsel--split-string (&optional str)
- (split-string
- (or str (buffer-string))
- (ivy-alist-setting counsel-async-split-string-re-alist)
- t))
-
-(defun counsel--async-sentinel (process _msg)
- "Sentinel function for an asynchronous counsel PROCESS."
- (when (eq (process-status process) 'exit)
- (if (zerop (process-exit-status process))
- (progn
- (ivy--set-candidates
- (ivy--sort-maybe
- (with-current-buffer (process-buffer process)
- (counsel--split-string))))
- (when counsel--async-start
- (setq counsel--async-duration
- (time-to-seconds (time-since counsel--async-start))))
- (let ((re (ivy-re-to-str (funcall ivy--regex-function ivy-text))))
- (if ivy--old-cands
- (if (eq (ivy-alist-setting ivy-index-functions-alist)
'ivy-recompute-index-zero)
- (ivy-set-index 0)
- (ivy--recompute-index ivy-text re ivy--all-candidates))
- (unless (ivy-set-index
- (ivy--preselect-index
- (ivy-state-preselect ivy-last)
- ivy--all-candidates))
- (ivy--recompute-index ivy-text re ivy--all-candidates))))
- (setq ivy--old-cands ivy--all-candidates)
- (if ivy--all-candidates
- (ivy--exhibit)
- (ivy--insert-minibuffer "")))
- (setq counsel--async-last-error-string
- (with-current-buffer (process-buffer process) (buffer-string)))
- (setq ivy--all-candidates
- (let ((status (process-exit-status process))
- (plist (plist-get counsel--async-exit-code-plist
- (ivy-state-caller ivy-last))))
- (list (or (plist-get plist status)
- (format "error code %d" status)))))
- (setq ivy--old-cands ivy--all-candidates)
- (ivy--exhibit))))
-
-(defcustom counsel-async-filter-update-time 500000
- "The amount of microseconds to wait until updating `counsel--async-filter'."
- :type 'integer)
-
-(defun counsel--async-filter (process str)
- "Receive from PROCESS the output STR.
-Update the minibuffer with the amount of lines collected every
-`counsel-async-filter-update-time' microseconds since the last update."
- (with-current-buffer (process-buffer process)
- (insert str))
- (when (time-less-p (list 0 0 counsel-async-filter-update-time)
- (time-since counsel--async-time))
- (let (numlines)
- (with-current-buffer (process-buffer process)
- (setq numlines (count-lines (point-min) (point-max)))
- (ivy--set-candidates
- (let ((lines (counsel--split-string))
- (ignore-re (ivy-alist-setting counsel-async-ignore-re-alist)))
- (if (stringp ignore-re)
- (cl-remove-if (lambda (line)
- (string-match-p ignore-re line))
- lines)
- lines))))
- (let ((ivy--prompt (format "%d++ %s" numlines (ivy-state-prompt
ivy-last))))
- (ivy--insert-minibuffer (ivy--format ivy--all-candidates)))
- (setq counsel--async-time (current-time)))))
-
-(defun counsel-delete-process (&optional name)
- "Delete current counsel process or that with NAME."
- (let ((process (get-process (or name " *counsel*"))))
- (when process
- (delete-process process))))
-
-;;* Completion at point
-;;** `counsel-el'
-;;;###autoload
-(defun counsel-el ()
- "Elisp completion at point."
- (interactive)
- (let* ((bnd (unless (and (looking-at ")")
- (eq (char-before) ?\())
- (bounds-of-thing-at-point 'symbol)))
- (str (if bnd
- (buffer-substring-no-properties
- (car bnd)
- (cdr bnd))
- ""))
- (pred (and (eq (char-before (car bnd)) ?\()
- #'fboundp))
- symbol-names)
- (setq ivy-completion-beg (car bnd))
- (setq ivy-completion-end (cdr bnd))
- (if (string= str "")
- (mapatoms
- (lambda (x)
- (when (and (symbolp x) (funcall pred x))
- (push (symbol-name x) symbol-names))))
- (setq symbol-names (all-completions str obarray pred)))
- (ivy-read "Symbol name: " symbol-names
- :initial-input str
- :action #'ivy-completion-in-region-action
- :caller 'counsel-el)))
-
-(ivy-configure 'counsel-el
- :height 7)
-
-;;** `counsel-cl'
-(declare-function slime-symbol-start-pos "ext:slime")
-(declare-function slime-symbol-end-pos "ext:slime")
-(declare-function slime-contextual-completions "ext:slime-c-p-c")
-
-;;;###autoload
-(defun counsel-cl ()
- "Common Lisp completion at point."
- (interactive)
- (setq ivy-completion-beg (slime-symbol-start-pos))
- (setq ivy-completion-end (slime-symbol-end-pos))
- (ivy-read "Symbol name: "
- (car (slime-contextual-completions
- ivy-completion-beg
- ivy-completion-end))
- :action #'ivy-completion-in-region-action))
-
-;;** `counsel-jedi'
-(declare-function deferred:sync! "ext:deferred")
-(declare-function jedi:complete-request "ext:jedi-core")
-(declare-function jedi:ac-direct-matches "ext:jedi")
-
-;;;###autoload
-(defun counsel-jedi ()
- "Python completion at point."
- (interactive)
- (let ((bnd (bounds-of-thing-at-point 'symbol)))
- (setq ivy-completion-beg (car bnd))
- (setq ivy-completion-end (cdr bnd)))
- (deferred:sync!
- (jedi:complete-request))
- (ivy-read "Symbol name: " (jedi:ac-direct-matches)
- :action #'counsel--py-action))
-
-(defun counsel--py-action (symbol-name)
- "Insert SYMBOL-NAME, erasing the previous one."
- (when (stringp symbol-name)
- (with-ivy-window
- (when ivy-completion-beg
- (delete-region
- ivy-completion-beg
- ivy-completion-end))
- (setq ivy-completion-beg (point))
- (insert symbol-name)
- (setq ivy-completion-end (point)))))
-
-;;** `counsel-clj'
-(declare-function cider-sync-request:complete "ext:cider-client")
-(defun counsel--generic (completion-fn)
- "Complete thing at point with COMPLETION-FN."
- (let* ((bnd (or (bounds-of-thing-at-point 'symbol)
- (cons (point) (point))))
- (str (buffer-substring-no-properties
- (car bnd) (cdr bnd)))
- (candidates (funcall completion-fn str))
- (res (ivy-read (format "pattern (%s): " str)
- candidates
- :caller 'counsel--generic)))
- (when (stringp res)
- (when bnd
- (delete-region (car bnd) (cdr bnd)))
- (insert res))))
-
-(ivy-configure 'counsel--generic
- :height 7)
-
-;;;###autoload
-(defun counsel-clj ()
- "Clojure completion at point."
- (interactive)
- (counsel--generic
- (lambda (str)
- (mapcar
- #'cl-caddr
- (cider-sync-request:complete str ":same")))))
-
-;;** `counsel-company'
-(defvar company-candidates)
-(defvar company-common)
-(defvar company-prefix)
-(declare-function company-abort "ext:company")
-(declare-function company-complete "ext:company")
-(declare-function company-mode "ext:company")
-
-;;;###autoload
-(defun counsel-company ()
- "Complete using `company-candidates'."
- (interactive)
- (company-mode 1)
- (unless company-candidates
- (company-complete))
- (let ((len (cond (company-common
- (length company-common))
- (company-prefix
- (length company-prefix)))))
- (when len
- (setq ivy-completion-beg (- (point) len))
- (setq ivy-completion-end (point))
- (ivy-read "Candidate: " company-candidates
- :action #'ivy-completion-in-region-action
- :caller 'counsel-company))))
-
-(ivy-configure 'counsel-company
- :unwind-fn #'company-abort)
-
-;;** `counsel-irony'
-(declare-function irony-completion-candidates-async "ext:irony-completion")
-(declare-function irony-completion-symbol-bounds "ext:irony-completion")
-(declare-function irony-completion-annotation "ext:irony-completion")
-
-;;;###autoload
-(defun counsel-irony ()
- "Inline C/C++ completion using Irony."
- (interactive)
- (irony-completion-candidates-async 'counsel-irony-callback))
-
-(defun counsel-irony-callback (candidates)
- "Callback function for Irony to search among CANDIDATES."
- (interactive)
- (let* ((symbol-bounds (irony-completion-symbol-bounds))
- (beg (car symbol-bounds))
- (end (cdr symbol-bounds))
- (prefix (buffer-substring-no-properties beg end)))
- (setq ivy-completion-beg beg
- ivy-completion-end end)
- (ivy-read "code: " (mapcar #'counsel-irony-annotate candidates)
- :predicate (lambda (candidate)
- (string-prefix-p prefix (car candidate)))
- :caller 'counsel-irony
- :action #'ivy-completion-in-region-action)))
-
-(defun counsel-irony-annotate (x)
- "Make Ivy candidate from Irony candidate X."
- (cons (concat (car x) (irony-completion-annotation x))
- (car x)))
-
-(add-to-list 'ivy-display-functions-alist '(counsel-irony .
ivy-display-function-overlay))
-
-;;* Elisp symbols
-;;** `counsel-describe-variable'
-(defvar counsel-describe-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-.") #'counsel-find-symbol)
- (define-key map (kbd "C-,") #'counsel--info-lookup-symbol)
- map))
-
-(ivy-set-actions
- 'counsel-describe-variable
- '(("I" counsel-info-lookup-symbol "info")
- ("d" counsel--find-symbol "definition")))
-
-(defvar counsel-describe-symbol-history ()
- "History list for variable and function names.
-Used by commands `counsel-describe-variable' and
-`counsel-describe-function'.")
-
-(defun counsel-find-symbol ()
- "Jump to the definition of the current symbol."
- (interactive)
- (ivy-exit-with-action #'counsel--find-symbol))
-(put 'counsel-find-symbol 'no-counsel-M-x t)
-
-(defun counsel--info-lookup-symbol ()
- "Lookup the current symbol in the info docs."
- (interactive)
- (ivy-exit-with-action #'counsel-info-lookup-symbol))
-
-(defvar find-tag-marker-ring)
-(declare-function xref-push-marker-stack "xref")
-
-(defalias 'counsel--push-xref-marker
- (if (require 'xref nil t)
- #'xref-push-marker-stack
- (require 'etags)
- (lambda (&optional m)
- (ring-insert (with-no-warnings find-tag-marker-ring) (or m
(point-marker)))))
- "Compatibility shim for `xref-push-marker-stack'.")
-
-(defun counsel--find-symbol (x)
- "Find symbol definition that corresponds to string X."
- (with-ivy-window
- (counsel--push-xref-marker)
- (let ((full-name (get-text-property 0 'full-name x)))
- (if full-name
- (find-library full-name)
- (let ((sym (read x)))
- (cond ((and (eq (ivy-state-caller ivy-last)
- 'counsel-describe-variable)
- (boundp sym))
- (find-variable sym))
- ((fboundp sym)
- (find-function sym))
- ((boundp sym)
- (find-variable sym))
- ((or (featurep sym)
- (locate-library
- (prin1-to-string sym)))
- (find-library
- (prin1-to-string sym)))
- (t
- (error "Couldn't find definition of %s"
- sym))))))))
-
-(defun counsel--variable-p (symbol)
- "Return non-nil if SYMBOL is a bound or documented variable."
- (or (and (boundp symbol)
- (not (keywordp symbol)))
- (get symbol 'variable-documentation)))
-
-(defcustom counsel-describe-variable-function #'describe-variable
- "Function to call to describe a variable passed as parameter."
- :type 'function)
-
-(defun counsel-describe-variable-transformer (var)
- "Propertize VAR if it's a custom variable."
- (if (custom-variable-p (intern var))
- (ivy-append-face var 'ivy-highlight-face)
- var))
-
-;;;###autoload
-(defun counsel-describe-variable ()
- "Forward to `describe-variable'.
-
-Variables declared using `defcustom' are highlighted according to
-`ivy-highlight-face'."
- (interactive)
- (let ((enable-recursive-minibuffers t))
- (ivy-read "Describe variable: " obarray
- :predicate #'counsel--variable-p
- :require-match t
- :history 'counsel-describe-symbol-history
- :keymap counsel-describe-map
- :preselect (ivy-thing-at-point)
- :action (lambda (x)
- (funcall counsel-describe-variable-function (intern
x)))
- :caller 'counsel-describe-variable)))
-
-(ivy-configure 'counsel-describe-variable
- :initial-input "^"
- :display-transformer-fn #'counsel-describe-variable-transformer
- :sort-fn #'ivy-string<)
-
-;;** `counsel-describe-function'
-(ivy-set-actions
- 'counsel-describe-function
- '(("I" counsel-info-lookup-symbol "info")
- ("d" counsel--find-symbol "definition")))
-
-(defcustom counsel-describe-function-function #'describe-function
- "Function to call to describe a function passed as parameter."
- :type 'function)
-
-(defun counsel-describe-function-transformer (function-name)
- "Propertize FUNCTION-NAME if it's an interactive function."
- (if (commandp (intern function-name))
- (ivy-append-face function-name 'ivy-highlight-face)
- function-name))
-
-(defun ivy-function-called-at-point ()
- (let ((f (function-called-at-point)))
- (and f (symbol-name f))))
-
-(defcustom counsel-describe-function-preselect #'ivy-thing-at-point
- "Determine what `counsel-describe-function' should preselect."
- :type '(radio
- (function-item ivy-thing-at-point)
- (function-item ivy-function-called-at-point)))
-
-;;;###autoload
-(defun counsel-describe-function ()
- "Forward to `describe-function'.
-
-Interactive functions (i.e., commands) are highlighted according
-to `ivy-highlight-face'."
- (interactive)
- (let ((enable-recursive-minibuffers t))
- (ivy-read "Describe function: " obarray
- :predicate (lambda (sym)
- (or (fboundp sym)
- (get sym 'function-documentation)))
- :require-match t
- :history 'counsel-describe-symbol-history
- :keymap counsel-describe-map
- :preselect (funcall counsel-describe-function-preselect)
- :action (lambda (x)
- (funcall counsel-describe-function-function (intern
x)))
- :caller 'counsel-describe-function)))
-
-(ivy-configure 'counsel-describe-function
- :initial-input "^"
- :display-transformer-fn #'counsel-describe-function-transformer
- :sort-fn #'ivy-string<)
-
-;;** `counsel-set-variable'
-(defvar counsel-set-variable-history nil
- "Store history for `counsel-set-variable'.")
-
-(defun counsel-read-setq-expression (sym)
- "Read and eval a setq expression for SYM."
- (setq this-command 'eval-expression)
- (let* ((minibuffer-completing-symbol t)
- (sym-value (symbol-value sym))
- (expr (minibuffer-with-setup-hook
- (lambda ()
- (add-function :before-until (local
'eldoc-documentation-function)
- #'elisp-eldoc-documentation-function)
- (add-hook 'completion-at-point-functions
#'elisp-completion-at-point nil t)
- (run-hooks 'eval-expression-minibuffer-setup-hook)
- (goto-char (minibuffer-prompt-end))
- (forward-char 6)
- (insert (format "%S " sym)))
- (read-from-minibuffer "Eval: "
- (format
- (if (and sym-value (consp sym-value))
- "(setq '%S)"
- "(setq %S)")
- sym-value)
- read-expression-map t
- 'read-expression-history))))
- (eval-expression expr)))
-
-(defun counsel--setq-doconst (x)
- "Return a cons of description and value for X.
-X is an item of a radio- or choice-type defcustom."
- (when (listp x)
- (let ((v (car-safe (last x)))
- (tag (and (eq (car x) 'const)
- (plist-get (cdr x) :tag))))
- (when (and (or v tag) (not (eq v 'function)))
- (cons
- (concat
- (when tag
- (concat tag ": "))
- (if (stringp v) v (prin1-to-string v)))
- (if (symbolp v)
- (list 'quote v)
- v))))))
-
-(declare-function lv-message "ext:lv")
-(declare-function lv-delete-window "ext:lv")
-(declare-function custom-variable-documentation "cus-edit")
-
-(defface counsel-variable-documentation
- '((t :inherit font-lock-comment-face))
- "Face for displaying Lisp documentation."
- :group 'ivy-faces)
-
-;;;###autoload
-(defun counsel-set-variable (sym)
- "Set a variable SYM, with completion.
-
-When the selected variable is a `defcustom' with the type boolean
-or radio, offer completion of all possible values.
-
-Otherwise, offer a variant of `eval-expression', with the initial
-input corresponding to the chosen variable.
-
-With a prefix arg, restrict list to variables defined using
-`defcustom'."
- (interactive (list (intern
- (ivy-read "Set variable: " obarray
- :predicate (if current-prefix-arg
- #'custom-variable-p
- #'counsel--variable-p)
- :history 'counsel-set-variable-history
- :preselect (ivy-thing-at-point)))))
- (let ((doc (and (require 'cus-edit)
- (require 'lv nil t)
- (not (string= "nil" (custom-variable-documentation sym)))
- (propertize (custom-variable-documentation sym)
- 'face 'counsel-variable-documentation)))
- sym-type
- cands)
- (unwind-protect
- (progn
- (when doc
- (lv-message (ivy--quote-format-string doc)))
- (if (and (boundp sym)
- (setq sym-type (get sym 'custom-type))
- (cond
- ((and (consp sym-type)
- (memq (car sym-type) '(choice radio)))
- (setq cands (delq nil (mapcar #'counsel--setq-doconst
- (cdr sym-type)))))
- ((eq sym-type 'boolean)
- (setq cands '(("nil" . nil) ("t" . t))))
- (t nil)))
- (let* ((sym-val (symbol-value sym))
- (res (ivy-read (format "Set (%S <%s>): " sym sym-val)
- cands
- :preselect (prin1-to-string sym-val))))
- (when res
- (setq res
- (if (assoc res cands)
- (cdr (assoc res cands))
- (read res)))
- (set sym (if (and (listp res) (eq (car res) 'quote))
- (cadr res)
- res))))
- (unless (boundp sym)
- (set sym nil))
- (counsel-read-setq-expression sym)))
- (when doc
- (lv-delete-window)))))
-
-;;** `counsel-apropos'
-;;;###autoload
-(defun counsel-apropos ()
- "Show all matching symbols.
-See `apropos' for further information on what is considered
-a symbol and how to search for them."
- (interactive)
- (ivy-read "Search for symbol (word list or regexp): " obarray
- :predicate (lambda (sym)
- (or (fboundp sym)
- (boundp sym)
- (facep sym)
- (symbol-plist sym)))
- :history 'counsel-apropos-history
- :preselect (ivy-thing-at-point)
- :action (lambda (pattern)
- (when (string= pattern "")
- (user-error "Please specify a pattern"))
- ;; If the user selected a candidate form the list, we use
- ;; a pattern which matches only the selected symbol.
- (if (memq this-command '(ivy-immediate-done
ivy-alt-done))
- ;; Regexp pattern are passed verbatim, other input is
- ;; split into words.
- (if (string= (regexp-quote pattern) pattern)
- (apropos (split-string pattern "[ \t]+" t))
- (apropos pattern))
- (apropos (concat "\\`" pattern "\\'"))))
- :caller 'counsel-apropos))
-
-(ivy-configure 'counsel-apropos
- :sort-fn #'ivy-string<)
-
-;;** `counsel-info-lookup-symbol'
-(defvar info-lookup-mode)
-(declare-function info-lookup-guess-default "info-look")
-(declare-function info-lookup->completions "info-look")
-(declare-function info-lookup->mode-value "info-look")
-(declare-function info-lookup-select-mode "info-look")
-(declare-function info-lookup-change-mode "info-look")
-(declare-function info-lookup "info-look")
-
-;;;###autoload
-(defun counsel-info-lookup-symbol (symbol &optional mode)
- "Forward SYMBOL to `info-lookup-symbol' with ivy completion.
-With prefix arg MODE a query for the symbol help mode is offered."
- (interactive
- (progn
- (require 'info-look)
- ;; Courtesy of `info-lookup-interactive-arguments'
- (let* ((topic 'symbol)
- (mode (cond (current-prefix-arg
- (info-lookup-change-mode topic))
- ((info-lookup->mode-value
- topic (info-lookup-select-mode))
- info-lookup-mode)
- ((info-lookup-change-mode topic))))
- (enable-recursive-minibuffers t))
- (list (ivy-read "Describe symbol: " (info-lookup->completions topic
mode)
- :history 'info-lookup-history
- :preselect (info-lookup-guess-default topic mode)
- :caller 'counsel-info-lookup-symbol)
- mode))))
- (info-lookup-symbol symbol mode))
-
-(ivy-configure 'counsel-info-lookup-symbol
- :sort-fn #'ivy-string<)
-
-;;** `counsel-M-x'
-(defface counsel-key-binding
- '((t :inherit font-lock-keyword-face))
- "Face used by `counsel-M-x' for key bindings."
- :group 'ivy-faces)
-
-(defface counsel-active-mode
- '((t :inherit font-lock-builtin-face))
- "Face used by `counsel-M-x' for activated modes."
- :group 'ivy-faces)
-
-(defcustom counsel-alias-expand t
- "When non-nil, show the expansion of aliases in `counsel-M-x'."
- :type 'boolean
- :group 'ivy)
-
-(defun counsel-M-x-transformer (cmd)
- "Return CMD annotated with its active key binding, if any."
- (let* ((sym (intern cmd))
- (alias (symbol-function sym))
- (key (where-is-internal sym nil t)))
- (when (or (eq sym major-mode)
- (and
- (memq sym minor-mode-list)
- (boundp sym)
- (buffer-local-value sym (ivy-state-buffer ivy-last))))
- (setq cmd (propertize cmd 'face 'counsel-active-mode)))
- (concat cmd
- (when (and (symbolp alias) counsel-alias-expand)
- (format " (%s)" alias))
- (when key
- ;; Prefer `<f2>' over `C-x 6' where applicable
- (let ((i (cl-search [?\C-x ?6] key)))
- (when i
- (let ((dup (vconcat (substring key 0 i) [f2] (substring key
(+ i 2))))
- (map (current-global-map)))
- (when (equal (lookup-key map key)
- (lookup-key map dup))
- (setq key dup)))))
- (setq key (key-description key))
- (put-text-property 0 (length key) 'face 'counsel-key-binding key)
- (format " (%s)" key)))))
-
-(defvar amx-initialized)
-(defvar amx-cache)
-(declare-function amx-initialize "ext:amx")
-(declare-function amx-detect-new-commands "ext:amx")
-(declare-function amx-update "ext:amx")
-(declare-function amx-rank "ext:amx")
-(defvar smex-initialized-p)
-(defvar smex-ido-cache)
-(declare-function smex-initialize "ext:smex")
-(declare-function smex-detect-new-commands "ext:smex")
-(declare-function smex-update "ext:smex")
-(declare-function smex-rank "ext:smex")
-
-(defun counsel--M-x-externs ()
- "Return `counsel-M-x' candidates from external packages.
-The return value is a list of strings. The currently supported
-packages are, in order of precedence, `amx' and `smex'."
- (cond ((require 'amx nil t)
- (unless amx-initialized
- (amx-initialize))
- (when (amx-detect-new-commands)
- (amx-update))
- (mapcar (lambda (entry)
- (symbol-name (car entry)))
- amx-cache))
- ((require 'smex nil t)
- (unless smex-initialized-p
- (smex-initialize))
- (when (smex-detect-new-commands)
- (smex-update))
- smex-ido-cache)))
-
-(defun counsel--M-x-prompt ()
- "String for `M-x' plus the string representation of `current-prefix-arg'."
- (concat (cond ((null current-prefix-arg)
- nil)
- ((eq current-prefix-arg '-)
- "- ")
- ((integerp current-prefix-arg)
- (format "%d " current-prefix-arg))
- ((= (car current-prefix-arg) 4)
- "C-u ")
- (t
- (format "%d " (car current-prefix-arg))))
- "M-x "))
-
-(defvar counsel-M-x-history nil
- "History for `counsel-M-x'.")
-
-(defun counsel-M-x-action (cmd)
- "Execute CMD."
- (setq cmd (intern cmd))
- (cond ((bound-and-true-p amx-initialized)
- (amx-rank cmd))
- ((bound-and-true-p smex-initialized-p)
- (smex-rank cmd)))
- (setq prefix-arg current-prefix-arg)
- (setq this-command cmd)
- (setq real-this-command cmd)
- (command-execute cmd 'record))
-
-;;;###autoload
-(defun counsel-M-x (&optional initial-input)
- "Ivy version of `execute-extended-command'.
-Optional INITIAL-INPUT is the initial input in the minibuffer.
-This function integrates with either the `amx' or `smex' package
-when available, in that order of precedence."
- (interactive)
- ;; When `counsel-M-x' returns, `last-command' would be set to
- ;; `counsel-M-x' because :action hasn't been invoked yet.
- ;; Instead, preserve the old value of `this-command'.
- (setq this-command last-command)
- (setq real-this-command real-last-command)
- (let ((externs (counsel--M-x-externs)))
- (ivy-read (counsel--M-x-prompt) (or externs obarray)
- :predicate (if externs
- (lambda (x)
- (not (get (intern x) 'no-counsel-M-x)))
- (lambda (sym)
- (and (commandp sym)
- (not (get sym 'byte-obsolete-info))
- (not (get sym 'no-counsel-M-x)))))
- :require-match t
- :history 'counsel-M-x-history
- :action #'counsel-M-x-action
- :keymap counsel-describe-map
- :initial-input initial-input
- :caller 'counsel-M-x)))
-
-(ivy-configure 'counsel-M-x
- :initial-input "^"
- :display-transformer-fn #'counsel-M-x-transformer)
-
-(ivy-set-actions
- 'counsel-M-x
- `(("d" counsel--find-symbol "definition")
- ("h" ,(lambda (x) (funcall counsel-describe-function-function (intern x)))
"help")))
-
-;;** `counsel-command-history'
-(defun counsel-command-history-action-eval (cmd)
- "Eval the command CMD."
- (eval (read cmd)))
-
-(defun counsel-command-history-action-edit-and-eval (cmd)
- "Edit and eval the command CMD."
- (edit-and-eval-command "Eval: " (read cmd)))
-
-(ivy-set-actions
- 'counsel-command-history
- '(("r" counsel-command-history-action-eval "eval command")
- ("e" counsel-command-history-action-edit-and-eval "edit and eval
command")))
-
-;;;###autoload
-(defun counsel-command-history ()
- "Show the history of commands."
- (interactive)
- (ivy-read "Command: " (mapcar #'prin1-to-string command-history)
- :require-match t
- :action #'counsel-command-history-action-eval
- :caller 'counsel-command-history))
-
-;;** `counsel-load-library'
-(defun counsel-library-candidates ()
- "Return a list of completion candidates for `counsel-load-library'."
- (let ((suffix (concat (regexp-opt '(".el" ".el.gz") t) "\\'"))
- (cands (make-hash-table :test #'equal))
- short-name
- old-val
- dir-parent
- res)
- (dolist (dir load-path)
- (setq dir (or dir default-directory)) ;; interpret nil in load-path as
default-directory
- (when (file-directory-p dir)
- (dolist (file (file-name-all-completions "" dir))
- (when (string-match suffix file)
- (unless (string-match "pkg.elc?$" file)
- (setq short-name (substring file 0 (match-beginning 0)))
- (if (setq old-val (gethash short-name cands))
- (progn
- ;; assume going up directory once will resolve name clash
- (setq dir-parent (counsel-directory-name (cdr old-val)))
- (puthash short-name
- (cons
- (counsel-string-compose dir-parent (car old-val))
- (cdr old-val))
- cands)
- (setq dir-parent (counsel-directory-name dir))
- (puthash (concat dir-parent short-name)
- (cons
- (propertize
- (counsel-string-compose
- dir-parent short-name)
- 'full-name (expand-file-name file dir))
- dir)
- cands))
- (puthash short-name
- (cons (propertize
- short-name
- 'full-name (expand-file-name file dir))
- dir)
- cands)))))))
- (maphash (lambda (_k v) (push (car v) res)) cands)
- (nreverse res)))
-
-;;;###autoload
-(defun counsel-load-library ()
- "Load a selected the Emacs Lisp library.
-The libraries are offered from `load-path'."
- (interactive)
- (let ((cands (counsel-library-candidates)))
- (ivy-read "Load library: " cands
- :action (lambda (x)
- (load-library
- (get-text-property 0 'full-name x)))
- :keymap counsel-describe-map)))
-
-(ivy-set-actions
- 'counsel-load-library
- '(("d" counsel--find-symbol "definition")))
-
-;;** `counsel-find-library'
-(declare-function find-library-name "find-func")
-(defun counsel-find-library-other-window (library)
- (let ((buf (find-file-noselect (find-library-name library))))
- (pop-to-buffer buf 'other-window)))
-
-(defun counsel-find-library-other-frame (library)
- (let ((buf (find-file-noselect (find-library-name library))))
- (condition-case nil
- (switch-to-buffer-other-frame buf)
- (error (pop-to-buffer buf)))))
-
-(ivy-set-actions
- 'counsel-find-library
- '(("j" counsel-find-library-other-window "other window")
- ("f" counsel-find-library-other-frame "other frame")))
-
-;;;###autoload
-(defun counsel-find-library ()
- "Visit a selected the Emacs Lisp library.
-The libraries are offered from `load-path'."
- (interactive)
- (let ((cands (counsel-library-candidates)))
- (ivy-read "Find library: " cands
- :action #'counsel--find-symbol
- :keymap counsel-describe-map
- :caller 'counsel-find-library)))
-
-;;** `counsel-load-theme'
-(declare-function powerline-reset "ext:powerline")
-
-(defun counsel-load-theme-action (x)
- "Disable current themes and load theme X."
- (condition-case nil
- (progn
- (mapc #'disable-theme custom-enabled-themes)
- (load-theme (intern x) t)
- (when (fboundp 'powerline-reset)
- (powerline-reset)))
- (error "Problem loading theme %s" x)))
-
-;;;###autoload
-(defun counsel-load-theme ()
- "Forward to `load-theme'.
-Usable with `ivy-resume', `ivy-next-line-and-call' and
-`ivy-previous-line-and-call'."
- (interactive)
- (ivy-read "Load custom theme: "
- (mapcar 'symbol-name
- (custom-available-themes))
- :action #'counsel-load-theme-action
- :caller 'counsel-load-theme))
-
-;;** `counsel-descbinds'
-(ivy-set-actions
- 'counsel-descbinds
- '(("d" counsel-descbinds-action-find "definition")
- ("I" counsel-descbinds-action-info "info")
- ("x" counsel-descbinds-action-exec "execute")))
-
-(defvar counsel-descbinds-history nil
- "History for `counsel-descbinds'.")
-
-(defun counsel--descbinds-cands (&optional prefix buffer)
- "Get key bindings starting with PREFIX in BUFFER.
-See `describe-buffer-bindings' for further information."
- (let ((buffer (or buffer (current-buffer)))
- (re-exclude (regexp-opt
- '("<vertical-line>" "<bottom-divider>" "<right-divider>"
- "<mode-line>" "<C-down-mouse-2>" "<left-fringe>"
- "<right-fringe>" "<header-line>"
- "<vertical-scroll-bar>" "<horizontal-scroll-bar>")))
- res)
- (with-temp-buffer
- (let ((indent-tabs-mode t))
- (describe-buffer-bindings buffer prefix))
- (goto-char (point-min))
- ;; Skip the "Key translations" section
- (re-search-forward " ")
- (forward-char 1)
- (while (not (eobp))
- (when (looking-at "^\\([^\t\n]+\\)[\t ]*\\(.*\\)$")
- (let ((key (match-string 1))
- (fun (match-string 2))
- cmd)
- (unless (or (member fun '("??" "self-insert-command"))
- (string-match re-exclude key)
- (not (or (commandp (setq cmd (intern-soft fun)))
- (member fun '("Prefix Command")))))
- (push
- (cons (format
- "%-15s %s"
- (propertize key 'face 'counsel-key-binding)
- fun)
- (cons key cmd))
- res))))
- (forward-line 1)))
- (nreverse res)))
-
-(defcustom counsel-descbinds-function #'describe-function
- "Function to call to describe a function passed as parameter."
- :type 'function)
-
-(defun counsel-descbinds-action-describe (x)
- "Describe function of candidate X.
-See `describe-function' for further information."
- (let ((cmd (cddr x)))
- (funcall counsel-descbinds-function cmd)))
-
-(defun counsel-descbinds-action-exec (x)
- "Run candidate X.
-See `execute-extended-command' for further information."
- (let ((cmd (cddr x)))
- (command-execute cmd 'record)))
-
-(defun counsel-descbinds-action-find (x)
- "Find symbol definition of candidate X.
-See `counsel--find-symbol' for further information."
- (let ((cmd (cddr x)))
- (counsel--find-symbol (symbol-name cmd))))
-
-(defun counsel-descbinds-action-info (x)
- "Display symbol definition of candidate X, as found in the relevant manual.
-See `info-lookup-symbol' for further information."
- (let ((cmd (cddr x)))
- (counsel-info-lookup-symbol (symbol-name cmd))))
-
-;;;###autoload
-(defun counsel-descbinds (&optional prefix buffer)
- "Show a list of all defined keys and their definitions.
-If non-nil, show only bindings that start with PREFIX.
-BUFFER defaults to the current one."
- (interactive)
- (ivy-read "Bindings: " (counsel--descbinds-cands prefix buffer)
- :action #'counsel-descbinds-action-describe
- :history 'counsel-descbinds-history
- :caller 'counsel-descbinds))
-
-;;** `counsel-describe-face'
-(defcustom counsel-describe-face-function #'describe-face
- "Function to call to describe a face or face name argument."
- :type 'function)
-
-(defun counsel--face-at-point ()
- "Return name of face around point.
-Try detecting a face name in the text around point before falling
-back to the face of the character after point, and finally the
-`default' face."
- (symbol-name (or (face-at-point t) 'default)))
-
-;;;###autoload
-(defun counsel-describe-face ()
- "Completion for `describe-face'."
- (interactive)
- (ivy-read "Face: " (face-list)
- :require-match t
- :history 'face-name-history
- :preselect (counsel--face-at-point)
- :action counsel-describe-face-function
- :caller 'counsel-describe-face))
-
-(ivy-configure 'counsel-describe-face
- :sort-fn #'ivy-string<)
-
-(defun counsel-customize-face (name)
- "Customize face with NAME."
- (customize-face (intern name)))
-
-(defun counsel-customize-face-other-window (name)
- "Customize face with NAME in another window."
- (customize-face-other-window (intern name)))
-
-(ivy-set-actions
- 'counsel-describe-face
- '(("c" counsel-customize-face "customize")
- ("C" counsel-customize-face-other-window "customize other window")))
-
-;;** `counsel-faces'
-(defvar counsel--faces-format "%-40s %s")
-
-(defun counsel--faces-format-function (names)
- "Format NAMES according to `counsel--faces-format'."
- (let ((formatter
- (lambda (name)
- (format counsel--faces-format name
- (propertize list-faces-sample-text
- 'face (intern name))))))
- (ivy--format-function-generic
- (lambda (name)
- (funcall formatter (ivy--add-face name 'ivy-current-match)))
- formatter names "\n")))
-
-;;;###autoload
-(defun counsel-faces ()
- "Complete faces with preview.
-Actions are provided by default for describing or customizing the
-selected face."
- (interactive)
- (let* ((names (mapcar #'symbol-name (face-list)))
- (counsel--faces-format
- (format "%%-%ds %%s"
- (apply #'max 0 (mapcar #'string-width names)))))
- (ivy-read "Face: " names
- :require-match t
- :history 'face-name-history
- :preselect (counsel--face-at-point)
- :action counsel-describe-face-function
- :caller 'counsel-faces)))
-
-(ivy-configure 'counsel-faces
- :sort-fn #'ivy-string<
- :format-fn #'counsel--faces-format-function)
-
-(ivy-set-actions
- 'counsel-faces
- '(("c" counsel-customize-face "customize")
- ("C" counsel-customize-face-other-window "customize other window")))
-
-;;* Git
-;;** `counsel-git'
-(defvar counsel-git-cmd "git ls-files --full-name --"
- "Command for `counsel-git'.")
-
-(ivy-set-actions
- 'counsel-git
- '(("j" find-file-other-window "other window")
- ("x" counsel-find-file-extern "open externally")))
-
-(defun counsel--dominating-file (file &optional dir)
- "Look up directory hierarchy for FILE, starting in DIR.
-Like `locate-dominating-file', but DIR defaults to
-`default-directory' and the return value is expanded."
- (and (setq dir (locate-dominating-file (or dir default-directory) file))
- (expand-file-name dir)))
-
-(defun counsel-locate-git-root ()
- "Return the root of the Git repository containing the current buffer."
- (or (counsel--git-root)
- (error "Not in a Git repository")))
-
-(defun counsel-git-cands ()
- (let ((default-directory (counsel-locate-git-root)))
- (split-string
- (shell-command-to-string counsel-git-cmd)
- "\n"
- t)))
-
-;;;###autoload
-(defun counsel-git (&optional initial-input)
- "Find file in the current Git repository.
-INITIAL-INPUT can be given as the initial minibuffer input."
- (interactive)
- (counsel-require-program counsel-git-cmd)
- (let ((default-directory (counsel-locate-git-root)))
- (ivy-read "Find file: " (counsel-git-cands)
- :initial-input initial-input
- :action #'counsel-git-action
- :caller 'counsel-git)))
-
-(ivy-configure 'counsel-git
- :occur #'counsel-git-occur)
-
-(defun counsel-git-action (x)
- "Find file X in current Git repository."
- (with-ivy-window
- (let ((default-directory (ivy-state-directory ivy-last)))
- (find-file x))))
-
-(defun counsel-git-occur (&optional _cands)
- "Occur function for `counsel-git' using `counsel-cmd-to-dired'."
- (cd (ivy-state-directory ivy-last))
- (counsel-cmd-to-dired
- (counsel--expand-ls
- (format "%s | %s | xargs ls"
- counsel-git-cmd
- (counsel--file-name-filter)))))
-
-(defvar counsel-dired-listing-switches "-alh"
- "Switches passed to `ls' for `counsel-cmd-to-dired'.")
-
-(defun counsel-cmd-to-dired (full-cmd &optional filter)
- "Adapted from `find-dired'."
- (let ((inhibit-read-only t))
- (erase-buffer)
- (dired-mode default-directory counsel-dired-listing-switches)
- (insert " " default-directory ":\n")
- (let ((point (point)))
- (insert " " full-cmd "\n")
- (dired-insert-set-properties point (point)))
- (setq-local dired-sort-inhibit t)
- (setq-local revert-buffer-function
- (lambda (_1 _2) (counsel-cmd-to-dired full-cmd)))
- (setq-local dired-subdir-alist
- (list (cons default-directory (point-min-marker))))
- (let ((proc (start-process-shell-command
- "counsel-cmd" (current-buffer) full-cmd)))
- (set-process-filter proc filter)
- (set-process-sentinel
- proc
- (lambda (process _msg)
- (when (and (eq (process-status process) 'exit)
- (zerop (process-exit-status process)))
- (goto-char (point-min))
- (forward-line 2)
- (dired-move-to-filename)))))))
-
-;;** `counsel-git-grep'
-(defvar counsel-git-grep-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-l") 'ivy-call-and-recenter)
- (define-key map (kbd "M-q") 'counsel-git-grep-query-replace)
- (define-key map (kbd "C-c C-m") 'counsel-git-grep-switch-cmd)
- (define-key map (kbd "C-x C-d") 'counsel-cd)
- map))
-
-(defvar counsel-git-grep-cmd-default "git --no-pager grep --full-name -n
--no-color -i -I -e \"%s\""
- "Initial command for `counsel-git-grep'.")
-
-(defvar counsel-git-grep-cmd nil
- "Store the command for `counsel-git-grep'.")
-
-(defvar counsel-git-grep-history nil
- "History for `counsel-git-grep'.")
-
-(defvar counsel-git-grep-cmd-history
- (list counsel-git-grep-cmd-default)
- "History for `counsel-git-grep' shell commands.")
-
-(defcustom counsel-grep-post-action-hook nil
- "Hook that runs after the point moves to the next candidate.
-Typical value: '(recenter)."
- :type 'hook)
-
-(defcustom counsel-git-grep-cmd-function
#'counsel-git-grep-cmd-function-default
- "How a git-grep shell call is built from the input."
- :type '(radio
- (function-item counsel-git-grep-cmd-function-default)
- (function-item counsel-git-grep-cmd-function-ignore-order)
- (function :tag "Other")))
-
-(defun counsel-git-grep-cmd-function-default (str)
- (format counsel-git-grep-cmd
- (setq ivy--old-re
- (if (eq ivy--regex-function #'ivy--regex-fuzzy)
- (replace-regexp-in-string
- "\n" "" (ivy--regex-fuzzy str))
- (ivy--regex str t)))))
-
-(defun counsel-git-grep-cmd-function-ignore-order (str)
- (setq ivy--old-re (ivy--regex str t))
- (let ((parts (split-string str " " t)))
- (concat
- "git --no-pager grep --full-name -n --no-color -i -e "
- (mapconcat #'shell-quote-argument parts " --and -e "))))
-
-(defun counsel-git-grep-function (string)
- "Grep in the current Git repository for STRING."
- (or
- (ivy-more-chars)
- (progn
- (counsel--async-command
- (funcall counsel-git-grep-cmd-function string))
- nil)))
-
-(defun counsel-git-grep-action (x)
- "Go to occurrence X in current Git repository."
- (when (string-match "\\`\\(.*?\\):\\([0-9]+\\):\\(.*\\)\\'" x)
- (let ((file-name (match-string-no-properties 1 x))
- (line-number (match-string-no-properties 2 x)))
- (find-file (expand-file-name
- file-name
- (ivy-state-directory ivy-last)))
- (goto-char (point-min))
- (forward-line (1- (string-to-number line-number)))
- (when (re-search-forward (ivy--regex ivy-text t) (line-end-position) t)
- (when swiper-goto-start-of-match
- (goto-char (match-beginning 0))))
- (swiper--ensure-visible)
- (run-hooks 'counsel-grep-post-action-hook)
- (unless (eq ivy-exit 'done)
- (swiper--cleanup)
- (swiper--add-overlays (ivy--regex ivy-text))))))
-
-(defun counsel-git-grep-transformer (str)
- "Higlight file and line number in STR."
- (when (string-match "\\`\\([^:]+\\):\\([^:]+\\):" str)
- (ivy-add-face-text-property (match-beginning 1) (match-end 1)
- 'ivy-grep-info
- str)
- (ivy-add-face-text-property (match-beginning 2) (match-end 2)
- 'ivy-grep-line-number
- str))
- str)
-
-(defvar counsel-git-grep-projects-alist nil
- "An alist of project directory to \"git-grep\" command.
-Allows to automatically use a custom \"git-grep\" command for all
-files in a project.")
-
-(defun counsel--git-grep-cmd-and-proj (cmd)
- (let ((dd (expand-file-name default-directory))
- proj)
- (cond
- ((stringp cmd))
- (current-prefix-arg
- (if (setq proj
- (cl-find-if
- (lambda (x)
- (string-match (car x) dd))
- counsel-git-grep-projects-alist))
- (setq cmd (cdr proj))
- (setq cmd
- (ivy-read "cmd: " counsel-git-grep-cmd-history
- :history 'counsel-git-grep-cmd-history
- :re-builder #'ivy--regex))
- (setq counsel-git-grep-cmd-history
- (delete-dups counsel-git-grep-cmd-history))))
- (t
- (setq cmd counsel-git-grep-cmd-default)))
- (cons proj cmd)))
-
-(defun counsel--call (command &optional result-fn)
- "Synchronously call COMMAND and return its output as a string.
-COMMAND comprises the program name followed by its arguments, as
-in `make-process'. Signal `file-error' and emit a warning if
-COMMAND fails. Obey file handlers based on `default-directory'.
-On success, RESULT-FN is called in output buffer with no arguments."
- (let ((stderr (make-temp-file "counsel-call-stderr-"))
- status)
- (unwind-protect
- (with-temp-buffer
- (setq status (apply #'process-file (car command) nil
- (list t stderr) nil (cdr command)))
- (if (eq status 0)
- (if result-fn
- (funcall result-fn)
- ;; Return all output except trailing newline.
- (buffer-substring (point-min)
- (- (point)
- (if (eq (bobp) (bolp))
- 0
- 1))))
- ;; Convert process status into error list.
- (setq status (list 'file-error
- (mapconcat #'identity `(,@command "failed") "
")
- status))
- ;; Print stderr contents, if any, to *Warnings* buffer.
- (let ((msg (condition-case err
- (unless (zerop (cadr (insert-file-contents
- stderr nil nil nil t)))
- (buffer-string))
- (error (error-message-string err)))))
- (lwarn 'ivy :warning "%s" (apply #'concat
- (error-message-string status)
- (and msg (list "\n" msg)))))
- ;; Signal `file-error' with process status.
- (signal (car status) (cdr status))))
- (delete-file stderr))))
-
-(defun counsel--command (&rest command)
- "Forward COMMAND to `counsel--call'."
- (counsel--call command))
-
-(defun counsel--grep-unwind ()
- (counsel-delete-process)
- (swiper--cleanup))
-
-;;;###autoload
-(defun counsel-git-grep (&optional initial-input initial-directory cmd)
- "Grep for a string in the current Git repository.
-INITIAL-INPUT can be given as the initial minibuffer input.
-INITIAL-DIRECTORY, if non-nil, is used as the root directory for search.
-When CMD is a string, use it as a \"git grep\" command.
-When CMD is non-nil, prompt for a specific \"git grep\" command."
- (interactive)
- (let ((proj-and-cmd (counsel--git-grep-cmd-and-proj cmd))
- proj)
- (setq proj (car proj-and-cmd))
- (setq counsel-git-grep-cmd (cdr proj-and-cmd))
- (counsel-require-program counsel-git-grep-cmd)
- (let ((collection-function
- (if proj
- #'counsel-git-grep-proj-function
- #'counsel-git-grep-function))
- (default-directory (or initial-directory
- (if proj
- (car proj)
- (counsel-locate-git-root)))))
- (ivy-read "git grep: " collection-function
- :initial-input initial-input
- :dynamic-collection t
- :keymap counsel-git-grep-map
- :action #'counsel-git-grep-action
- :history 'counsel-git-grep-history
- :caller 'counsel-git-grep))))
-
-(ivy-configure 'counsel-git-grep
- :occur #'counsel-git-grep-occur
- :unwind-fn #'counsel--grep-unwind
- :index-fn #'ivy-recompute-index-swiper-async
- :display-transformer-fn #'counsel-git-grep-transformer
- :grep-p t
- :exit-codes '(1 "No matches found"))
-
-(defun counsel-git-grep-proj-function (str)
- "Grep for STR in the current Git repository."
- (or
- (ivy-more-chars)
- (let ((regex (setq ivy--old-re
- (ivy--regex str t))))
- (counsel--async-command (format counsel-git-grep-cmd regex))
- nil)))
-
-(defun counsel-git-grep-switch-cmd ()
- "Set `counsel-git-grep-cmd' to a different value."
- (interactive)
- (setq counsel-git-grep-cmd
- (ivy-read "cmd: " counsel-git-grep-cmd-history
- :history 'counsel-git-grep-cmd-history))
- (setq counsel-git-grep-cmd-history
- (delete-dups counsel-git-grep-cmd-history))
- (unless (ivy-state-dynamic-collection ivy-last)
- (setq ivy--all-candidates
- (all-completions "" 'counsel-git-grep-function))))
-
-(defun counsel--normalize-grep-match (str)
- ;; Prepend ./ if necessary:
- (unless (ivy--starts-with-dotslash str)
- (setq str (concat "./" str)))
- ;; Remove column info if any:
- (save-match-data
- (when (string-match
- "[^\n:]+?[^\n/:]:[\t ]*[1-9][0-9]*[\t ]*:\\([1-9][0-9]*:\\)"
- str)
- (setq str (replace-match "" t t str 1))))
- str)
-
-(defun counsel--git-grep-occur-cmd (input)
- (let* ((regex (funcall ivy--regex-function input))
- (regex (if (eq ivy--regex-function #'ivy--regex-fuzzy)
- (replace-regexp-in-string "\n" "" regex)
- regex))
- (positive-pattern (replace-regexp-in-string
- ;; git-grep can't handle .*?
- "\\.\\*\\?" ".*"
- (ivy-re-to-str regex)))
- (negative-patterns
- (if (stringp regex) ""
- (mapconcat (lambda (x)
- (and (null (cdr x))
- (format "| grep -v %s" (car x))))
- regex
- " "))))
- (concat (format counsel-git-grep-cmd positive-pattern) negative-patterns)))
-
-(defun counsel-git-grep-occur (&optional _cands)
- "Generate a custom occur buffer for `counsel-git-grep'."
- (counsel-grep-like-occur #'counsel--git-grep-occur-cmd))
-
-(defun counsel-git-grep-query-replace ()
- "Start `query-replace' with string to replace from last search string."
- (interactive)
- (unless (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
- (ivy-state-directory ivy-last)))
- (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))))))))))
-
-;;** `counsel-git-stash'
-(defun counsel-git-stash-kill-action (x)
- "Add git stash command to kill ring.
-The git command applies the stash entry where candidate X was found in."
- (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* ((default-directory (counsel-locate-git-root))
- (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'
-(defvar counsel-git-log-cmd "GIT_PAGER=cat git log --grep '%s'"
- "Command used for \"git log\".")
-
-(defun counsel-git-log-function (str)
- "Search for STR in git log."
- (or
- (ivy-more-chars)
- (progn
- ;; `counsel--yank-pop-format-function' uses this
- (setq ivy--old-re (funcall ivy--regex-function str))
- (counsel--async-command
- ;; "git log --grep" likes to have groups quoted e.g. \(foo\).
- ;; But it doesn't like the non-greedy ".*?".
- (format counsel-git-log-cmd
- (replace-regexp-in-string "\\.\\*\\?" ".*"
- (ivy-re-to-str ivy--old-re))))
- nil)))
-
-(defun counsel-git-log-action (x)
- "Add candidate X to kill ring."
- (message "%S" (kill-new x)))
-
-(declare-function magit-show-commit "ext:magit-diff")
-
-(defun counsel-git-log-show-commit-action (log-entry)
- "Visit the commit corresponding to LOG-ENTRY."
- (require 'magit-diff)
- (let ((commit (substring-no-properties log-entry 0 (string-match-p "\\W"
log-entry))))
- (magit-show-commit commit)))
-
-(ivy-set-actions
- 'counsel-git-log
- '(("v" counsel-git-log-show-commit-action "visit commit")))
-
-;;** `counsel-git-change-worktree'
-(defun counsel-git-change-worktree-action (git-root-dir tree)
- "Find the corresponding file in the worktree located at tree.
-The current buffer is assumed to be in a subdirectory of GIT-ROOT-DIR.
-TREE is the selected candidate."
- (let* ((new-root-dir (counsel-git-worktree-parse-root tree))
- (tree-filename (file-relative-name buffer-file-name git-root-dir))
- (file-name (expand-file-name tree-filename new-root-dir)))
- (find-file file-name)))
-
-(defun counsel-git-worktree-list ()
- "List worktrees in the Git repository containing the current buffer."
- (let ((default-directory (counsel-locate-git-root)))
- (split-string (shell-command-to-string "git worktree list") "\n" t)))
-
-(defun counsel-git-worktree-parse-root (tree)
- "Return worktree from candidate TREE."
- (substring tree 0 (string-match-p " " tree)))
-
-(defun counsel-git-close-worktree-files-action (root-dir)
- "Close all buffers from the worktree located at ROOT-DIR."
- (setq root-dir (counsel-git-worktree-parse-root root-dir))
- (save-excursion
- (dolist (buf (buffer-list))
- (set-buffer buf)
- (and buffer-file-name
- (string= "." (file-relative-name root-dir
(counsel-locate-git-root)))
- (kill-buffer buf)))))
-
-(ivy-set-actions
- 'counsel-git-change-worktree
- '(("k" counsel-git-close-worktree-files-action "kill all")))
-
-;;;###autoload
-(defun counsel-git-change-worktree ()
- "Find the file corresponding to the current buffer on a different worktree."
- (interactive)
- (let ((default-directory (counsel-locate-git-root)))
- (ivy-read "Select worktree: "
- (or (cl-delete default-directory (counsel-git-worktree-list)
- :key #'counsel-git-worktree-parse-root :test
#'string=)
- (error "No other worktrees!"))
- :action (lambda (tree)
- (counsel-git-change-worktree-action
- (ivy-state-directory ivy-last) tree))
- :require-match t
- :caller 'counsel-git-change-worktree)))
-
-;;** `counsel-git-checkout'
-(defun counsel-git-checkout-action (branch)
- "Switch branch by invoking git-checkout(1).
-The command is passed a single argument comprising all characters
-in BRANCH up to, but not including, the first space
-character (#x20), or the string's end if it lacks a space."
- (shell-command
- (format "git checkout %s"
- (shell-quote-argument
- (substring branch 0 (string-match-p " " branch))))))
-
-(defun counsel-git-branch-list ()
- "Return list of branches in the current Git repository.
-Value comprises all local and remote branches bar the one
-currently checked out."
- (cl-mapcan (lambda (line)
- (and (string-match "\\`[[:blank:]]+" line)
- (list (substring line (match-end 0)))))
- (let ((default-directory (counsel-locate-git-root)))
- (split-string (shell-command-to-string "git branch -vv --all")
- "\n" t))))
-
-;;;###autoload
-(defun counsel-git-checkout ()
- "Call the \"git checkout\" command."
- (interactive)
- (ivy-read "Checkout branch: " (counsel-git-branch-list)
- :action #'counsel-git-checkout-action
- :caller 'counsel-git-checkout))
-
-(defvar counsel-yank-pop-truncate-radius)
-
-(defun counsel--git-log-format-function (str)
- (let ((counsel-yank-pop-truncate-radius 5))
- (counsel--yank-pop-format-function str)))
-
-;;;###autoload
-(defun counsel-git-log ()
- "Call the \"git log --grep\" shell command."
- (interactive)
- (ivy-read "Grep log: " #'counsel-git-log-function
- :dynamic-collection t
- :action #'counsel-git-log-action
- :caller 'counsel-git-log))
-
-(ivy-configure 'counsel-git-log
- :height 4
- :unwind-fn #'counsel-delete-process
- :format-fn #'counsel--git-log-format-function)
-
-(add-to-list 'counsel-async-split-string-re-alist '(counsel-git-log . "^commit
"))
-(add-to-list 'counsel-async-ignore-re-alist '(counsel-git-log . "^[ \n]*$"))
-
-;;* 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)
- (define-key map (kbd "`") (ivy-make-magic-action 'counsel-find-file "b"))
- map))
-
-(when (executable-find "git")
- (add-to-list 'ivy-ffap-url-functions 'counsel-github-url-p)
- (add-to-list 'ivy-ffap-url-functions 'counsel-emacs-url-p))
-(add-to-list 'ivy-ffap-url-functions 'counsel-url-expand)
-(defun counsel-find-file-cd-bookmark-action (_)
- "Reset `counsel-find-file' from selected directory."
- (ivy-read "cd: "
- (progn
- (ivy--virtual-buffers)
- (delete-dups
- (mapcar (lambda (x) (file-name-directory (cdr x)))
- ivy--virtual-buffers)))
- :action (lambda (x)
- (let ((default-directory (file-name-directory x)))
- (counsel-find-file)))))
-
-(defcustom counsel-root-command "sudo"
- "Command to gain root privileges."
- :type 'string)
-
-(defun counsel-find-file-as-root (x)
- "Find file X with root privileges."
- (counsel-require-program counsel-root-command)
- (let* ((host (file-remote-p x 'host))
- (file-name (format "/%s:%s:%s"
- counsel-root-command
- (or host "")
- (expand-file-name
- (if host
- (file-remote-p x 'localname)
- x)))))
- ;; If the current buffer visits the same file we are about to open,
- ;; replace the current buffer with the new one.
- (if (eq (current-buffer) (get-file-buffer x))
- (find-alternate-file file-name)
- (find-file file-name))))
-
-(defun counsel--yes-or-no-p (fmt &rest args)
- "Ask user a yes or no question created using FMT and ARGS.
-If Emacs 26 user option `read-answer-short' is bound, use it to
-choose between `yes-or-no-p' and `y-or-n-p'; otherwise default to
-`yes-or-no-p'."
- (funcall (if (and (boundp 'read-answer-short)
- (cond ((eq read-answer-short t))
- ((eq read-answer-short 'auto)
- (eq (symbol-function 'yes-or-no-p) 'y-or-n-p))))
- #'y-or-n-p
- #'yes-or-no-p)
- (apply #'format fmt args)))
-
-(defun counsel-find-file-copy (x)
- "Copy file X."
- (require 'dired-aux)
- (counsel--find-file-1 "Copy file to: "
- ivy--directory
- (lambda (new-name)
- (dired-copy-file x new-name 1))
- 'counsel-find-file-copy))
-
-(defun counsel-find-file-delete (x)
- "Delete file X."
- (when (or delete-by-moving-to-trash
- ;; `dired-delete-file', which see, already prompts for directories
- (eq t (car (file-attributes x)))
- (counsel--yes-or-no-p "Delete %s? " x))
- (dired-delete-file x dired-recursive-deletes delete-by-moving-to-trash)
- (dired-clean-up-after-deletion x)
- (let ((win (and (not (eq ivy-exit 'done))
- (active-minibuffer-window))))
- (when win (with-selected-window win (ivy--cd ivy--directory))))))
-
-(defun counsel-find-file-move (x)
- "Move or rename file X."
- (require 'dired-aux)
- (counsel--find-file-1 "Rename file to: "
- ivy--directory
- (lambda (new-name)
- (dired-rename-file x new-name 1))
- 'counsel-find-file-move))
-
-(defun counsel-find-file-mkdir-action (_x)
- "Create a directory and any nonexistent parent dirs from `ivy-text'."
- (let ((dir (file-name-as-directory
- (expand-file-name ivy-text ivy--directory)))
- (win (and (not (eq ivy-exit 'done))
- (active-minibuffer-window))))
- (make-directory dir t)
- (when win (with-selected-window win (ivy--cd dir)))))
-
-(ivy-set-actions
- 'counsel-find-file
- '(("j" find-file-other-window "other window")
- ("f" find-file-other-frame "other frame")
- ("b" counsel-find-file-cd-bookmark-action "cd bookmark")
- ("x" counsel-find-file-extern "open externally")
- ("r" counsel-find-file-as-root "open as root")
- ("R" find-file-read-only "read only")
- ("k" counsel-find-file-delete "delete")
- ("c" counsel-find-file-copy "copy file")
- ("m" counsel-find-file-move "move or rename")
- ("d" counsel-find-file-mkdir-action "mkdir")))
-
-(defcustom counsel-find-file-at-point nil
- "When non-nil, add file-at-point to the list of candidates."
- :type 'boolean)
-
-(defcustom counsel-preselect-current-file nil
- "When non-nil, preselect current file in list of candidates."
- :type 'boolean)
-
-(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."
- :type `(choice
- (const :tag "None" nil)
- (const :tag "Dotfiles and Lockfiles"
"\\(?:\\`\\|[/\\]\\)\\(?:[#.]\\)")
- (const :tag "Ignored Extensions"
- ,(regexp-opt completion-ignored-extensions))
- (regexp :tag "Regex")))
-
-(defvar counsel--find-file-predicate nil
- "When non-nil, `counsel--find-file-matcher' will use this predicate.")
-
-(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
- (lambda (re-str)
- (lambda (x)
- (string-match re-str (directory-file-name x)))))))
- (when counsel--find-file-predicate
- (let ((default-directory ivy--directory))
- (setq res (cl-remove-if-not counsel--find-file-predicate res))))
- (if (or (null ivy-use-ignore)
- (null counsel-find-file-ignore-regexp)
- (string-match-p "\\`\\." ivy-text))
- res
- (or (cl-remove-if
- (lambda (x)
- (and
- (string-match-p counsel-find-file-ignore-regexp x)
- (not (member x ivy-extra-directories))))
- res)
- res))))
-
-(declare-function ffap-guesser "ffap")
-
-(defvar counsel-find-file-speedup-remote t
- "Speed up opening remote files by disabling `find-file-hook' for them.")
-
-(defcustom counsel-find-file-extern-extensions '("mp4" "mkv" "xlsx")
- "List of extensions that make `counsel-find-file' use
`counsel-find-file-extern'."
- :type '(repeat string))
-
-(defun counsel-find-file-action (x)
- "Find file X."
- (with-ivy-window
- (cond ((and counsel-find-file-speedup-remote
- (file-remote-p ivy--directory))
- (let ((find-file-hook nil))
- (find-file (expand-file-name x ivy--directory))))
- ((member (file-name-extension x) counsel-find-file-extern-extensions)
- (counsel-find-file-extern x))
- (t
- (find-file (expand-file-name x ivy--directory))))))
-
-(defun counsel--preselect-file ()
- "Return candidate to preselect during filename completion.
-The preselect behavior can be customized via user options
-`counsel-find-file-at-point' and
-`counsel-preselect-current-file', which see."
- (or
- (when counsel-find-file-at-point
- (require 'ffap)
- (let ((f (ffap-guesser)))
- (when f (expand-file-name f))))
- (and counsel-preselect-current-file
- buffer-file-name
- (file-name-nondirectory buffer-file-name))))
-
-(defun counsel--find-file-1 (prompt initial-input action caller)
- (let ((default-directory
- (if (eq major-mode 'dired-mode)
- (dired-current-directory)
- default-directory)))
- (ivy-read prompt #'read-file-name-internal
- :matcher #'counsel--find-file-matcher
- :initial-input initial-input
- :action action
- :preselect (counsel--preselect-file)
- :require-match 'confirm-after-completion
- :history 'file-name-history
- :keymap counsel-find-file-map
- :caller caller)))
-
-;;;###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)
- (counsel--find-file-1
- "Find file: " initial-input
- #'counsel-find-file-action
- 'counsel-find-file))
-
-(ivy-configure 'counsel-find-file
- :occur #'counsel-find-file-occur
- :display-transformer-fn #'ivy-read-file-transformer)
-
-(defvar counsel-find-file-occur-cmd "ls -a | %s | xargs -d '\\n' ls -d
--group-directories-first"
- "Format string for `counsel-find-file-occur'.")
-
-(defvar counsel-find-file-occur-use-find (not (eq system-type 'gnu/linux))
- "When non-nil, `counsel-find-file-occur' will use \"find\" as the base cmd.")
-
-(defun counsel--expand-ls (cmd)
- "Expand CMD that ends in \"ls\" with switches."
- (concat cmd " " counsel-dired-listing-switches " | sed -e \"s/^/ /\""))
-
-(defvar counsel-file-name-filter-alist
- '(("ag -i '%s'" . t)
- ("ack -i '%s'" . t)
- ("perl -ne '/(%s.*)/i && print \"$1\\n\";'" . t)
- ("grep -i -E '%s'"))
- "Alist of file name filtering commands.
-The car is a shell command and the cdr is t when the shell
-command supports look-arounds. The executable for the commands
-will be checked for existence via `executable-find'. The first
-one that exists will be used.")
-
-(defun counsel--file-name-filter (&optional use-ignore)
- "Return a command that filters a file list to match ivy candidates.
-If USE-IGNORE is non-nil, try to generate a command that respects
-`counsel-find-file-ignore-regexp'."
- (let ((regex ivy--old-re))
- (if (= 0 (length regex))
- "cat"
- (let ((filter-cmd (cl-find-if
- (lambda (x)
- (executable-find
- (car (split-string (car x)))))
- counsel-file-name-filter-alist))
- cmd)
- (when (and use-ignore ivy-use-ignore
- counsel-find-file-ignore-regexp
- (cdr filter-cmd)
- (not (string-match-p "\\`\\." ivy-text))
- (not (string-match-p counsel-find-file-ignore-regexp
- (or (car ivy--old-cands) ""))))
- (let ((ignore-re (list (counsel--elisp-to-pcre
- counsel-find-file-ignore-regexp))))
- (setq regex (if (stringp regex)
- (list ignore-re (cons regex t))
- (cons ignore-re regex)))))
- (setq cmd (format (car filter-cmd)
- (counsel--elisp-to-pcre regex (cdr filter-cmd))))
- (if (string-match-p "csh\\'" shell-file-name)
- (replace-regexp-in-string "\\?!" "?\\\\!" cmd)
- cmd)))))
-
-(defun counsel--occur-cmd-find ()
- (let ((cmd (format
- "find . -maxdepth 1 | %s | xargs -I {} find {} -maxdepth 0 -ls"
- (counsel--file-name-filter t))))
- (concat
- (counsel--cmd-to-dired-by-type "d" cmd)
- " && "
- (counsel--cmd-to-dired-by-type "f" cmd))))
-
-(defun counsel--cmd-to-dired-by-type (type cmd)
- (let ((exclude-dots
- (if (string-match "^\\." ivy-text)
- ""
- " | grep -v '/\\\\.'")))
- (replace-regexp-in-string
- " | grep"
- (concat " -type " type exclude-dots " | grep") cmd)))
-
-(defun counsel-find-file-occur (&optional _cands)
- (require 'find-dired)
- (cd ivy--directory)
- (if counsel-find-file-occur-use-find
- (counsel-cmd-to-dired
- (counsel--occur-cmd-find)
- 'find-dired-filter)
- (counsel-cmd-to-dired
- (counsel--expand-ls
- (format counsel-find-file-occur-cmd
- (if (string-match-p "grep" counsel-find-file-occur-cmd)
- ;; for backwards compatibility
- (counsel--elisp-to-pcre ivy--old-re)
- (counsel--file-name-filter t)))))))
-
-(defvar counsel-up-directory-level t
- "Control whether `counsel-up-directory' goes up a level or always a
directory.
-
-If non-nil, then `counsel-up-directory' will remove the final level of the
path.
-For example: /a/long/path/file.jpg => /a/long/path/
- /a/long/path/ => /a/long/
-
-If nil, then `counsel-up-directory' will go up a directory.
-For example: /a/long/path/file.jpg => /a/long/
- /a/long/path/ => /a/long/")
-
-(defun counsel-up-directory ()
- "Go to the parent directory preselecting the current one.
-
-If the current directory is remote and it's not possible to go up any
-further, make the remote prefix editable.
-
-See variable `counsel-up-directory-level'."
- (interactive)
- (let* ((cur-dir (directory-file-name (expand-file-name ivy--directory)))
- (up-dir (file-name-directory cur-dir)))
- (if (and (file-remote-p cur-dir) (string-equal cur-dir up-dir))
- (progn
- ;; make the remote prefix editable
- (setq ivy--old-cands nil)
- (setq ivy--old-re nil)
- (ivy-set-index 0)
- (setq ivy--directory "")
- (setq ivy--all-candidates nil)
- (setq ivy-text "")
- (delete-minibuffer-contents)
- (insert up-dir))
- (if (and counsel-up-directory-level (not (string= ivy-text "")))
- (delete-region (line-beginning-position) (line-end-position))
- (ivy--cd up-dir)
- (setf (ivy-state-preselect ivy-last)
- (file-name-as-directory (file-name-nondirectory cur-dir)))))))
-
-(defun counsel-down-directory ()
- "Descend into the current directory."
- (interactive)
- (ivy--directory-enter))
-
-(defun counsel-at-git-issue-p ()
- "When 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 vc-git-log-view-mode))
- (bound-and-true-p magit-commit-mode))
- (match-string-no-properties 0)))
-
-(defun counsel-github-url-p ()
- "Return a Github issue URL at point."
- (counsel-require-program "git")
- (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."
- (counsel-require-program "git")
- (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 "https://debbugs.gnu.org/cgi/bugreport.cgi?bug=%s";
- (substring url 1)))))))
-
-(defvar counsel-url-expansions-alist nil
- "Map of regular expressions to expansions.
-
-This variable should take the form of a list of (REGEXP . FORMAT)
-pairs.
-
-`counsel-url-expand' will expand the word at point according to
-FORMAT for the first matching REGEXP. FORMAT can be either a
-string or a function. If it is a string, it will be used as the
-format string for the `format' function, with the word at point
-as the next argument. If it is a function, it will be called
-with the word at point as the sole argument.
-
-For example, a pair of the form:
- '(\"\\`BSERV-[[:digit:]]+\\'\" . \"https://jira.atlassian.com/browse/%s\";)
-will expand to URL `https://jira.atlassian.com/browse/BSERV-100'
-when the word at point is BSERV-100.
-
-If the format element is a function, more powerful
-transformations are possible. As an example,
- '(\"\\`issue\\([[:digit:]]+\\)\\'\" .
- (lambda (word)
- (concat \"https://debbugs.gnu.org/cgi/bugreport.cgi?bug=\";
- (match-string 1 word))))
-trims the \"issue\" prefix from the word at point before creating the URL.")
-
-(defun counsel-url-expand ()
- "Expand word at point using `counsel-url-expansions-alist'.
-The first pair in the list whose regexp matches the word at point
-will be expanded according to its format. This function is
-intended to be used in `ivy-ffap-url-functions' to browse the
-result as a URL."
- (let ((word-at-point (current-word)))
- (when word-at-point
- (cl-some
- (lambda (pair)
- (let ((regexp (car pair))
- (formatter (cdr pair)))
- (when (string-match regexp word-at-point)
- (if (functionp formatter)
- (funcall formatter word-at-point)
- (format formatter word-at-point)))))
- counsel-url-expansions-alist))))
-
-;;** `counsel-dired'
-(declare-function dired "dired")
-
-;;;###autoload
-(defun counsel-dired (&optional initial-input)
- "Forward to `dired'.
-When INITIAL-INPUT is non-nil, use it in the minibuffer during completion."
- (interactive)
- (let ((counsel--find-file-predicate #'file-directory-p))
- (counsel--find-file-1
- "Dired (directory): " initial-input
- (lambda (d) (dired (expand-file-name d)))
- 'counsel-dired)))
-
-(ivy-configure 'counsel-dired
- :display-transformer-fn #'ivy-read-file-transformer)
-
-;;** `counsel-recentf'
-(defvar recentf-list)
-(declare-function recentf-mode "recentf")
-
-;;;###autoload
-(defun counsel-recentf ()
- "Find a file on `recentf-list'."
- (interactive)
- (require 'recentf)
- (recentf-mode)
- (ivy-read "Recentf: " (mapcar #'substring-no-properties recentf-list)
- :action (lambda (f)
- (with-ivy-window
- (find-file f)))
- :require-match t
- :caller 'counsel-recentf))
-(ivy-set-actions
- 'counsel-recentf
- '(("j" find-file-other-window "other window")
- ("f" find-file-other-frame "other frame")
- ("x" counsel-find-file-extern "open externally")))
-
-(defun counsel-buffer-or-recentf-candidates ()
- "Return candidates for `counsel-buffer-or-recentf'."
- (require 'recentf)
- (recentf-mode)
- (let ((buffers
- (delq nil
- (mapcar (lambda (b)
- (when (buffer-file-name b)
- (buffer-file-name b)))
- (buffer-list)))))
- (append
- buffers
- (cl-remove-if (lambda (f) (member f buffers))
- (mapcar #'substring-no-properties recentf-list)))))
-
-;;;###autoload
-(defun counsel-buffer-or-recentf ()
- "Find a buffer visiting a file or file on `recentf-list'."
- (interactive)
- (ivy-read "Buffer File or Recentf: " (counsel-buffer-or-recentf-candidates)
- :action (lambda (s)
- (with-ivy-window
- (if (bufferp s)
- (switch-to-buffer s)
- (find-file s))))
- :require-match t
- :caller 'counsel-buffer-or-recentf))
-
-(ivy-configure 'counsel-buffer-or-recentf
- :display-transformer-fn #'counsel-buffer-or-recentf-transformer)
-
-(ivy-set-actions
- 'counsel-buffer-or-recentf
- '(("j" find-file-other-window "other window")
- ("f" find-file-other-frame "other frame")
- ("x" counsel-find-file-extern "open externally")))
-
-(defun counsel-buffer-or-recentf-transformer (var)
- "Propertize VAR if it's a buffer visiting a file."
- (if (member var (mapcar #'buffer-file-name (buffer-list)))
- (ivy-append-face var 'ivy-highlight-face)
- var))
-
-;;** `counsel-bookmark'
-(defcustom counsel-bookmark-avoid-dired nil
- "If non-nil, open directory bookmarks with `counsel-find-file'.
-By default `counsel-bookmark' opens a dired buffer for directories."
- :type 'boolean)
-
-(defvar bookmark-alist)
-(declare-function bookmark-location "bookmark")
-(declare-function bookmark-all-names "bookmark")
-(declare-function bookmark-get-filename "bookmark")
-(declare-function bookmark-maybe-load-default-file "bookmark")
-
-;;;###autoload
-(defun counsel-bookmark ()
- "Forward to `bookmark-jump' or `bookmark-set' if bookmark doesn't exist."
- (interactive)
- (require 'bookmark)
- (ivy-read "Create or jump to bookmark: "
- (bookmark-all-names)
- :history 'bookmark-history
- :action (lambda (x)
- (cond ((and counsel-bookmark-avoid-dired
- (member x (bookmark-all-names))
- (file-directory-p (bookmark-location x)))
- (with-ivy-window
- (let ((default-directory (bookmark-location x)))
- (counsel-find-file))))
- ((member x (bookmark-all-names))
- (with-ivy-window
- (bookmark-jump x)))
- (t
- (bookmark-set x))))
- :caller 'counsel-bookmark))
-
-(defun counsel--apply-bookmark-fn (fn)
- "Return a function applying FN to a bookmark's location."
- (lambda (bookmark)
- (funcall fn (bookmark-location bookmark))))
-
-(ivy-set-actions
- 'counsel-bookmark
- `(("d" bookmark-delete "delete")
- ("e" bookmark-rename "edit")
- ("x" ,(counsel--apply-bookmark-fn #'counsel-find-file-extern)
- "open externally")
- ("r" ,(counsel--apply-bookmark-fn #'counsel-find-file-as-root)
- "open as root")))
-
-;;** `counsel-bookmarked-directory'
-(defun counsel-bookmarked-directory--candidates ()
- "Get a list of bookmarked directories sorted by file path."
- (bookmark-maybe-load-default-file)
- (sort (cl-remove-if-not
- #'ivy--dirname-p
- (delq nil (mapcar #'bookmark-get-filename bookmark-alist)))
- #'string<))
-
-;;;###autoload
-(defun counsel-bookmarked-directory ()
- "Ivy interface for bookmarked directories.
-
-With a prefix argument, this command creates a new bookmark which points to the
-current value of `default-directory'."
- (interactive)
- (require 'bookmark)
- (ivy-read "Bookmarked directory: "
- (counsel-bookmarked-directory--candidates)
- :caller 'counsel-bookmarked-directory
- :action #'dired))
-
-(ivy-set-actions 'counsel-bookmarked-directory
- '(("j" dired-other-window "other window")
- ("x" counsel-find-file-extern "open externally")
- ("r" counsel-find-file-as-root "open as root")
- ("f" (lambda (dir)
- (let ((default-directory dir))
- (call-interactively #'find-file)))
- "find-file")))
-
-;;** `counsel-file-register'
-;;;###autoload
-(defun counsel-file-register ()
- "Search file in register.
-
-You cannot use Emacs' normal register commands to create file
-registers. Instead you must use the `set-register' function like
-so: `(set-register ?i \"/home/eric/.emacs.d/init.el\")'. Now you
-can use `C-x r j i' to open that file."
- (interactive)
- (ivy-read "File Register: "
- ;; Use the `register-alist' variable to filter out file
- ;; registers. Each entry for a file register will have the
- ;; following layout:
- ;;
- ;; (NUMBER 'file . "string/path/to/file")
- ;;
- ;; So we go through each entry and see if the `cadr' is
- ;; `eq' to the symbol `file'. If so then add the filename
- ;; (`cddr') which `ivy-read' will use for its choices.
- (mapcar (lambda (register-alist-entry)
- (if (eq 'file (cadr register-alist-entry))
- (cddr register-alist-entry)))
- register-alist)
- :require-match t
- :history 'counsel-file-register
- :caller 'counsel-file-register
- :action (lambda (register-file)
- (with-ivy-window (find-file register-file)))))
-
-(ivy-configure 'counsel-file-register
- :sort-fn #'ivy-string<)
-
-(ivy-set-actions
- 'counsel-file-register
- '(("j" find-file-other-window "other window")))
-
-;;** `counsel-locate'
-(defcustom counsel-locate-cmd (cond ((memq system-type '(darwin berkeley-unix))
- '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."
- :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")
- ("r" counsel-find-file-as-root "open as root")
- ("d" counsel-locate-action-dired "dired")))
-
-(defvar counsel-locate-history nil
- "History for `counsel-locate'.")
-
-;;;###autoload
-(defun counsel-locate-action-extern (x)
- "Pass X to `xdg-open' or equivalent command via the shell."
- (interactive "FFile: ")
- (if (and (eq system-type 'windows-nt)
- (fboundp 'w32-shell-execute))
- (w32-shell-execute "open" x)
- (call-process-shell-command (format "%s %s"
- (cl-case system-type
- (darwin "open")
- (cygwin "cygstart")
- (t "xdg-open"))
- (shell-quote-argument x))
- nil 0)))
-
-(defalias 'counsel-find-file-extern #'counsel-locate-action-extern)
-
-(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."
- (counsel-require-program "locate")
- (format "locate -i --regex '%s'"
- (counsel--elisp-to-pcre
- (ivy--regex input))))
-
-(defun counsel-locate-cmd-noregex (input)
- "Return a shell command based on INPUT."
- (counsel-require-program "locate")
- (format "locate -i '%s'" input))
-
-(defun counsel-locate-cmd-mdfind (input)
- "Return a shell command based on INPUT."
- (counsel-require-program "mdfind")
- (format "mdfind -name '%s'" input))
-
-(defvar w32-ansi-code-page)
-
-(defun counsel-locate-cmd-es (input)
- "Return a shell command based on INPUT."
- (counsel-require-program "es.exe")
- (let ((raw-string (format "es.exe -i -r -p %s"
- (counsel--elisp-to-pcre
- (ivy--regex input t)))))
- ;; W32 don't use Unicode by default, so we encode search command
- ;; to local codepage to support searching filename contains non-ASCII
- ;; characters.
- (if (and (eq system-type 'windows-nt)
- (boundp 'w32-ansi-code-page))
- (encode-coding-string raw-string
- (intern (format "cp%d" w32-ansi-code-page)))
- raw-string)))
-
-(defun counsel-locate-function (input)
- "Call the \"locate\" shell command with INPUT."
- (or
- (ivy-more-chars)
- (progn
- (counsel--async-command
- (funcall counsel-locate-cmd input))
- '("" "working..."))))
-
-(defcustom counsel-locate-db-path "~/.local/mlocate.db"
- "Location where to put the locatedb in case your home folder is encrypted."
- :type 'file)
-
-(defun counsel-file-stale-p (fname seconds)
- "Return non-nil if FNAME was modified more than SECONDS ago."
- (> (time-to-seconds
- (time-subtract
- (current-time)
- (nth 5 (file-attributes fname))))
- seconds))
-
-(defun counsel--locate-updatedb ()
- (when (file-exists-p "~/.Private")
- (let ((db-fname (expand-file-name counsel-locate-db-path)))
- (setenv "LOCATE_PATH" db-fname)
- (when (or (not (file-exists-p db-fname))
- (counsel-file-stale-p db-fname 60))
- (message "Updating %s..." db-fname)
- (counsel--command
- "updatedb" "-l" "0" "-o" db-fname "-U" (expand-file-name "~"))))))
-
-;;;###autoload
-(defun counsel-locate (&optional initial-input)
- "Call the \"locate\" shell command.
-INITIAL-INPUT can be given as the initial minibuffer input."
- (interactive)
- (counsel--locate-updatedb)
- (ivy-read "Locate: " #'counsel-locate-function
- :initial-input initial-input
- :dynamic-collection t
- :history 'counsel-locate-history
- :action (lambda (file)
- (when file
- (with-ivy-window
- (find-file
- (concat (file-remote-p default-directory) file)))))
- :caller 'counsel-locate))
-
-(ivy-configure 'counsel-locate
- :unwind-fn #'counsel-delete-process
- :exit-codes '(1 "Nothing found"))
-
-;;** `counsel-fzf'
-(defvar counsel-fzf-cmd "fzf -f \"%s\""
- "Command for `counsel-fzf'.")
-
-(defvar counsel--fzf-dir nil
- "Store the base fzf directory.")
-
-(defvar counsel-fzf-dir-function 'counsel-fzf-dir-function-projectile
- "Function that returns a directory for fzf to use.")
-
-(defun counsel-fzf-dir-function-projectile ()
- (if (and
- (fboundp 'projectile-project-p)
- (fboundp 'projectile-project-root)
- (projectile-project-p))
- (projectile-project-root)
- default-directory))
-
-(defun counsel-fzf-function (str)
- (let ((default-directory counsel--fzf-dir))
- (setq ivy--old-re (ivy--regex-fuzzy str))
- (counsel--async-command
- (format counsel-fzf-cmd str)))
- nil)
-
-;;;###autoload
-(defun counsel-fzf (&optional initial-input initial-directory fzf-prompt)
- "Open a file using the fzf shell command.
-INITIAL-INPUT can be given as the initial minibuffer input.
-INITIAL-DIRECTORY, if non-nil, is used as the root directory for search.
-FZF-PROMPT, if non-nil, is passed as `ivy-read' prompt argument."
- (interactive
- (let ((fzf-basename (car (split-string counsel-fzf-cmd))))
- (list nil
- (when current-prefix-arg
- (counsel-read-directory-name (concat
- fzf-basename
- " in directory: "))))))
- (counsel-require-program counsel-fzf-cmd)
- (setq counsel--fzf-dir
- (or initial-directory
- (funcall counsel-fzf-dir-function)))
- (ivy-read (or fzf-prompt "fzf: ")
- #'counsel-fzf-function
- :initial-input initial-input
- :re-builder #'ivy--regex-fuzzy
- :dynamic-collection t
- :action #'counsel-fzf-action
- :caller 'counsel-fzf))
-
-(ivy-configure 'counsel-fzf
- :occur #'counsel-fzf-occur
- :unwind-fn #'counsel-delete-process
- :exit-codes '(1 "Nothing found"))
-
-(defun counsel-fzf-action (x)
- "Find file X in current fzf directory."
- (with-ivy-window
- (let ((default-directory counsel--fzf-dir))
- (find-file x))))
-
-(defun counsel-fzf-occur (&optional _cands)
- "Occur function for `counsel-fzf' using `counsel-cmd-to-dired'."
- (cd counsel--fzf-dir)
- (counsel-cmd-to-dired
- (counsel--expand-ls
- (format
- "%s --print0 | xargs -0 ls"
- (format counsel-fzf-cmd ivy-text)))))
-
-(ivy-set-actions
- 'counsel-fzf
- '(("x" counsel-locate-action-extern "xdg-open")
- ("d" counsel-locate-action-dired "dired")))
-
-;;** `counsel-dpkg'
-;;;###autoload
-(defun counsel-dpkg ()
- "Call the \"dpkg\" shell command."
- (interactive)
- (counsel-require-program "dpkg")
- (let ((cands (mapcar
- (lambda (x)
- (let ((y (split-string x " +")))
- (cons (format "%-40s %s"
- (ivy--truncate-string
- (nth 1 y) 40)
- (nth 4 y))
- (mapconcat #'identity y " "))))
- (split-string
- (shell-command-to-string "dpkg -l | tail -n+6") "\n" t))))
- (ivy-read "dpkg: " cands
- :action (lambda (x)
- (message (cdr x)))
- :caller 'counsel-dpkg)))
-
-;;** `counsel-rpm'
-;;;###autoload
-(defun counsel-rpm ()
- "Call the \"rpm\" shell command."
- (interactive)
- (counsel-require-program "rpm")
- (let ((cands (mapcar
- (lambda (x)
- (let ((y (split-string x "|")))
- (cons (format "%-40s %s"
- (ivy--truncate-string
- (nth 0 y) 40)
- (nth 1 y))
- (mapconcat #'identity y " "))))
- (split-string
- (shell-command-to-string "rpm -qa --qf
\"%{NAME}|%{SUMMARY}\\n\"") "\n" t))))
- (ivy-read "rpm: " cands
- :action (lambda (x)
- (message (cdr x)))
- :caller 'counsel-rpm)))
-
-(defun counsel--find-return-list (args)
- (unless (listp args)
- (user-error "`counsel-file-jump-args' is a list now, please customize
accordingly."))
- (counsel--call
- (cons find-program args)
- (lambda ()
- (let (files)
- (goto-char (point-min))
- (while (< (point) (point-max))
- (when (looking-at "\\./")
- (goto-char (match-end 0)))
- (push (buffer-substring (point) (line-end-position)) files)
- (beginning-of-line 2))
- (nreverse files)))))
-
-(defcustom counsel-file-jump-args (split-string ". -name .git -prune -o -type
f -print")
- "Arguments for the `find-command' when using `counsel-file-jump'."
- :type '(repeat string))
-
-;;** `counsel-file-jump'
-;;;###autoload
-(defun counsel-file-jump (&optional initial-input initial-directory)
- "Jump to a file below the current directory.
-List all files within the current directory or any of its sub-directories.
-INITIAL-INPUT can be given as the initial minibuffer input.
-INITIAL-DIRECTORY, if non-nil, is used as the root directory for search."
- (interactive
- (list nil
- (when current-prefix-arg
- (counsel-read-directory-name "From directory: "))))
- (counsel-require-program find-program)
- (let ((default-directory (or initial-directory default-directory)))
- (ivy-read "Find file: "
- (counsel--find-return-list counsel-file-jump-args)
- :matcher #'counsel--find-file-matcher
- :initial-input initial-input
- :action #'find-file
- :preselect (counsel--preselect-file)
- :require-match 'confirm-after-completion
- :history 'file-name-history
- :keymap counsel-find-file-map
- :caller 'counsel-file-jump)))
-
-(ivy-set-actions
- 'counsel-file-jump
- `(("d" ,(lambda (x)
- (dired (or (file-name-directory x) default-directory)))
- "open in dired")))
-
-(defcustom counsel-dired-jump-args (split-string ". -name .git -prune -o -type
d -print")
- "Arguments for the `find-command' when using `counsel-dired-jump'."
- :type '(repeat string))
-
-;;** `counsel-dired-jump'
-;;;###autoload
-(defun counsel-dired-jump (&optional initial-input initial-directory)
- "Jump to a directory (see `dired-jump') below the current directory.
-List all sub-directories within the current directory.
-INITIAL-INPUT can be given as the initial minibuffer input.
-INITIAL-DIRECTORY, if non-nil, is used as the root directory for search."
- (interactive
- (list nil
- (when current-prefix-arg
- (counsel-read-directory-name "From directory: "))))
- (counsel-require-program find-program)
- (let ((default-directory (or initial-directory default-directory)))
- (ivy-read "Find directory: "
- (cdr
- (counsel--find-return-list counsel-dired-jump-args))
- :matcher #'counsel--find-file-matcher
- :initial-input initial-input
- :action (lambda (d) (dired-jump nil (expand-file-name d)))
- :history 'file-name-history
- :keymap counsel-find-file-map
- :caller 'counsel-dired-jump)))
-
-;;* Grep
-(defun counsel--grep-mode-occur (git-grep-dir-is-file)
- "Generate a custom occur buffer for grep like commands.
-If GIT-GREP-DIR-IS-FILE is t, then `ivy-state-directory' is treated as a full
-path to a file rather than a directory (e.g. for `counsel-grep-occur').
-
-This function expects that the candidates have already been filtered.
-It applies no filtering to ivy--all-candidates."
- (unless (eq major-mode 'ivy-occur-grep-mode)
- (ivy-occur-grep-mode))
- (let ((directory
- (if git-grep-dir-is-file
- (file-name-directory (ivy-state-directory ivy-last))
- (ivy-state-directory ivy-last))))
- (setq default-directory directory)
- ;; 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 ivy--all-candidates)))
- (ivy--occur-insert-lines
- (mapcar #'counsel--normalize-grep-match ivy--all-candidates))))
-
-;;** `counsel-ag'
-(defvar counsel-ag-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-l") 'ivy-call-and-recenter)
- (define-key map (kbd "M-q") 'counsel-git-grep-query-replace)
- (define-key map (kbd "C-'") 'swiper-avy)
- (define-key map (kbd "C-x C-d") 'counsel-cd)
- map))
-
-(defcustom counsel-ag-base-command
- (if (memq system-type '(ms-dos windows-nt))
- "ag --vimgrep %s"
- "ag --nocolor --nogroup %s")
- "Format string to use in `counsel-ag-function' to construct the command.
-The %s will be replaced by optional extra ag arguments followed by the
-regex string."
- :type 'string)
-
-(defvar counsel-ag-command nil)
-
-(defvar counsel--grep-tool-look-around t)
-
-(defvar counsel--regex-look-around nil)
-
-(defconst counsel--command-args-separator "-- ")
-
-(defun counsel--split-command-args (arguments)
- "Split ARGUMENTS into its switches and search-term parts.
-Return pair of corresponding strings (SWITCHES . SEARCH-TERM)."
- (let ((switches "")
- (search-term arguments))
- (when (string-prefix-p "-" arguments)
- (let ((index (string-match counsel--command-args-separator arguments)))
- (when index
- (setq search-term
- (substring arguments (+ (length
counsel--command-args-separator) index)))
- (setq switches (substring arguments 0 index)))))
- (cons switches search-term)))
-
-(defun counsel--format-ag-command (extra-args needle)
- "Construct a complete `counsel-ag-command' as a string.
-EXTRA-ARGS is a string of the additional arguments.
-NEEDLE is the search string."
- (format counsel-ag-command
- (if (string-match " \\(--\\) " extra-args)
- (replace-match needle t t extra-args 1)
- (concat extra-args " " needle))))
-
-(defun counsel--grep-regex (str)
- (counsel--elisp-to-pcre
- (setq ivy--old-re
- (funcall ivy--regex-function str))
- counsel--regex-look-around))
-
-(defun counsel--ag-extra-switches (regex)
- "Get additional switches needed for look-arounds."
- (and (stringp counsel--regex-look-around)
- ;; using look-arounds
- (string-match-p "\\`\\^(\\?[=!]" regex)
- (concat " " counsel--regex-look-around " ")))
-
-(defun counsel-ag-function (string)
- "Grep in the current directory for STRING."
- (let* ((command-args (counsel--split-command-args string))
- (search-term (cdr command-args)))
- (or
- (let ((ivy-text search-term))
- (ivy-more-chars))
- (let* ((default-directory (ivy-state-directory ivy-last))
- (regex (counsel--grep-regex search-term))
- (switches (concat (car command-args)
- (counsel--ag-extra-switches regex)
- (and (ivy--case-fold-p string) " -i "))))
- (counsel--async-command (counsel--format-ag-command
- switches
- (shell-quote-argument regex)))
- nil))))
-
-;;;###autoload
-(cl-defun counsel-ag (&optional initial-input initial-directory extra-ag-args
ag-prompt
- &key caller)
- "Grep for a string in the current directory using ag.
-INITIAL-INPUT can be given as the initial minibuffer input.
-INITIAL-DIRECTORY, if non-nil, is used as the root directory for search.
-EXTRA-AG-ARGS string, if non-nil, is appended to `counsel-ag-base-command'.
-AG-PROMPT, if non-nil, is passed as `ivy-read' prompt argument.
-CALLER is passed to `ivy-read'."
- (interactive)
- (setq counsel-ag-command counsel-ag-base-command)
- (setq counsel--regex-look-around counsel--grep-tool-look-around)
- (counsel-require-program counsel-ag-command)
- (when current-prefix-arg
- (setq initial-directory
- (or initial-directory
- (counsel-read-directory-name (concat
- (car (split-string
counsel-ag-command))
- " in directory: "))))
- (setq extra-ag-args
- (or extra-ag-args
- (read-from-minibuffer (format
- "%s args: "
- (car (split-string
counsel-ag-command)))))))
- (setq counsel-ag-command (counsel--format-ag-command (or extra-ag-args "")
"%s"))
- (let ((default-directory (or initial-directory
- (counsel--git-root)
- default-directory)))
- (ivy-read (or ag-prompt
- (concat (car (split-string counsel-ag-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
- :caller (or caller 'counsel-ag))))
-
-(ivy-configure 'counsel-ag
- :occur #'counsel-ag-occur
- :unwind-fn #'counsel--grep-unwind
- :display-transformer-fn #'counsel-git-grep-transformer
- :grep-p t
- :exit-codes '(1 "No matches found"))
-
-(defun counsel-read-directory-name (prompt)
- "Read a directory name from user, a (partial) replacement of
`read-directory-name'."
- (let ((counsel--find-file-predicate #'file-directory-p))
- (ivy-read prompt
- #'read-file-name-internal
- :matcher #'counsel--find-file-matcher
- :history 'file-name-history
- :keymap counsel-find-file-map
- :caller 'counsel-read-directory-name)))
-
-(ivy-configure 'counsel-read-directory-name
- :display-transformer-fn #'ivy-read-file-transformer)
-
-(defun counsel-cd ()
- "Change the directory for the currently running Ivy grep-like command.
-Works for `counsel-git-grep', `counsel-ag', etc."
- (interactive)
- (let ((input ivy-text)
- (new-dir (counsel-read-directory-name "cd: ")))
- (ivy-quit-and-run
- (funcall (ivy-state-caller ivy-last) input new-dir))))
-
-(defun counsel-grep-like-occur (cmd-template)
- (unless (eq major-mode 'ivy-occur-grep-mode)
- (ivy-occur-grep-mode)
- (setq default-directory (ivy-state-directory ivy-last)))
- (setq ivy-text
- (and (string-match "\"\\(.*\\)\"" (buffer-name))
- (match-string 1 (buffer-name))))
- (let* ((cmd
- (if (functionp cmd-template)
- (funcall cmd-template ivy-text)
- (let* ((command-args (counsel--split-command-args ivy-text))
- (regex (counsel--grep-regex (cdr command-args)))
- (switches (concat (car command-args)
- (counsel--ag-extra-switches regex))))
- (format cmd-template
- (concat
- switches
- (shell-quote-argument regex))))))
- (cands (counsel--split-string (shell-command-to-string cmd))))
- (swiper--occur-insert-lines (mapcar #'counsel--normalize-grep-match
cands))))
-
-(defun counsel-ag-occur (&optional _cands)
- "Generate a custom occur buffer for `counsel-ag'."
- (counsel-grep-like-occur
- counsel-ag-command))
-
-;;** `counsel-pt'
-(defcustom counsel-pt-base-command "pt --nocolor --nogroup -e %s"
- "Alternative to `counsel-ag-base-command' using pt."
- :type 'string)
-
-;;;###autoload
-(defun counsel-pt (&optional initial-input)
- "Grep for a string in the current directory using pt.
-INITIAL-INPUT can be given as the initial minibuffer input.
-This uses `counsel-ag' with `counsel-pt-base-command' instead of
-`counsel-ag-base-command'."
- (interactive)
- (let ((counsel-ag-base-command counsel-pt-base-command)
- (counsel--grep-tool-look-around nil))
- (counsel-ag initial-input :caller 'counsel-pt)))
-
-(ivy-configure 'counsel-pt
- :unwind-fn #'counsel--grep-unwind
- :display-transformer-fn #'counsel-git-grep-transformer
- :grep-p t)
-
-;;** `counsel-ack'
-(defcustom counsel-ack-base-command
- (concat
- (file-name-nondirectory
- (or (executable-find "ack-grep") "ack"))
- " --nocolor --nogroup %s")
- "Alternative to `counsel-ag-base-command' using ack."
- :type 'string)
-
-;;;###autoload
-(defun counsel-ack (&optional initial-input)
- "Grep for a string in the current directory using ack.
-INITIAL-INPUT can be given as the initial minibuffer input.
-This uses `counsel-ag' with `counsel-ack-base-command' replacing
-`counsel-ag-base-command'."
- (interactive)
- (let ((counsel-ag-base-command counsel-ack-base-command)
- (counsel--grep-tool-look-around t))
- (counsel-ag initial-input :caller 'counsel-ack)))
-
-
-;;** `counsel-rg'
-(defcustom counsel-rg-base-command
- (if (memq system-type '(ms-dos windows-nt))
- "rg --with-filename --no-heading --line-number --path-separator /
--color never %s ."
- "rg --with-filename --no-heading --line-number --color never %s")
- "Alternative to `counsel-ag-base-command' using ripgrep.
-
-Note: don't use single quotes for the regex."
- :type 'string)
-
-(defun counsel--rg-targets ()
- "Return a list of files to operate on, based on `dired-mode' marks."
- (if (eq major-mode 'dired-mode)
- (let ((files
- (dired-get-marked-files 'no-dir nil nil t)))
- (if (and (null (cdr files))
- (not (when (string-match-p "\\*ivy-occur" (buffer-name))
- (dired-toggle-marks)
- (setq files (dired-get-marked-files 'no-dir))
- (dired-toggle-marks)
- t)))
- ""
- (concat
- " "
- (mapconcat #'shell-quote-argument (delq t files) " "))))
- ""))
-
-;;;###autoload
-(defun counsel-rg (&optional initial-input initial-directory extra-rg-args
rg-prompt)
- "Grep for a string in the current directory using rg.
-INITIAL-INPUT can be given as the initial minibuffer input.
-INITIAL-DIRECTORY, if non-nil, is used as the root directory for search.
-EXTRA-RG-ARGS string, if non-nil, is appended to `counsel-rg-base-command'.
-RG-PROMPT, if non-nil, is passed as `ivy-read' prompt argument.
-
-Example input with inclusion and exclusion file patterns:
- -g*.py -g!*test* -- ..."
- (interactive)
- (let ((counsel-ag-base-command
- (concat counsel-rg-base-command (counsel--rg-targets)))
- (counsel--grep-tool-look-around
- (let ((rg (car (split-string counsel-rg-base-command)))
- (switch "--pcre2"))
- (and (eq 0 (call-process rg nil nil nil switch "--version"))
- switch))))
- (counsel-ag initial-input initial-directory extra-rg-args rg-prompt
- :caller 'counsel-rg)))
-
-(ivy-configure 'counsel-rg
- :occur #'counsel-ag-occur
- :unwind-fn #'counsel--grep-unwind
- :display-transformer-fn #'counsel-git-grep-transformer
- :grep-p t
- :exit-codes '(1 "No matches found"))
-
-;;** `counsel-grep'
-(defvar counsel-grep-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-l") 'ivy-call-and-recenter)
- (define-key map (kbd "M-q") 'swiper-query-replace)
- (define-key map (kbd "C-'") 'swiper-avy)
- map))
-
-(defcustom counsel-grep-base-command "grep -E -n -e %s %s"
- "Format string used by `counsel-grep' to build a shell command.
-It should contain two %-sequences (see function `format') to be
-substituted by the search regexp and file, respectively. Neither
-%-sequence should be contained in single quotes."
- :type 'string)
-
-(defvar counsel-grep-command nil)
-
-(defun counsel-grep-function (string)
- "Grep in the current directory for STRING."
- (or
- (ivy-more-chars)
- (let ((regex (counsel--elisp-to-pcre
- (setq ivy--old-re
- (ivy--regex string)))))
- (counsel--async-command
- (format counsel-grep-command (shell-quote-argument regex)))
- nil)))
-
-(defvar counsel--grep-last-pos nil
- "Store the last point and line that `counsel-grep-action' scrolled to.
-This speeds up scrolling: instead of going to `point-min' and
-`forward-line' with a huge arg (e.g. to scroll 50K lines), scroll
-relative to the last position stored here.")
-
-(defun counsel-grep-action (x)
- "Go to candidate X."
- (with-ivy-window
- (swiper--cleanup)
- (let ((default-directory
- (file-name-directory
- (ivy-state-directory ivy-last)))
- file-name line-number)
- (when (cond ((string-match "\\`\\([0-9]+\\):\\(.*\\)\\'" x)
- (setq file-name (buffer-file-name (ivy-state-buffer
ivy-last)))
- (setq line-number (match-string-no-properties 1 x)))
- ((string-match "\\`\\([^:]+\\):\\([0-9]+\\):\\(.*\\)\\'" x)
- (setq file-name (match-string-no-properties 1 x))
- (setq line-number (match-string-no-properties 2 x))))
- ;; If the file buffer is already open, just get it. Prevent doing
- ;; `find-file', as that file could have already been opened using
- ;; `find-file-literally'.
- (with-current-buffer (or (get-file-buffer file-name)
- (find-file file-name))
- (setq line-number (string-to-number line-number))
- (if (and counsel--grep-last-pos (= (point) (car
counsel--grep-last-pos)))
- (forward-line (- line-number (cdr counsel--grep-last-pos)))
- (goto-char (point-min))
- (forward-line (1- line-number)))
- (setq counsel--grep-last-pos (cons (point) line-number))
- (when (re-search-forward (ivy--regex ivy-text t) (line-end-position)
t)
- (when swiper-goto-start-of-match
- (goto-char (match-beginning 0))))
- (run-hooks 'counsel-grep-post-action-hook)
- (if (eq ivy-exit 'done)
- (swiper--ensure-visible)
- (isearch-range-invisible (line-beginning-position)
- (line-end-position))
- (swiper--add-overlays (ivy--regex ivy-text))))))))
-
-(defun counsel-grep-occur (&optional _cands)
- "Generate a custom occur buffer for `counsel-grep'."
- (counsel-grep-like-occur
- (format
- "grep -niE %%s %s /dev/null"
- (shell-quote-argument
- (file-name-nondirectory
- (buffer-file-name
- (ivy-state-buffer ivy-last)))))))
-
-(defvar counsel-grep-history nil
- "History for `counsel-grep'.")
-
-;;;###autoload
-(defun counsel-grep (&optional initial-input)
- "Grep for a string in the file visited by the current buffer.
-When non-nil, INITIAL-INPUT is the initial search pattern."
- (interactive)
- (unless buffer-file-name
- (user-error "Current buffer is not visiting a file"))
- (counsel-require-program counsel-grep-base-command)
- (setq counsel-grep-command
- (format counsel-grep-base-command
- "%s" (shell-quote-argument
- (file-name-nondirectory
- buffer-file-name))))
- (let ((default-directory (file-name-directory buffer-file-name))
- (init-point (point))
- res)
- (unwind-protect
- (setq res (ivy-read "grep: " #'counsel-grep-function
- :initial-input initial-input
- :dynamic-collection t
- :require-match t
- :preselect
- (when (< (- (line-end-position)
(line-beginning-position)) 300)
- (format "%d:%s"
- (line-number-at-pos)
- (regexp-quote
- (buffer-substring-no-properties
- (line-beginning-position)
- (line-end-position)))))
- :keymap counsel-grep-map
- :history 'counsel-grep-history
- :re-builder #'ivy--regex
- :action #'counsel-grep-action
- :caller 'counsel-grep))
- (unless res
- (goto-char init-point)))))
-
-(ivy-configure 'counsel-grep
- :update-fn 'auto
- :unwind-fn #'counsel--grep-unwind
- :index-fn #'ivy-recompute-index-swiper-async
- :occur #'counsel-grep-occur
- :more-chars 2
- :grep-p t
- :exit-codes '(1 ""))
-
-;;;###autoload
-(defun counsel-grep-backward (&optional initial-input)
- "Grep for a string in the file visited by the current buffer going
-backward similar to `swiper-backward'. When non-nil, INITIAL-INPUT is
-the initial search pattern."
- (interactive)
- (let ((ivy-index-functions-alist
- '((counsel-grep . ivy-recompute-index-swiper-async-backward))))
- (counsel-grep initial-input)))
-
-;;** `counsel-grep-or-swiper'
-(defcustom counsel-grep-swiper-limit 300000
- "Buffer size threshold for `counsel-grep-or-swiper'.
-When the number of characters in a buffer exceeds this threshold,
-`counsel-grep' will be used instead of `swiper'."
- :type 'integer)
-
-(defcustom counsel-grep-use-swiper-p #'counsel-grep-use-swiper-p-default
- "When this function returns non-nil, call `swiper', else `counsel-grep'."
- :type '(choice
- (const :tag "Rely on `counsel-grep-swiper-limit'."
- counsel-grep-use-swiper-p-default)
- (const :tag "Always use `counsel-grep'." ignore)
- (function :tag "Custom")))
-
-(defun counsel-grep-use-swiper-p-default ()
- (<= (buffer-size)
- (/ counsel-grep-swiper-limit
- (if (eq major-mode 'org-mode) 4 1))))
-
-;;;###autoload
-(defun counsel-grep-or-swiper (&optional initial-input)
- "Call `swiper' for small buffers and `counsel-grep' for large ones.
-When non-nil, INITIAL-INPUT is the initial search pattern."
- (interactive)
- (if (or (not buffer-file-name)
- (buffer-narrowed-p)
- (ignore-errors
- (file-remote-p buffer-file-name))
- (jka-compr-get-compression-info buffer-file-name)
- (funcall counsel-grep-use-swiper-p))
- (swiper initial-input)
- (when (file-writable-p buffer-file-name)
- (save-buffer))
- (counsel-grep initial-input)))
-
-;;** `counsel-grep-or-swiper-backward'
-;;;###autoload
-(defun counsel-grep-or-swiper-backward (&optional initial-input)
- "Call `swiper-backward' for small buffers and `counsel-grep-backward' for
-large ones. When non-nil, INITIAL-INPUT is the initial search pattern."
- (interactive)
- (let ((ivy-index-functions-alist
- '((swiper . ivy-recompute-index-swiper-backward)
- (counsel-grep . ivy-recompute-index-swiper-async-backward))))
- (counsel-grep-or-swiper initial-input)))
-
-;;** `counsel-recoll'
-(defun counsel-recoll-function (str)
- "Run recoll for STR."
- (or
- (ivy-more-chars)
- (progn
- (counsel--async-command
- (format "recoll -t -b %s"
- (shell-quote-argument str)))
- nil)))
-
-;; This command uses the recollq command line tool that comes together
-;; with the recoll (the document indexing database) source:
-;; https://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.
-;;;###autoload
-(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)
- (counsel-require-program "recoll")
- (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)))))
- :caller 'counsel-recoll))
-
-(ivy-configure 'counsel-recoll
- :unwind-fn #'counsel-delete-process)
-
-;;* Org
-;;** `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-get-tags "org")
-(declare-function org-make-tag-string "org")
-(declare-function org-move-to-column "org-compat")
-
-(defun counsel--org-make-tag-string ()
- (if (fboundp #'org-make-tag-string)
- ;; >= Org 9.2
- (org-make-tag-string (counsel--org-get-tags))
- (with-no-warnings
- (org-get-tags-string))))
-
-(defun counsel-org-change-tags (tags)
- "Change tags of current org headline to TAGS."
- (let ((current (counsel--org-make-tag-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]*$")
- (line-end-position) 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 ()
- "Set tags of current org headline to `counsel-org-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)
- "Add tag X to `counsel-org-tags'.
-If X is already part of the list, remove it instead. Quit the selection if
-X is selected by either `ivy-done', `ivy-alt-done' or `ivy-immediate-done',
-otherwise continue prompting for tags."
- (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 (counsel--org-get-tags) add-tags)))
- (counsel-org--set-tags))))))
- (counsel-org--set-tags)))
- ((eq this-command 'ivy-call)
- (with-selected-window (active-minibuffer-window)
- (delete-minibuffer-contents)))))
-
-(defun counsel-org-tag-prompt ()
- "Return prompt for `counsel-org-tag'."
- (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")
-(declare-function org-tags-completion-function "org")
-
-;;;###autoload
-(defun counsel--org-get-tags ()
- (delete "" (condition-case nil
- (org-get-tags nil t)
- (error (org-get-tags)))))
-
-;;;###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 (counsel--org-get-tags)))))
- (unless (org-at-heading-p)
- (org-back-to-heading t))
- (setq counsel-org-tags (counsel--org-get-tags)))
- (let ((org-last-tags-completion-table
- (append (and (or org-complete-tags-always-offer-all-agenda-tags
- (eq major-mode 'org-agenda-mode))
- (org-global-tags-completion-table
- (org-agenda-files)))
- (unless (boundp 'org-current-tag-alist)
- org-tag-persistent-alist)
- (or (if (boundp 'org-current-tag-alist)
- org-current-tag-alist
- org-tag-alist)
- (org-get-buffer-tags)))))
- (ivy-read (counsel-org-tag-prompt)
- (lambda (str _pred _action)
- (delete-dups
- (all-completions str #'org-tags-completion-function)))
- :history 'org-tags-history
- :action #'counsel-org-tag-action
- :caller 'counsel-org-tag))))
-
-(defvar org-version)
-
-;;;###autoload
-(defun counsel-org-tag-agenda ()
- "Set tags for the current agenda item."
- (interactive)
- (cl-letf (((symbol-function (if (version< org-version "9.2")
- 'org-set-tags
- 'org-set-tags-command))
- #'counsel-org-tag))
- (org-agenda-set-tags)))
-
-(defcustom counsel-org-headline-display-tags nil
- "If non-nil, display tags in matched `org-mode' headlines."
- :type 'boolean)
-
-(defcustom counsel-org-headline-display-todo nil
- "If non-nil, display todo keywords in matched `org-mode' headlines."
- :type 'boolean)
-
-(defcustom counsel-org-headline-display-priority nil
- "If non-nil, display priorities in matched `org-mode' headlines."
- :type 'boolean)
-
-(declare-function org-get-heading "org")
-(declare-function org-goto-marker-or-bmk "org")
-(declare-function outline-next-heading "outline")
-
-;;;###autoload
-(defalias 'counsel-org-goto #'counsel-outline)
-
-(defcustom counsel-org-goto-all-outline-path-prefix nil
- "Prefix for outline candidates in `counsel-org-goto-all'."
- :type '(choice
- (const :tag "None" nil)
- (const :tag "File name" file-name)
- (const :tag "File name (nondirectory part)" file-name-nondirectory)
- (const :tag "Buffer name" buffer-name)))
-
-(defun counsel-org-goto-all--outline-path-prefix ()
- (cl-case counsel-org-goto-all-outline-path-prefix
- (file-name buffer-file-name)
- (file-name-nondirectory (file-name-nondirectory buffer-file-name))
- (buffer-name (buffer-name))))
-
-(defvar counsel-outline-settings
- '((emacs-lisp-mode
- :outline-regexp ";;[;*]+[\s\t]+"
- :outline-level counsel-outline-level-emacs-lisp)
- (org-mode
- :outline-title counsel-outline-title-org
- :action counsel-org-goto-action
- :history counsel-org-goto-history
- :caller counsel-org-goto)
- ;; markdown-mode package
- (markdown-mode
- :outline-title counsel-outline-title-markdown)
- ;; Built-in mode or AUCTeX package
- (latex-mode
- :outline-title counsel-outline-title-latex))
- "Alist mapping major modes to their `counsel-outline' settings.
-
-Each entry is a pair (MAJOR-MODE . PLIST). `counsel-outline'
-checks whether an entry exists for the current buffer's
-MAJOR-MODE and, if so, loads the settings specified by PLIST
-instead of the default settings. The following settings are
-recognized:
-
-- `:outline-regexp' is a regexp to match the beginning of an
- outline heading. It is only checked at the start of a line and
- so need not start with \"^\".
- Defaults to the value of the variable `outline-regexp'.
-
-- `:outline-level' is a function of no arguments which computes
- the level of an outline heading. It is called with point at
- the beginning of `outline-regexp' and with the match data
- corresponding to `outline-regexp'.
- Defaults to the value of the variable `outline-level'.
-
-- `:outline-title' is a function of no arguments which returns
- the title of an outline heading. It is called with point at
- the end of `outline-regexp' and with the match data
- corresponding to `outline-regexp'.
- Defaults to the function `counsel-outline-title'.
-
-- `:action' is a function of one argument, the selected outline
- heading to jump to. This setting corresponds directly to its
- eponymous `ivy-read' keyword, as used by `counsel-outline', so
- the type of the function's argument depends on the value
- returned by `counsel-outline-candidates'.
- Defaults to the function `counsel-outline-action'.
-
-- `:history' is a history list, usually a symbol representing a
- history list variable. It corresponds directly to its
- eponymous `ivy-read' keyword, as used by `counsel-outline'.
- Defaults to the symbol `counsel-outline-history'.
-
-- `:caller' is a symbol to uniquely identify the caller to
- `ivy-read'. It corresponds directly to its eponymous
- `ivy-read' keyword, as used by `counsel-outline'.
- Defaults to the symbol `counsel-outline'.
-
-- `:display-style' overrides the variable
- `counsel-outline-display-style'.
-
-- `:path-separator' overrides the variable
- `counsel-outline-path-separator'.
-
-- `:face-style' overrides the variable
- `counsel-outline-face-style'.
-
-- `:custom-faces' overrides the variable
- `counsel-outline-custom-faces'.")
-
-;;;###autoload
-(defun counsel-org-goto-all ()
- "Go to a different location in any org file."
- (interactive)
- (let (entries)
- (dolist (b (buffer-list))
- (with-current-buffer b
- (when (derived-mode-p 'org-mode)
- (setq entries
- (nconc entries
- (counsel-outline-candidates
- (cdr (assq 'org-mode counsel-outline-settings))
- (counsel-org-goto-all--outline-path-prefix)))))))
- (ivy-read "Goto: " entries
- :history 'counsel-org-goto-history
- :action #'counsel-org-goto-action
- :caller 'counsel-org-goto-all)))
-
-(defun counsel-org-goto-action (x)
- "Go to headline in candidate X."
- (org-goto-marker-or-bmk (cdr x)))
-
-(defun counsel--org-get-heading-args ()
- "Return list of arguments for `org-get-heading'.
-Try to return the right number of arguments for the current Org
-version. Argument values are based on the
-`counsel-org-headline-display-*' user options."
- (nbutlast (mapcar #'not (list counsel-org-headline-display-tags
- counsel-org-headline-display-todo
- counsel-org-headline-display-priority))
- (if (if (fboundp 'func-arity)
- (< (cdr (func-arity #'org-get-heading)) 3)
- (version< org-version "9.1.1"))
- 1 0)))
-
-;;** `counsel-org-file'
-(declare-function org-attach-dir "org-attach")
-(declare-function org-attach-file-list "org-attach")
-(defvar org-attach-directory)
-
-(defun counsel-org-files ()
- "Return list of all files under current Org attachment directories.
-Filenames returned are relative to `default-directory'. For each
-attachment directory associated with the current buffer, all
-contained files are listed, so the return value could conceivably
-include attachments of other Org buffers."
- (require 'org-attach)
- (let (dirs)
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward "^:\\(ATTACH_DIR\\|ID\\):[\t ]+\\(.*\\)$" nil
t)
- (let ((dir (org-attach-dir)))
- (when dir
- (push dir dirs)))))
- (cl-mapcan
- (lambda (dir)
- (mapcar (lambda (file)
- (file-relative-name (expand-file-name file dir)))
- (org-attach-file-list dir)))
- (nreverse dirs))))
-
-;;;###autoload
-(defun counsel-org-file ()
- "Browse all attachments for current Org file."
- (interactive)
- (ivy-read "file: " (counsel-org-files)
- :action #'counsel-locate-action-dired
- :caller 'counsel-org-file))
-
-;;** `counsel-org-entity'
-(defvar org-entities)
-(defvar org-entities-user)
-
-;;;###autoload
-(defun counsel-org-entity ()
- "Complete Org entities using Ivy."
- (interactive)
- (require 'org)
- (ivy-read "Entity: " (cl-loop for element in (append org-entities
org-entities-user)
- unless (stringp element)
- collect (cons
- (format "%20s | %20s | %20s | %s"
- (cl-first element) ; name
- (cl-second element) ; latex
- (cl-fourth element) ; html
- (cl-seventh element)) ; utf-8
- element))
- :require-match t
- :action '(1
- ("u" (lambda (candidate)
- (insert (cl-seventh (cdr candidate)))) "utf-8")
- ("o" (lambda (candidate)
- (insert "\\" (cl-first (cdr candidate))))
"org-entity")
- ("l" (lambda (candidate)
- (insert (cl-second (cdr candidate)))) "latex")
- ("h" (lambda (candidate)
- (insert (cl-fourth (cdr candidate)))) "html")
- ("a" (lambda (candidate)
- (insert (cl-fifth (cdr candidate)))) "ascii")
- ("L" (lambda (candidate)
- (insert (cl-sixth (cdr candidate))) "Latin-1")))))
-
-;;** `counsel-org-capture'
-(defvar org-capture-templates)
-(defvar org-capture-templates-contexts)
-(declare-function org-contextualize-keys "org")
-(declare-function org-capture-goto-last-stored "org-capture")
-(declare-function org-capture-goto-target "org-capture")
-(declare-function org-capture-upgrade-templates "org-capture")
-
-;;;###autoload
-(defun counsel-org-capture ()
- "Capture something."
- (interactive)
- (require 'org-capture)
- (ivy-read "Capture template: "
- (delq nil
- (mapcar
- (lambda (x)
- (when (> (length x) 2)
- (format "%-5s %s" (nth 0 x) (nth 1 x))))
- ;; We build the list of capture templates as in
- ;; `org-capture-select-template':
- (or (org-contextualize-keys
- (org-capture-upgrade-templates org-capture-templates)
- org-capture-templates-contexts)
- '(("t" "Task" entry (file+headline "" "Tasks")
- "* TODO %?\n %u\n %a")))))
- :require-match t
- :action (lambda (x)
- (org-capture nil (car (split-string x))))
- :caller 'counsel-org-capture))
-
-(ivy-configure 'counsel-org-capture
- :initial-input "^")
-
-(ivy-set-actions
- 'counsel-org-capture
- `(("t" ,(lambda (x)
- (org-capture-goto-target (car (split-string x))))
- "go to target")
- ("l" ,(lambda (_x)
- (org-capture-goto-last-stored))
- "go to last stored")
- ("p" ,(lambda (x)
- (org-capture 0 (car (split-string x))))
- "insert template at point")
- ("c" ,(lambda (_x)
- (customize-variable 'org-capture-templates))
- "customize org-capture-templates")))
-
-;;** `counsel-org-agenda-headlines'
-(defvar org-odd-levels-only)
-(declare-function org-set-startup-visibility "org")
-(declare-function org-show-entry "org")
-(declare-function org-map-entries "org")
-(declare-function org-heading-components "org")
-
-(defun counsel-org-agenda-headlines-action-goto (headline)
- "Go to the `org-mode' agenda HEADLINE."
- (find-file (nth 1 headline))
- (org-set-startup-visibility)
- (goto-char (nth 2 headline))
- (org-show-entry))
-
-(ivy-set-actions
- 'counsel-org-agenda-headlines
- '(("g" counsel-org-agenda-headlines-action-goto "goto headline")))
-
-(defvar counsel-org-agenda-headlines-history nil
- "History for `counsel-org-agenda-headlines'.")
-
-(defcustom counsel-outline-display-style 'path
- "The style used when displaying matched outline headings.
-
-If `headline', the title is displayed with leading stars
-indicating the outline level.
-
-If `path', the path hierarchy is displayed. For each entry the
-title is shown. Entries are separated with
-`counsel-outline-path-separator'.
-
-If `title' or any other value, only the title of the heading is
-displayed.
-
-For displaying tags and TODO keywords in `org-mode' buffers, see
-`counsel-org-headline-display-tags' and
-`counsel-org-headline-display-todo', respectively."
- :type '(choice
- (const :tag "Title only" title)
- (const :tag "Headline" headline)
- (const :tag "Path" path)))
-
-(defcustom counsel-outline-path-separator "/"
- "String separating path entries in matched outline headings.
-This variable has no effect unless
-`counsel-outline-display-style' is set to `path'."
- :type 'string)
-
-(declare-function org-get-outline-path "org")
-
-(defun counsel-org-agenda-headlines--candidates ()
- "Return a list of completion candidates for `counsel-org-agenda-headlines'."
- (org-map-entries
- (lambda ()
- (let* ((components (org-heading-components))
- (level (and (eq counsel-outline-display-style 'headline)
- (make-string
- (if org-odd-levels-only
- (nth 1 components)
- (nth 0 components))
- ?*)))
- (todo (and counsel-org-headline-display-todo
- (nth 2 components)))
- (path (and (eq counsel-outline-display-style 'path)
- (org-get-outline-path)))
- (priority (and counsel-org-headline-display-priority
- (nth 3 components)))
- (text (nth 4 components))
- (tags (and counsel-org-headline-display-tags
- (nth 5 components))))
- (list
- (mapconcat
- 'identity
- (cl-remove-if 'null
- (list
- level
- todo
- (and priority (format "[#%c]" priority))
- (mapconcat 'identity
- (append path (list text))
- counsel-outline-path-separator)
- tags))
- " ")
- buffer-file-name
- (point))))
- nil
- 'agenda))
-
-;;;###autoload
-(defun counsel-org-agenda-headlines ()
- "Choose from headers of `org-mode' files in the agenda."
- (interactive)
- (require 'org)
- (let ((minibuffer-allow-text-properties t))
- (ivy-read "Org headline: "
- (counsel-org-agenda-headlines--candidates)
- :action #'counsel-org-agenda-headlines-action-goto
- :history 'counsel-org-agenda-headlines-history
- :caller 'counsel-org-agenda-headlines)))
-
-;;* Misc. Emacs
-;;** `counsel-mark-ring'
-(defface counsel--mark-ring-highlight
- '((t (:inherit highlight)))
- "Face for current `counsel-mark-ring' line."
- :group 'ivy-faces)
-
-(defvar counsel--mark-ring-overlay nil
- "Internal overlay to highlight line by candidate of `counsel-mark-ring'.")
-
-(defun counsel--mark-ring-add-highlight ()
- "Add highlight to current line."
- (setq counsel--mark-ring-overlay
- (make-overlay (line-beginning-position) (1+ (line-end-position))))
- (with-ivy-window
- (overlay-put counsel--mark-ring-overlay 'face
- 'counsel--mark-ring-highlight)))
-
-(defun counsel--mark-ring-delete-highlight ()
- "If `counsel-mark-ring' have highlight, delete highlight."
- (if counsel--mark-ring-overlay (delete-overlay counsel--mark-ring-overlay)))
-
-(defvar counsel--mark-ring-calling-point 0
- "Internal variable to remember calling position.")
-
-(defun counsel--mark-ring-unwind ()
- "Return back to calling position of `counsel-mark-ring'."
- (goto-char counsel--mark-ring-calling-point)
- (counsel--mark-ring-delete-highlight))
-
-(defun counsel--mark-ring-update-fn ()
- "Show preview by candidate."
- (let ((pos (get-text-property 0 'point (ivy-state-current ivy-last))))
- (counsel--mark-ring-delete-highlight)
- (with-ivy-window
- (goto-char pos)
- (counsel--mark-ring-add-highlight))))
-
-;;;###autoload
-(defun counsel-mark-ring ()
- "Browse `mark-ring' interactively.
-Obeys `widen-automatically', which see."
- (interactive)
- (let* ((counsel--mark-ring-calling-point (point))
- (width (length (number-to-string (line-number-at-pos (point-max)))))
- (fmt (format "%%%dd %%s" width))
- (make-candidate
- (lambda (mark)
- (goto-char (marker-position mark))
- (let ((linum (line-number-at-pos))
- (line (buffer-substring
- (line-beginning-position) (line-end-position))))
- (propertize (format fmt linum line) 'point (point)))))
- (marks (copy-sequence mark-ring))
- (marks (delete-dups marks))
- (marks
- ;; mark-marker is empty?
- (if (equal (mark-marker) (make-marker))
- marks
- (cons (copy-marker (mark-marker)) marks)))
- (cands
- ;; Widen, both to save `line-number-at-pos' the trouble
- ;; and for `buffer-substring' to work.
- (save-excursion
- (save-restriction
- (widen)
- (mapcar make-candidate marks)))))
- (if cands
- (ivy-read "Mark: " cands
- :require-match t
- :action (lambda (cand)
- (let ((pos (get-text-property 0 'point cand)))
- (when pos
- (unless (<= (point-min) pos (point-max))
- (if widen-automatically
- (widen)
- (error "\
-Position of selected mark outside accessible part of buffer")))
- (goto-char pos))))
- :caller 'counsel-mark-ring)
- (message "Mark ring is empty"))))
-
-(ivy-configure 'counsel-mark-ring
- :update-fn #'counsel--mark-ring-update-fn
- :unwind-fn #'counsel--mark-ring-unwind
- :sort-fn #'ivy-string<)
-
-;;** `counsel-package'
-(defvar package--initialized)
-(defvar package-alist)
-(defvar package-archive-contents)
-(defvar package-archives)
-(defvar package-user-dir)
-(declare-function package-installed-p "package")
-(declare-function package-delete "package")
-(declare-function package-desc-extras "package")
-
-(defvar counsel-package-history nil
- "History for `counsel-package'.")
-
-(defun counsel--package-candidates ()
- "Return completion alist for `counsel-package'."
- (unless package--initialized
- (package-initialize t))
- (if (or (not package-archive-contents)
- (cl-find-if (lambda (package-archive)
- (let ((fname
- (format
- "%s/archives/%s/archive-contents"
- package-user-dir (car package-archive))))
- (or (not (file-exists-p fname))
- (counsel-file-stale-p fname (* 4 60 60)))))
- package-archives))
- (package-refresh-contents))
- (sort (mapcar (lambda (entry)
- (cons (let ((pkg (car entry)))
- (concat (if (package-installed-p pkg) "-" "+")
- (symbol-name pkg)))
- entry))
- package-archive-contents)
- #'counsel--package-sort))
-
-;;;###autoload
-(defun counsel-package ()
- "Install or delete packages.
-
-Packages not currently installed are prefixed with \"+\", and
-selecting one of these will try to install it.
-Packages currently installed are prefixed with \"-\", and
-selecting one of these will try to delete it.
-
-Additional actions:\\<ivy-minibuffer-map>
-
- \\[ivy-dispatching-done] d: Describe package
- \\[ivy-dispatching-done] h: Visit package's homepage"
- (interactive)
- (require 'package)
- (ivy-read "Packages (install +pkg or delete -pkg): "
- (counsel--package-candidates)
- :action #'counsel-package-action
- :require-match t
- :history 'counsel-package-history
- :caller 'counsel-package))
-
-(cl-pushnew '(counsel-package . "^+") ivy-initial-inputs-alist :key #'car)
-
-(defun counsel-package-action (package)
- "Delete or install PACKAGE."
- (setq package (cadr package))
- (if (package-installed-p package)
- (package-delete (cadr (assq package package-alist)))
- (package-install package)))
-
-(defun counsel-package-action-describe (package)
- "Call `describe-package' on PACKAGE."
- (describe-package (cadr package)))
-
-(defun counsel-package-action-homepage (package)
- "Open homepage for PACKAGE in a WWW browser."
- (let ((url (cdr (assq :url (package-desc-extras (nth 2 package))))))
- (if url
- (browse-url url)
- (message "No homepage specified for package `%s'" (nth 1 package)))))
-
-(defun counsel--package-sort (a b)
- "Sort function for `counsel-package' candidates."
- (let* ((a (car a))
- (b (car b))
- (a-inst (= (string-to-char a) ?+))
- (b-inst (= (string-to-char b) ?+)))
- (or (and a-inst (not b-inst))
- (and (eq a-inst b-inst) (string-lessp a b)))))
-
-(ivy-set-actions
- 'counsel-package
- '(("d" counsel-package-action-describe "describe package")
- ("h" counsel-package-action-homepage "open package homepage")))
-
-;;** `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))
- (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 menu bar."
- (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'
-(defcustom counsel-yank-pop-truncate-radius 2
- "Number of context lines around `counsel-yank-pop' candidates."
- :type 'integer)
-
-(defun counsel--yank-pop-truncate (str)
- "Truncate STR for use in `counsel-yank-pop'."
- (condition-case nil
- (let* ((lines (split-string str "\n" t))
- (n (length lines))
- (re (ivy-re-to-str ivy--old-re))
- (first-match (cl-position-if
- (lambda (s) (string-match 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)))
-
-(defcustom counsel-yank-pop-separator "\n"
- "Separator for the kill ring strings in `counsel-yank-pop'."
- :type '(choice
- (const :tag "Plain" "\n")
- (const :tag "Dashes" "\n----\n")
- string))
-
-(defun counsel--yank-pop-format-function (cand-pairs)
- "Transform CAND-PAIRS into a string for `counsel-yank-pop'."
- (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
- (propertize counsel-yank-pop-separator 'face 'ivy-separator)))
-
-(defun counsel--yank-pop-position (s)
- "Return position of S in `kill-ring' relative to last yank."
- (or (cl-position s kill-ring-yank-pointer :test #'equal-including-properties)
- (cl-position s kill-ring-yank-pointer :test #'equal)
- (+ (or (cl-position s kill-ring :test #'equal-including-properties)
- (cl-position s kill-ring :test #'equal))
- (- (length kill-ring-yank-pointer)
- (length kill-ring)))))
-
-(defun counsel-string-non-blank-p (s)
- "Return non-nil if S includes non-blank characters.
-Newlines and carriage returns are considered blank."
- (not (string-match-p "\\`[\n\r[:blank:]]*\\'" s)))
-
-(defcustom counsel-yank-pop-filter #'counsel-string-non-blank-p
- "Unary filter function applied to `counsel-yank-pop' candidates.
-All elements of `kill-ring' for which this function returns nil
-will be destructively removed from `kill-ring' before completion.
-All blank strings are deleted from `kill-ring' by default."
- :type '(radio
- (function-item counsel-string-non-blank-p)
- (function-item identity)
- (function :tag "Other")))
-
-(defun counsel--yank-pop-kills ()
- "Return filtered `kill-ring' for `counsel-yank-pop' completion.
-Both `kill-ring' and `kill-ring-yank-pointer' may be
-destructively modified to eliminate duplicates under
-`equal-including-properties', satisfy `counsel-yank-pop-filter',
-and incorporate `interprogram-paste-function'."
- ;; Protect against `kill-ring' and result of
- ;; `interprogram-paste-function' both being nil
- (ignore-errors (current-kill 0))
- ;; Keep things consistent with the rest of Emacs
- (dolist (sym '(kill-ring kill-ring-yank-pointer))
- (set sym (cl-delete-duplicates
- (cl-delete-if-not counsel-yank-pop-filter (symbol-value sym))
- :test #'equal-including-properties :from-end t)))
- kill-ring)
-
-(defcustom counsel-yank-pop-after-point nil
- "Whether `counsel-yank-pop' yanks after point.
-Nil means `counsel-yank-pop' puts point at the end of the yanked
-text and mark at its beginning, as per the default \\[yank].
-Non-nil means `counsel-yank-pop' swaps the resulting point and
-mark, as per \\[universal-argument] \\[yank]."
- :type 'boolean)
-
-(defun counsel-yank-pop-action (s)
- "Like `yank-pop', but insert the kill corresponding to S.
-Signal a `buffer-read-only' error if called from a read-only
-buffer position."
- (with-ivy-window
- (barf-if-buffer-read-only)
- (setq last-command 'yank)
- (setq yank-window-start (window-start))
- (condition-case nil
- ;; Avoid unexpected additions to `kill-ring'
- (let (interprogram-paste-function)
- (yank-pop (counsel--yank-pop-position s)))
- (error
- (insert s)))
- (when (funcall (if counsel-yank-pop-after-point #'> #'<)
- (point) (mark t))
- (exchange-point-and-mark t))))
-
-(defun counsel-yank-pop-action-remove (s)
- "Remove all occurrences of S from the kill ring."
- (dolist (sym '(kill-ring kill-ring-yank-pointer))
- (set sym (cl-delete s (symbol-value sym)
- :test #'equal-including-properties)))
- ;; Update collection and preselect for next `ivy-call'
- (setf (ivy-state-collection ivy-last) kill-ring)
- (setf (ivy-state-preselect ivy-last)
- (nth (min ivy--index (1- (length kill-ring)))
- kill-ring))
- (ivy--reset-state ivy-last))
-
-(defun counsel-yank-pop-action-rotate (s)
- "Rotate the yanking point to S in the kill ring.
-See `current-kill' for how this interacts with the window system
-selection."
- (let ((i (counsel--yank-pop-position s)))
- ;; Avoid unexpected additions to `kill-ring'
- (let (interprogram-paste-function)
- (setf (ivy-state-preselect ivy-last) (current-kill i)))
- ;; Manually change window system selection because `current-kill' won't
- (when (and (zerop i)
- yank-pop-change-selection
- interprogram-cut-function)
- (funcall interprogram-cut-function (car kill-ring-yank-pointer))))
- (ivy--reset-state ivy-last))
-
-(defcustom counsel-yank-pop-preselect-last nil
- "Whether `counsel-yank-pop' preselects the last kill by default.
-
-The command `counsel-yank-pop' always preselects the same kill
-that `yank-pop' would have inserted, given the same prefix
-argument.
-
-When `counsel-yank-pop-preselect-last' is nil (the default), the
-prefix argument of `counsel-yank-pop' defaults to 1 (as per
-`yank-pop'), which causes the next-to-last kill to be
-preselected. Otherwise, the prefix argument defaults to 0, which
-results in the most recent kill being preselected."
- :type 'boolean)
-
-(autoload 'xor "array")
-
-;;;###autoload
-(defun counsel-yank-pop (&optional arg)
- "Ivy replacement for `yank-pop'.
-With a plain prefix argument (\\[universal-argument]),
-temporarily toggle the value of `counsel-yank-pop-after-point'.
-Any other value of ARG has the same meaning as in `yank-pop', but
-`counsel-yank-pop-preselect-last' determines its default value.
-See also `counsel-yank-pop-filter' for how to filter candidates.
-
-Note: Duplicate elements of `kill-ring' are always deleted."
- ;; Do not specify `*' to allow browsing `kill-ring' in read-only buffers
- (interactive "P")
- (let ((kills (or (counsel--yank-pop-kills)
- (error "Kill ring is empty or blank")))
- (preselect (let (interprogram-paste-function)
- (current-kill (cond ((nlistp arg)
- (prefix-numeric-value arg))
- (counsel-yank-pop-preselect-last 0)
- (t 1))
- t)))
- (counsel-yank-pop-after-point
- (xor (consp arg) counsel-yank-pop-after-point)))
- (unless (eq last-command 'yank)
- (push-mark))
- (ivy-read "kill-ring: " kills
- :require-match t
- :preselect preselect
- :action #'counsel-yank-pop-action
- :caller 'counsel-yank-pop)))
-
-(ivy-configure 'counsel-yank-pop
- :height 5
- :format-fn #'counsel--yank-pop-format-function)
-
-(ivy-set-actions
- 'counsel-yank-pop
- '(("d" counsel-yank-pop-action-remove "delete")
- ("r" counsel-yank-pop-action-rotate "rotate")))
-
-;;** `counsel-register'
-(defvar counsel-register-actions
- '(("\\`buffer position" . jump-to-register)
- ("\\`text" . insert-register)
- ("\\`rectangle" . insert-register)
- ("\\`window configuration" . jump-to-register)
- ("\\`frame configuration" . jump-to-register)
- ("\\`[-+]?[0-9]+\\(?:\\.[0-9]\\)?\\'" . insert-register)
- ("\\`the file" . jump-to-register)
- ("\\`keyboard macro" . jump-to-register)
- ("\\`file-query" . jump-to-register))
- "Alist of (REGEXP . FUNCTION) pairs for `counsel-register'.
-Selecting a register whose description matches REGEXP specifies
-FUNCTION as the action to take on the register.")
-
-(defvar counsel-register-history nil
- "History for `counsel-register'.")
-
-(defun counsel-register-action (register)
- "Default action for `counsel-register'.
-
-Call a function on REGISTER. The function is determined by
-matching the register's value description against a regexp in
-`counsel-register-actions'."
- (let* ((val (get-text-property 0 'register register))
- (desc (register-describe-oneline val))
- (action (cdr (cl-assoc-if (lambda (re) (string-match-p re desc))
- counsel-register-actions))))
- (if action
- (funcall action val)
- (error "No action was found for register %s"
- (single-key-description val)))))
-
-;;;###autoload
-(defun counsel-register ()
- "Interactively choose a register."
- (interactive)
- (ivy-read "Register: "
- (cl-mapcan
- (lambda (reg)
- (let ((s (funcall register-preview-function reg)))
- (setq s (substring s 0 (string-match-p "[ \t\n\r]+\\'" s)))
- (unless (string= s "")
- (put-text-property 0 1 'register (car reg) s)
- (list s))))
- register-alist)
- :require-match t
- :history 'counsel-register-history
- :action #'counsel-register-action
- :caller 'counsel-register))
-
-(ivy-configure 'counsel-register
- :sort-fn #'ivy-string<)
-
-;;** `counsel-evil-registers'
-;;;###autoload
-(defun counsel-evil-registers ()
- "Ivy replacement for `evil-show-registers'."
- (interactive)
- (if (fboundp 'evil-register-list)
- (ivy-read "evil-registers: "
- (cl-loop for (key . val) in (evil-register-list)
- collect (format "[%c]: %s" key (if (stringp val) val "")))
- :require-match t
- :action #'counsel-evil-registers-action
- :caller 'counsel-evil-registers)
- (user-error "Required feature `evil' not installed.")))
-(ivy-configure 'counsel-evil-registers
- :height 5
- :format-fn #'counsel--yank-pop-format-function)
-
-(defun counsel-evil-registers-action (s)
- "Paste contents of S, trimming the register part.
-
-S will be of the form \"[register]: content\"."
- (with-ivy-window
- (insert
- (replace-regexp-in-string "\\`\\[.*?\\]: " "" s))))
-
-;;** `counsel-imenu'
-(defvar imenu-auto-rescan)
-(defvar imenu-auto-rescan-maxout)
-(declare-function imenu--subalist-p "imenu")
-(declare-function imenu--make-index-alist "imenu")
-
-(defun counsel--imenu-candidates ()
- (unless (featurep 'imenu)
- (require 'imenu nil t))
- (let* ((imenu-auto-rescan t)
- (imenu-auto-rescan-maxout (if current-prefix-arg
- (buffer-size)
- imenu-auto-rescan-maxout))
- (items (imenu--make-index-alist t))
- (items (delete (assoc "*Rescan*" items) items))
- (items (counsel-imenu-categorize-functions items)))
- (counsel-imenu-get-candidates-from items)))
-
-(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
- (when prefix
- (concat
- (propertize prefix 'face 'ivy-grep-info)
- ": "))
- (car elm))))
- (list (cons key
- (cons key (if (overlayp (cdr elm))
- (overlay-start (cdr elm))
- (cdr elm))))))))
- alist))
-
-(defvar counsel-imenu-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-l") 'ivy-call-and-recenter)
- map))
-
-(defun counsel-imenu-categorize-functions (items)
- "Categorize all the functions of imenu."
- (let ((fns (cl-remove-if #'listp items :key #'cdr)))
- (if fns
- (nconc (cl-remove-if #'nlistp items :key #'cdr)
- `(("Functions" ,@fns)))
- items)))
-
-(defun counsel-imenu-action (x)
- (with-ivy-window
- (imenu (cdr x))))
-
-;;;###autoload
-(defun counsel-imenu ()
- "Jump to a buffer position indexed by imenu."
- (interactive)
- (ivy-read "imenu items: " (counsel--imenu-candidates)
- :preselect (thing-at-point 'symbol)
- :require-match t
- :action #'counsel-imenu-action
- :keymap counsel-imenu-map
- :caller 'counsel-imenu))
-
-;;** `counsel-list-processes'
-(defun counsel-list-processes-action-delete (x)
- "Delete process 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)
- "Switch to buffer of process 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)
- (with-temp-buffer
- (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 (lambda (x) (funcall action (cdr x)))
- :require-match t
- :caller 'counsel-ace-link))))
-
-;;** `counsel-minibuffer-history'
-;;;###autoload
-(defun counsel-minibuffer-history ()
- "Browse minibuffer history."
- (interactive)
- (let ((enable-recursive-minibuffers t))
- (ivy-read "History: " (ivy-history-contents minibuffer-history-variable)
- :keymap ivy-reverse-i-search-map
- :action #'insert
- :caller 'counsel-minibuffer-history)))
-
-;;** `counsel-esh-history'
-(defun counsel--browse-history (ring)
- "Use Ivy to navigate through RING."
- (setq ivy-completion-beg (point))
- (setq ivy-completion-end (point))
- (ivy-read "History: " (ivy-history-contents ring)
- :keymap ivy-reverse-i-search-map
- :action #'ivy-completion-in-region-action
- :caller 'counsel-shell-history))
-
-(defvar eshell-history-ring)
-
-;;;###autoload
-(defun counsel-esh-history ()
- "Browse Eshell history."
- (interactive)
- (require 'em-hist)
- (counsel--browse-history eshell-history-ring))
-
-(defvar comint-input-ring)
-
-;;;###autoload
-(defun counsel-shell-history ()
- "Browse shell history."
- (interactive)
- (require 'comint)
- (counsel--browse-history comint-input-ring))
-
-(defvar slime-repl-input-history)
-
-;;;###autoload
-(defun counsel-slime-repl-history ()
- "Browse Slime REPL history."
- (interactive)
- (require 'slime-repl)
- (counsel--browse-history slime-repl-input-history))
-
-;;** `counsel-hydra-heads'
-(defvar hydra-curr-body-fn)
-(declare-function hydra-keyboard-quit "ext:hydra")
-
-;;;###autoload
-(defun counsel-hydra-heads ()
- "Call a head of the current/last hydra."
- (interactive)
- (let* ((base (substring
- (prin1-to-string hydra-curr-body-fn)
- 0 -4))
- (heads (eval (intern (concat base "heads"))))
- (keymap (eval (intern (concat base "keymap"))))
- (head-names
- (mapcar (lambda (x)
- (cons
- (if (nth 2 x)
- (format "[%s] %S (%s)" (nth 0 x) (nth 1 x) (nth 2 x))
- (format "[%s] %S" (nth 0 x) (nth 1 x)))
- (lookup-key keymap (kbd (nth 0 x)))))
- heads)))
- (ivy-read "head: " head-names
- :action (lambda (x) (call-interactively (cdr x))))
- (hydra-keyboard-quit)))
-;;** `counsel-semantic'
-(declare-function semantic-tag-start "semantic/tag")
-(declare-function semantic-tag-class "semantic/tag")
-(declare-function semantic-tag-name "semantic/tag")
-(declare-function semantic-tag-put-attribute "semantic/tag")
-(declare-function semantic-tag-get-attribute "semantic/tag")
-(declare-function semantic-fetch-tags "semantic")
-(declare-function semantic-format-tag-summarize "semantic/format")
-(declare-function semantic-active-p "semantic/fw")
-
-(defun counsel-semantic-action (x)
- "Got to semantic TAG."
- (goto-char (semantic-tag-start (cdr x))))
-
-(defvar counsel-semantic-history nil
- "History for `counsel-semantic'.")
-
-(defun counsel-semantic-format-tag (tag)
- "Return a pretty string representation of TAG."
- (let ((depth (or (semantic-tag-get-attribute tag :depth) 0))
- (parent (semantic-tag-get-attribute tag :parent)))
- (concat (make-string (* depth 2) ?\ )
- (if parent
- (concat "(" parent ") ")
- "")
- (semantic-format-tag-summarize tag nil t))))
-
-(defun counsel-flatten-forest (func treep forest)
- "Use FUNC and TREEP to flatten FOREST.
-FUNC is applied to each node.
-TREEP is used to expand internal nodes."
- (cl-labels ((reducer (forest out depth)
- (dolist (tree forest)
- (let ((this (cons (funcall func tree depth) out))
- (leafs (funcall treep tree)))
- (setq out
- (if leafs
- (reducer leafs this (1+ depth))
- this))))
- out))
- (nreverse (reducer forest nil 0))))
-
-(defun counsel-semantic-tags ()
- "Fetch semantic tags."
- (counsel-flatten-forest
- (lambda (tree depth)
- (semantic-tag-put-attribute tree :depth depth))
- (lambda (tag)
- (when (eq (semantic-tag-class tag) 'type)
- (let ((name (semantic-tag-name tag)))
- (mapcar
- (lambda (x) (semantic-tag-put-attribute x :parent name))
- (semantic-tag-get-attribute tag :members)))))
- (semantic-fetch-tags)))
-
-;;;###autoload
-(defun counsel-semantic ()
- "Jump to a semantic tag in the current buffer."
- (interactive)
- (let ((tags (mapcar
- (lambda (x)
- (cons
- (counsel-semantic-format-tag x)
- x))
- (counsel-semantic-tags))))
- (ivy-read "tag: " tags
- :action #'counsel-semantic-action
- :history 'counsel-semantic-history
- :caller 'counsel-semantic)))
-
-;;;###autoload
-(defun counsel-semantic-or-imenu ()
- (interactive)
- (require 'semantic/fw)
- (if (semantic-active-p)
- (counsel-semantic)
- (counsel-imenu)))
-
-;;** `counsel-outline'
-(defcustom counsel-outline-face-style nil
- "Determines how to style outline headings during completion.
-
-If `org', the faces `counsel-outline-1' through
-`counsel-outline-8' are applied in a similar way to Org.
-Note that no cycling is performed, so headings on levels 9 and
-higher are not styled.
-
-If `verbatim', the faces used in the buffer are applied. For
-simple headlines in `org-mode' buffers, this is usually the same
-as the `org' setting, except that it depends on how much of the
-buffer has been completely fontified. If your buffer exceeds a
-certain size, headlines are styled lazily depending on which
-parts of the tree are visible. Headlines which are not yet
-styled in the buffer will appear unstyled in the minibuffer as
-well. If your headlines contain parts which are fontified
-differently than the headline itself (e.g. TODO keywords, tags,
-links) and you want these parts to be styled properly, verbatim
-is the way to go; otherwise you are probably better off using the
-`org' setting instead.
-
-If `custom', the faces defined in `counsel-outline-custom-faces'
-are applied. Note that no cycling is performed, so if there is
-no face defined for a certain level, headlines on that level will
-not be styled.
-
-If `nil', all headlines are highlighted using
-`counsel-outline-default'.
-
-For displaying tags and TODO keywords in `org-mode' buffers, see
-`counsel-org-headline-display-tags' and
-`counsel-org-headline-display-todo', respectively."
- :type '(choice
- (const :tag "Same as org-mode" org)
- (const :tag "Verbatim" verbatim)
- (const :tag "Custom" custom)
- (const :tag "No style" nil)))
-
-(defcustom counsel-outline-custom-faces nil
- "List of faces for custom display of outline headings.
-
-Headlines on level N are fontified with the Nth entry of this
-list, starting with N = 1. Headline levels with no corresponding
-entry in this list will not be styled.
-
-This variable has no effect unless `counsel-outline-face-style'
-is set to `custom'."
- :type '(repeat face))
-
-(defun counsel-outline-title ()
- "Return title of current outline heading.
-Intended as a value for the `:outline-title' setting in
-`counsel-outline-settings', which see."
- (buffer-substring (point) (line-end-position)))
-
-(defun counsel-outline-title-org ()
- "Return title of current outline heading.
-Like `counsel-outline-title' (which see), but for `org-mode'
-buffers."
- (apply #'org-get-heading (counsel--org-get-heading-args)))
-
-(defun counsel-outline-title-markdown ()
- "Return title of current outline heading.
-Like `counsel-outline-title' (which see), but for
-`markdown-mode' (from the eponymous package) buffers."
- ;; `outline-regexp' is set by `markdown-mode' to match both setext
- ;; (underline) and atx (hash) headings (see
- ;; `markdown-regex-header').
- (or (match-string 1) ; setext heading title
- (match-string 5))) ; atx heading title
-
-(defun counsel-outline-title-latex ()
- "Return title of current outline heading.
-Like `counsel-outline-title' (which see), but for `latex-mode'
-buffers."
- ;; `outline-regexp' is set by `latex-mode' (see variable
- ;; `latex-section-alist' for the built-in mode or function
- ;; `LaTeX-outline-regexp' for the AUCTeX package) to match section
- ;; macros, in which case we get the section name, as well as
- ;; `\appendix', `\documentclass', `\begin{document}', and
- ;; `\end{document}', in which case we simply return that.
- (if (and (assoc (match-string 1) ; Macro name
- (or (bound-and-true-p LaTeX-section-list) ; AUCTeX
- (bound-and-true-p latex-section-alist))) ; Built-in
- (progn
- ;; Point is at end of macro name, skip stars and optional args
- (skip-chars-forward "*")
- (while (looking-at-p "\\[")
- (forward-list))
- ;; First mandatory arg should be section title
- (looking-at-p "{")))
- (buffer-substring (1+ (point)) (1- (progn (forward-list) (point))))
- (buffer-substring (line-beginning-position) (point))))
-
-(defun counsel-outline-level-emacs-lisp ()
- "Return level of current outline heading.
-Like `lisp-outline-level', but adapted for the `:outline-level'
-setting in `counsel-outline-settings', which see."
- (if (looking-at ";;\\([;*]+\\)")
- (- (match-end 1) (match-beginning 1))
- (funcall outline-level)))
-
-(defvar counsel-outline--preselect 0
- "Index of the preselected candidate in `counsel-outline'.")
-
-(defun counsel-outline-candidates (&optional settings prefix)
- "Return an alist of outline heading completion candidates.
-Each element is a pair (HEADING . MARKER), where the string
-HEADING is located at the position of MARKER. SETTINGS is a
-plist entry from `counsel-outline-settings', which see.
-PREFIX is a string prepended to all candidates."
- (let* ((bol-regex (concat "^\\(?:"
- (or (plist-get settings :outline-regexp)
- outline-regexp)
- "\\)"))
- (outline-title-fn (or (plist-get settings :outline-title)
- #'counsel-outline-title))
- (outline-level-fn (or (plist-get settings :outline-level)
- outline-level))
- (display-style (or (plist-get settings :display-style)
- counsel-outline-display-style))
- (path-separator (or (plist-get settings :path-separator)
- counsel-outline-path-separator))
- (face-style (or (plist-get settings :face-style)
- counsel-outline-face-style))
- (custom-faces (or (plist-get settings :custom-faces)
- counsel-outline-custom-faces))
- (stack-level 0)
- (orig-point (point))
- (stack (and prefix (list (counsel-outline--add-face
- prefix 0 face-style custom-faces))))
- cands name level marker)
- (save-excursion
- (setq counsel-outline--preselect 0)
- (goto-char (point-min))
- (while (re-search-forward bol-regex nil t)
- (save-excursion
- (setq name (or (save-match-data
- (funcall outline-title-fn))
- ""))
- (goto-char (match-beginning 0))
- (setq marker (point-marker))
- (setq level (funcall outline-level-fn))
- (cond ((eq display-style 'path)
- ;; Update stack. The empty entry guards against incorrect
- ;; headline hierarchies, e.g. a level 3 headline
- ;; immediately following a level 1 entry.
- (while (<= level stack-level)
- (pop stack)
- (cl-decf stack-level))
- (while (> level stack-level)
- (push "" stack)
- (cl-incf stack-level))
- (setf (car stack)
- (counsel-outline--add-face
- name level face-style custom-faces))
- (setq name (mapconcat #'identity
- (reverse stack)
- path-separator)))
- (t
- (when (eq display-style 'headline)
- (setq name (concat (make-string level ?*) " " name)))
- (setq name (counsel-outline--add-face
- name level face-style custom-faces))))
- (push (cons name marker) cands))
- (unless (or (string= name "")
- (< orig-point marker))
- (cl-incf counsel-outline--preselect))))
- (nreverse cands)))
-
-(defun counsel-outline--add-face (name level &optional face-style custom-faces)
- "Set the `face' property on headline NAME according to LEVEL.
-FACE-STYLE and CUSTOM-FACES override `counsel-outline-face-style'
-and `counsel-outline-custom-faces', respectively, which determine
-the face to apply."
- (let ((face (cl-case (or face-style counsel-outline-face-style)
- (verbatim)
- (custom (nth (1- level)
- (or custom-faces counsel-outline-custom-faces)))
- (org (format "counsel-outline-%d" level))
- (t 'counsel-outline-default))))
- (when face
- (put-text-property 0 (length name) 'face face name)))
- name)
-
-(defun counsel-outline-action (x)
- "Go to outline X."
- (goto-char (cdr x)))
-
-;;;###autoload
-(defun counsel-outline ()
- "Jump to an outline heading with completion."
- (interactive)
- (let ((settings (cdr (assq major-mode counsel-outline-settings))))
- (ivy-read "Outline: " (counsel-outline-candidates settings)
- :action (or (plist-get settings :action)
- #'counsel-outline-action)
- :history (or (plist-get settings :history)
- 'counsel-outline-history)
- :preselect (max (1- counsel-outline--preselect) 0)
- :caller (or (plist-get settings :caller)
- 'counsel-outline))))
-
-;;** `counsel-ibuffer'
-(defvar counsel-ibuffer--buffer-name nil
- "Name of the buffer to use for `counsel-ibuffer'.")
-
-;;;###autoload
-(defun counsel-ibuffer (&optional name)
- "Use ibuffer to switch to another buffer.
-NAME specifies the name of the buffer (defaults to \"*Ibuffer*\")."
- (interactive)
- (setq counsel-ibuffer--buffer-name (or name "*Ibuffer*"))
- (ivy-read "Switch to buffer: " (counsel-ibuffer--get-buffers)
- :history 'counsel-ibuffer-history
- :action #'counsel-ibuffer-visit-buffer
- :caller 'counsel-ibuffer))
-
-(declare-function ibuffer-update "ibuffer")
-(declare-function ibuffer-current-buffer "ibuffer")
-(declare-function ibuffer-forward-line "ibuffer")
-(defvar ibuffer-movement-cycle)
-
-(defun counsel-ibuffer--get-buffers ()
- "Return list of buffer-related lines in Ibuffer as strings."
- (let ((oldbuf (get-buffer counsel-ibuffer--buffer-name)))
- (unless oldbuf
- ;; Avoid messing with the user's precious window/frame configuration.
- (save-window-excursion
- (let ((display-buffer-overriding-action
- '(display-buffer-same-window (inhibit-same-window . nil))))
- (ibuffer nil counsel-ibuffer--buffer-name nil t))))
- (with-current-buffer counsel-ibuffer--buffer-name
- (when oldbuf
- ;; Forcibly update possibly stale existing buffer.
- (ibuffer-update nil t))
- (goto-char (point-min))
- (let ((ibuffer-movement-cycle nil)
- entries)
- (while (not (eobp))
- (ibuffer-forward-line 1 t)
- (let ((buf (ibuffer-current-buffer)))
- ;; We are only interested in buffers we can actually visit.
- ;; This filters out headings and other unusable entries.
- (when (buffer-live-p buf)
- (push (cons (buffer-substring-no-properties
- (line-beginning-position)
- (line-end-position))
- buf)
- entries))))
- (nreverse entries)))))
-
-(defun counsel-ibuffer-visit-buffer (x)
- "Switch to buffer of candidate X."
- (switch-to-buffer (cdr x)))
-
-(defun counsel-ibuffer-visit-buffer-other-window (x)
- "Switch to buffer of candidate X in another window."
- (switch-to-buffer-other-window (cdr x)))
-
-(defun counsel-ibuffer-visit-ibuffer (_)
- "Switch to Ibuffer buffer."
- (switch-to-buffer counsel-ibuffer--buffer-name))
-
-(ivy-set-actions
- 'counsel-ibuffer
- '(("j" counsel-ibuffer-visit-buffer-other-window "other window")
- ("v" counsel-ibuffer-visit-ibuffer "switch to Ibuffer")))
-
-;;** `counsel-switch-to-shell-buffer'
-(defun counsel--buffers-with-mode (mode)
- "Return names of buffers with MODE as their `major-mode'."
- (let (bufs)
- (dolist (buf (buffer-list))
- (when (eq (buffer-local-value 'major-mode buf) mode)
- (push (buffer-name buf) bufs)))
- (nreverse bufs)))
-
-(declare-function shell-mode "shell")
-
-;;;###autoload
-(defun counsel-switch-to-shell-buffer ()
- "Switch to a shell buffer, or create one."
- (interactive)
- (ivy-read "Shell buffer: " (counsel--buffers-with-mode #'shell-mode)
- :action #'counsel--switch-to-shell
- :caller 'counsel-switch-to-shell-buffer))
-
-(defun counsel--switch-to-shell (name)
- "Display shell buffer with NAME and select its window.
-Reuse any existing window already displaying the named buffer.
-If there is no such buffer, start a new `shell' with NAME."
- (if (get-buffer name)
- (pop-to-buffer name '((display-buffer-reuse-window
- display-buffer-same-window)
- (inhibit-same-window . nil)
- (reusable-frames . visible)))
- (shell name)))
-
-;;** `counsel-unicode-char'
-(defvar counsel-unicode-char-history nil
- "History for `counsel-unicode-char'.")
-
-(defun counsel--unicode-names ()
- "Return formatted and sorted list of `ucs-names'.
-The result of `ucs-names' is mostly, but not completely, sorted,
-so this function ensures lexicographic order."
- (let* (cands
- (table (ucs-names)) ; Either hash map or alist
- (fmt (lambda (name code) ; Common format function
- (let ((cand (format "%06X %-58s %c" code name code)))
- (put-text-property 0 1 'code code cand)
- (push cand cands)))))
- (if (not (hash-table-p table))
- ;; Support `ucs-names' returning an alist in Emacs < 26.
- ;; The result of `ucs-names' comes pre-reversed so no need to repeat.
- (dolist (entry table)
- (funcall fmt (car entry) (cdr entry)))
- (maphash fmt table)
- ;; Reverse to speed up sorting
- (setq cands (nreverse cands)))
- (sort cands #'string-lessp)))
-
-(defvar counsel--unicode-table
- (lazy-completion-table counsel--unicode-table counsel--unicode-names)
- "Lazy completion table for `counsel-unicode-char'.
-Candidates comprise `counsel--unicode-names', which see.")
-
-;;;###autoload
-(defun counsel-unicode-char (&optional count)
- "Insert COUNT copies of a Unicode character at point.
-COUNT defaults to 1."
- (interactive "p")
- (setq ivy-completion-beg (point))
- (setq ivy-completion-end (point))
- (ivy-read "Unicode name: " counsel--unicode-table
- :history 'counsel-unicode-char-history
- :action (lambda (name)
- (with-ivy-window
- (delete-region ivy-completion-beg ivy-completion-end)
- (setq ivy-completion-beg (point))
- (insert-char (get-text-property 0 'code name) count)
- (setq ivy-completion-end (point))))
- :caller 'counsel-unicode-char))
-
-(ivy-configure 'counsel-unicode-char
- :sort-fn #'ivy-string<)
-
-(defun counsel-unicode-copy (name)
- "Ivy action to copy the unicode from NAME to the kill ring."
- (kill-new (char-to-string (get-text-property 0 'code name))))
-
-(ivy-set-actions
- 'counsel-unicode-char
- '(("w" counsel-unicode-copy "copy")))
-
-;;** `counsel-colors'
-(defun counsel-colors-action-insert-hex (color)
- "Insert the hexadecimal RGB value of COLOR."
- (insert (get-text-property 0 'hex color)))
-
-(defun counsel-colors-action-kill-hex (color)
- "Kill the hexadecimal RGB value of COLOR."
- (kill-new (get-text-property 0 'hex color)))
-
-;;** `counsel-colors-emacs'
-(defvar counsel-colors-emacs-history ()
- "History for `counsel-colors-emacs'.")
-
-(defun counsel-colors--name-to-hex (name)
- "Return hexadecimal RGB value of color with NAME.
-
-Return nil if NAME does not designate a valid color."
- (let ((rgb (color-name-to-rgb name)))
- (when rgb
- (apply #'color-rgb-to-hex rgb))))
-
-(defvar shr-color-visible-luminance-min)
-(declare-function shr-color-visible "shr-color")
-(defvar counsel--colors-format "%-20s %s %s%s")
-
-(defun counsel--colors-emacs-format-function (colors)
- "Format function for `counsel-colors-emacs'."
- (require 'shr-color)
- (let* ((blank (make-string 10 ?\s))
- (formatter
- (lambda (color)
- (let ((fg (list :foreground color)))
- (format counsel--colors-format color
- (propertize (get-text-property 0 'hex color) 'face fg)
- (propertize blank 'face (list :background color))
- (propertize (mapconcat (lambda (dup)
- (concat " " dup))
- (get-text-property 0 'dups color)
- ",")
- 'face fg))))))
- (ivy--format-function-generic
- (lambda (color)
- (let* ((hex (get-text-property 0 'hex color))
- (shr-color-visible-luminance-min 100)
- (fg (cadr (shr-color-visible hex "black" t))))
- (propertize (funcall formatter color)
- 'face (list :foreground fg :background hex))))
- formatter colors "\n")))
-
-(defun counsel--colors-web-format-function (colors)
- "Format function for `counsel-colors-web'."
- (require 'shr-color)
- (let* ((blank (make-string 10 ?\s))
- (formatter (lambda (color)
- (let ((hex (get-text-property 0 'hex color)))
- (format counsel--colors-format color
- (propertize hex 'face (list :foreground hex))
- (propertize blank 'face (list :background
hex)))))))
- (ivy--format-function-generic
- (lambda (color)
- (let* ((hex (get-text-property 0 'hex color))
- (shr-color-visible-luminance-min 100)
- (fg (cadr (shr-color-visible hex "black" t))))
- (propertize (funcall formatter color)
- 'face (list :foreground fg :background hex))))
- formatter colors "\n")))
-
-;;;###autoload
-(defun counsel-colors-emacs ()
- "Show a list of all supported colors for a particular frame.
-
-You can insert or kill the name or hexadecimal RGB value of the
-selected color."
- (interactive)
- (let* ((colors
- (delete nil
- (mapcar (lambda (cell)
- (let* ((name (car cell))
- (dups (cdr cell))
- (hex (counsel-colors--name-to-hex name)))
- (when hex
- (propertize name 'hex hex 'dups dups))))
- (list-colors-duplicates))))
- (counsel--colors-format
- (format "%%-%ds %%s %%s%%s"
- (apply #'max 0 (mapcar #'string-width colors)))))
- (ivy-read "Emacs color: " colors
- :require-match t
- :history 'counsel-colors-emacs-history
- :action #'insert
- :caller 'counsel-colors-emacs)))
-(ivy-configure 'counsel-colors-emacs
- :format-fn #'counsel--colors-emacs-format-function)
-
-(ivy-set-actions
- 'counsel-colors-emacs
- '(("h" counsel-colors-action-insert-hex "insert hexadecimal value")
- ("H" counsel-colors-action-kill-hex "kill hexadecimal value")))
-
-;;** `counsel-colors-web'
-(defvar shr-color-html-colors-alist)
-
-(defun counsel-colors--web-alist ()
- "Return list of CSS colors for `counsel-colors-web'."
- (require 'shr-color)
- (let* ((alist (copy-alist shr-color-html-colors-alist))
- (mp (assoc "MediumPurple" alist))
- (pvr (assoc "PaleVioletRed" alist))
- (rp (assoc "RebeccaPurple" alist)))
- ;; Backport GNU Emacs bug#30377
- (when mp (setcdr mp "#9370db"))
- (when pvr (setcdr pvr "#db7093"))
- (unless rp (push (cons "rebeccapurple" "#663399") alist))
- (sort (mapcar (lambda (cell)
- (propertize (downcase (car cell))
- 'hex (downcase (cdr cell))))
- alist)
- #'string-lessp)))
-
-(defvar counsel-colors-web-history ()
- "History for `counsel-colors-web'.")
-
-;;;###autoload
-(defun counsel-colors-web ()
- "Show a list of all W3C web colors for use in CSS.
-
-You can insert or kill the name or hexadecimal RGB value of the
-selected color."
- (interactive)
- (let* ((colors (counsel-colors--web-alist))
- (counsel--colors-format
- (format "%%-%ds %%s %%s"
- (apply #'max 0 (mapcar #'string-width colors)))))
- (ivy-read "Web color: " colors
- :require-match t
- :history 'counsel-colors-web-history
- :action #'insert
- :caller 'counsel-colors-web)))
-
-(ivy-configure 'counsel-colors-web
- :sort-fn #'ivy-string<
- :format-fn #'counsel--colors-web-format-function)
-
-(ivy-set-actions
- 'counsel-colors-web
- '(("h" counsel-colors-action-insert-hex "insert hexadecimal value")
- ("H" counsel-colors-action-kill-hex "kill hexadecimal value")))
-
-;;** `counsel-fonts'
-(defvar counsel-fonts-history ()
- "History for `counsel-fonts'.")
-
-;;;###autoload
-(defun counsel-fonts ()
- "Show a list of all supported font families for a particular frame.
-
-You can insert or kill the name of the selected font."
- (interactive)
- (ivy-read "Font: " (delete-dups (font-family-list))
- :require-match t
- :history 'counsel-fonts-history
- :action #'insert
- :caller 'counsel-fonts))
-
-;;* Misc. OS
-;;** `counsel-rhythmbox'
-(declare-function dbus-call-method "dbus")
-(declare-function dbus-get-property "dbus")
-
-(defun counsel--run (&rest program-and-args)
- (let ((name (mapconcat #'identity program-and-args " ")))
- (apply #'start-process name nil program-and-args)
- name))
-
-(defun counsel--sl (cmd)
- "Shell command to list."
- (split-string (shell-command-to-string cmd) "\n" t))
-
-(defun counsel-rhythmbox-play-song (song)
- "Let Rhythmbox play SONG."
- (let ((first (string= (shell-command-to-string "pidof rhythmbox") ""))
- (service "org.gnome.Rhythmbox3")
- (path "/org/mpris/MediaPlayer2")
- (interface "org.mpris.MediaPlayer2.Player"))
- (when first
- (counsel--run "nohup" "rhythmbox")
- (sit-for 1.5))
- (dbus-call-method :session service path interface
- "OpenUri" (cdr song))
- (let ((id (and first
- (cdr (counsel--wmctrl-parse
- (shell-command-to-string
- "wmctrl -l -p | grep $(pidof rhythmbox)"))))))
- (when id
- (sit-for 0.2)
- (counsel--run "wmctrl" "-ic" id)))))
-
-(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" (cdr song))))
-
-(defun counsel-rhythmbox-toggle-shuffle (_song)
- "Toggle Rhythmbox shuffle setting."
- (let* ((old-order (counsel--command "dconf" "read"
"/org/gnome/rhythmbox/player/play-order"))
- (new-order (if (string= old-order "'shuffle'")
- "'linear'"
- "'shuffle'")))
- (counsel--command
- "dconf"
- "write"
- "/org/gnome/rhythmbox/player/play-order"
- new-order)
- (message (if (string= new-order "'shuffle'")
- "shuffle on"
- "shuffle off"))))
-
-(defvar counsel-rhythmbox-history nil
- "History for `counsel-rhythmbox'.")
-
-(defvar counsel-rhythmbox-songs nil)
-
-(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 (&optional arg)
- "Choose a song from the Rhythmbox library to play or enqueue."
- (interactive "P")
- (require 'dbus)
- (when (or arg (null counsel-rhythmbox-songs))
- (let* ((service "org.gnome.Rhythmbox3")
- (path "/org/gnome/UPnP/MediaServer2/Library/all")
- (interface "org.gnome.UPnP.MediaContainer2")
- (nb-songs (dbus-get-property
- :session service path interface "ChildCount")))
- (if (not nb-songs)
- (error "Couldn't connect to Rhythmbox")
- (setq counsel-rhythmbox-songs
- (mapcar (lambda (x)
- (cons
- (format
- "%s - %s - %s"
- (cl-caadr (assoc "Artist" x))
- (cl-caadr (assoc "Album" x))
- (cl-caadr (assoc "DisplayName" x)))
- (cl-caaadr (assoc "URLs" x))))
- (dbus-call-method
- :session service path interface "ListChildren"
- 0 nb-songs '("*")))))))
- (ivy-read "Rhythmbox: " counsel-rhythmbox-songs
- :require-match t
- :history 'counsel-rhythmbox-history
- :preselect (counsel-rhythmbox-current-song)
- :action
- '(1
- ("p" counsel-rhythmbox-play-song "Play song")
- ("e" counsel-rhythmbox-enqueue-song "Enqueue song")
- ("s" counsel-rhythmbox-toggle-shuffle "Shuffle on/off"))
- :caller 'counsel-rhythmbox))
-
-;;** `counsel-linux-app'
-(require 'xdg nil t)
-
-(defalias 'counsel--xdg-data-home
- (if (fboundp 'xdg-data-home)
- #'xdg-data-home
- (lambda ()
- (let ((directory (getenv "XDG_DATA_HOME")))
- (if (or (null directory) (string= directory ""))
- "~/.local/share"
- directory))))
- "Compatibility shim for `xdg-data-home'.")
-
-(defalias 'counsel--xdg-data-dirs
- (if (fboundp 'xdg-data-dirs)
- #'xdg-data-dirs
- (lambda ()
- (let ((path (getenv "XDG_DATA_DIRS")))
- (if (or (null path) (string= path ""))
- '("/usr/local/share" "/usr/share")
- (parse-colon-path path)))))
- "Compatibility shim for `xdg-data-dirs'.")
-
-(defcustom counsel-linux-apps-directories
- (mapcar (lambda (dir) (expand-file-name "applications" dir))
- (cons (counsel--xdg-data-home)
- (counsel--xdg-data-dirs)))
- "Directories in which to search for applications (.desktop files)."
- :type '(repeat directory))
-
-(defcustom counsel-linux-app-format-function
#'counsel-linux-app-format-function-default
- "Function to format Linux application names the `counsel-linux-app' menu.
-The format function will be passed the application's name, comment, and command
-as arguments."
- :type '(choice
- (const :tag "Command : Name - Comment"
counsel-linux-app-format-function-default)
- (const :tag "Name - Comment (Command)"
counsel-linux-app-format-function-name-first)
- (const :tag "Name - Comment"
counsel-linux-app-format-function-name-only)
- (const :tag "Command" counsel-linux-app-format-function-command-only)
- (function :tag "Custom")))
-
-(defface counsel-application-name
- '((t :inherit font-lock-builtin-face))
- "Face for displaying executable names."
- :group 'ivy-faces)
-
-(defface counsel-outline-1
- '((t :inherit org-level-1))
- "Face for displaying level 1 headings."
- :group 'ivy-faces)
-
-(defface counsel-outline-2
- '((t :inherit org-level-2))
- "Face for displaying level 2 headings."
- :group 'ivy-faces)
-
-(defface counsel-outline-3
- '((t :inherit org-level-3))
- "Face for displaying level 3 headings."
- :group 'ivy-faces)
-
-(defface counsel-outline-4
- '((t :inherit org-level-4))
- "Face for displaying level 4 headings."
- :group 'ivy-faces)
-
-(defface counsel-outline-5
- '((t :inherit org-level-5))
- "Face for displaying level 5 headings."
- :group 'ivy-faces)
-
-(defface counsel-outline-6
- '((t :inherit org-level-6))
- "Face for displaying level 6 headings."
- :group 'ivy-faces)
-
-(defface counsel-outline-7
- '((t :inherit org-level-7))
- "Face for displaying level 7 headings."
- :group 'ivy-faces)
-
-(defface counsel-outline-8
- '((t :inherit org-level-8))
- "Face for displaying level 8 headings."
- :group 'ivy-faces)
-
-(defface counsel-outline-default
- '((t :inherit minibuffer-prompt))
- "Face for displaying headings."
- :group 'ivy-faces)
-
-(defvar counsel-linux-apps-faulty nil
- "List of faulty desktop files.")
-
-(defvar counsel--linux-apps-cache nil
- "Cache of desktop files data.")
-
-(defvar counsel--linux-apps-cached-files nil
- "List of cached desktop files.")
-
-(defvar counsel--linux-apps-cache-timestamp nil
- "Time when we last updated the cached application list.")
-
-(defvar counsel--linux-apps-cache-format-function nil
- "The function used to format the cached Linux application menu.")
-
-(defun counsel-linux-app-format-function-default (name comment exec)
- "Default Linux application name formatter.
-NAME is the name of the application, COMMENT its comment and EXEC
-the command to launch it."
- (format "% -45s: %s%s"
- (propertize
- (ivy--truncate-string exec 45)
- 'face 'counsel-application-name)
- name
- (if comment
- (concat " - " comment)
- "")))
-
-(defun counsel-linux-app-format-function-name-first (name comment exec)
- "Format Linux application names with the NAME (and COMMENT) first.
-EXEC is the command to launch the application."
- (format "%s%s (%s)"
- name
- (if comment
- (concat " - " comment)
- "")
- (propertize exec 'face 'counsel-application-name)))
-
-(defun counsel-linux-app-format-function-name-only (name comment _exec)
- "Format Linux application names with the NAME (and COMMENT) only."
- (format "%s%s"
- name
- (if comment
- (concat " - " comment)
- "")))
-
-(defun counsel-linux-app-format-function-command-only (_name _comment exec)
- "Display only the command EXEC when formatting Linux application names."
- exec)
-
-(defun counsel-linux-apps-list-desktop-files ()
- "Return an alist of all Linux applications.
-Each list entry is a pair of (desktop-name . desktop-file).
-This function always returns its elements in a stable order."
- (let ((hash (make-hash-table :test #'equal))
- result)
- (dolist (dir counsel-linux-apps-directories)
- (when (file-exists-p dir)
- (let ((dir (file-name-as-directory dir)))
- (dolist (file (directory-files-recursively dir ".*\\.desktop$"))
- (let ((id (subst-char-in-string ?/ ?- (file-relative-name file
dir))))
- (when (and (not (gethash id hash)) (file-readable-p file))
- (push (cons id file) result)
- (puthash id file hash)))))))
- result))
-
-(defun counsel-linux-app--parse-file (file)
- (with-temp-buffer
- (insert-file-contents file)
- (goto-char (point-min))
- (let ((start (re-search-forward "^\\[Desktop Entry\\] *$" nil t))
- (end (re-search-forward "^\\[" nil t))
- (visible t)
- name comment exec)
- (catch 'break
- (unless start
- (push file counsel-linux-apps-faulty)
- (message "Warning: File %s has no [Desktop Entry] group" file)
- (throw 'break nil))
-
- (goto-char start)
- (when (re-search-forward "^\\(Hidden\\|NoDisplay\\) *= *\\(1\\|true\\)
*$" end t)
- (setq visible nil))
- (setq name (match-string 1))
-
- (goto-char start)
- (unless (re-search-forward "^Type *= *Application *$" end t)
- (throw 'break nil))
- (setq name (match-string 1))
-
- (goto-char start)
- (unless (re-search-forward "^Name *= *\\(.+\\)$" end t)
- (push file counsel-linux-apps-faulty)
- (message "Warning: File %s has no Name" file)
- (throw 'break nil))
- (setq name (match-string 1))
-
- (goto-char start)
- (when (re-search-forward "^Comment *= *\\(.+\\)$" end t)
- (setq comment (match-string 1)))
-
- (goto-char start)
- (unless (re-search-forward "^Exec *= *\\(.+\\)$" end t)
- ;; Don't warn because this can technically be a valid desktop file.
- (throw 'break nil))
- (setq exec (match-string 1))
-
- (goto-char start)
- (when (re-search-forward "^TryExec *= *\\(.+\\)$" end t)
- (let ((try-exec (match-string 1)))
- (unless (locate-file try-exec exec-path nil #'file-executable-p)
- (throw 'break nil))))
- (propertize
- (funcall counsel-linux-app-format-function name comment exec)
- 'visible visible)))))
-
-(defun counsel-linux-apps-parse (desktop-entries-alist)
- "Parse the given alist of Linux desktop entries.
-Each entry in DESKTOP-ENTRIES-ALIST is a pair of ((id . file-name)).
-Any desktop entries that fail to parse are recorded in
-`counsel-linux-apps-faulty'."
- (let (result)
- (setq counsel-linux-apps-faulty nil)
- (dolist (entry desktop-entries-alist result)
- (let* ((id (car entry))
- (file (cdr entry))
- (r (counsel-linux-app--parse-file file)))
- (when r
- (push (cons r id) result))))))
-
-(defun counsel-linux-apps-list ()
- "Return list of all Linux desktop applications."
- (let* ((new-desktop-alist (counsel-linux-apps-list-desktop-files))
- (new-files (mapcar 'cdr new-desktop-alist)))
- (unless (and
- (eq counsel-linux-app-format-function
- counsel--linux-apps-cache-format-function)
- (equal new-files counsel--linux-apps-cached-files)
- (null (cl-find-if
- (lambda (file)
- (time-less-p
- counsel--linux-apps-cache-timestamp
- (nth 5 (file-attributes file))))
- new-files)))
- (setq counsel--linux-apps-cache (counsel-linux-apps-parse
new-desktop-alist))
- (setq counsel--linux-apps-cache-format-function
counsel-linux-app-format-function)
- (setq counsel--linux-apps-cache-timestamp (current-time))
- (setq counsel--linux-apps-cached-files new-files)))
- counsel--linux-apps-cache)
-
-
-(defun counsel-linux-app-action-default (desktop-shortcut)
- "Launch DESKTOP-SHORTCUT."
- (call-process "gtk-launch" nil 0 nil (cdr desktop-shortcut)))
-
-(defun counsel-linux-app-action-file (desktop-shortcut)
- "Launch DESKTOP-SHORTCUT with a selected file."
- (call-process "gtk-launch" nil 0 nil
- (cdr desktop-shortcut)
- (read-file-name "File: ")))
-
-(defun counsel-linux-app-action-open-desktop (desktop-shortcut)
- "Open DESKTOP-SHORTCUT."
- (let* ((app (cdr desktop-shortcut))
- (file (cdr (assoc app (counsel-linux-apps-list-desktop-files)))))
- (if file
- (find-file file)
- (error "Could not find location of file %s" app))))
-
-(ivy-set-actions
- 'counsel-linux-app
- '(("f" counsel-linux-app-action-file "run on a file")
- ("d" counsel-linux-app-action-open-desktop "open desktop file")))
-
-;;;###autoload
-(defun counsel-linux-app (&optional arg)
- "Launch a Linux desktop application, similar to Alt-<F2>.
-When ARG is non-nil, ignore NoDisplay property in *.desktop files."
- (interactive "P")
- (ivy-read "Run a command: " (counsel-linux-apps-list)
- :predicate (unless arg (lambda (x) (get-text-property 0 'visible
(car x))))
- :action #'counsel-linux-app-action-default
- :caller 'counsel-linux-app))
-
-;;** `counsel-wmctrl'
-(defun counsel-wmctrl-action (x)
- "Select the desktop window that corresponds to X."
- (counsel--run "wmctrl" "-i" "-a" (cdr x)))
-
-(defvar counsel-wmctrl-ignore '("XdndCollectionWindowImp"
- "unity-launcher" "unity-panel" "unity-dash"
- "Hud" "Desktop")
- "List of window titles to ignore for `counsel-wmctrl'.")
-
-(defun counsel--wmctrl-parse (s)
- (when (string-match "\\`\\([0-9a-fx]+\\) +\\([-0-9]+\\) +\\(?:[0-9]+\\)
+\\([^ ]+\\) \\(.+\\)$" s)
- (let ((title (match-string 4 s))
- (id (match-string 1 s)))
- (unless (member title counsel-wmctrl-ignore)
- (cons title id)))))
-
-;;;###autoload
-(defun counsel-wmctrl ()
- "Select a desktop window using wmctrl."
- (interactive)
- (let* ((cands1 (counsel--sl "wmctrl -l -p"))
- (cands2 (delq nil (mapcar #'counsel--wmctrl-parse cands1))))
- (ivy-read "window: " cands2
- :action #'counsel-wmctrl-action
- :caller 'counsel-wmctrl)))
-
-(defvar counsel--switch-buffer-temporary-buffers nil
- "Internal.")
-
-(defvar counsel--switch-buffer-previous-buffers nil
- "Internal.")
-
-(defun counsel--switch-buffer-unwind ()
- "Clear temporary file buffers and restore `buffer-list'.
-The buffers are those opened during a session of `counsel-switch-buffer'."
- (mapc #'kill-buffer counsel--switch-buffer-temporary-buffers)
- (mapc #'bury-buffer (cl-remove-if-not
- #'buffer-live-p
- counsel--switch-buffer-previous-buffers))
- (setq counsel--switch-buffer-temporary-buffers nil
- counsel--switch-buffer-previous-buffers nil))
-
-(defun counsel--switch-buffer-update-fn ()
- (unless counsel--switch-buffer-previous-buffers
- (setq counsel--switch-buffer-previous-buffers (buffer-list)))
- (let* ((current (ivy-state-current ivy-last))
- (virtual (assoc current ivy--virtual-buffers)))
- (cond
- ((get-buffer current)
- (ivy-call))
- ((and virtual (file-exists-p (cdr virtual)))
- (let ((buf (ignore-errors
- ;; may not open due to `large-file-warning-threshold' etc.
- (find-file-noselect (cdr virtual)))))
- (if buf
- (progn
- (push buf counsel--switch-buffer-temporary-buffers)
- (ivy-call))
- ;; clean up the minibuffer so that there's no delay before
- ;; the Ivy candidates are displayed once again
- (message ""))))
- (t
- (with-ivy-window
- (switch-to-buffer (ivy-state-buffer ivy-last)))))))
-
-;;;###autoload
-(defun counsel-switch-buffer ()
- "Switch to another buffer.
-Display a preview of the selected ivy completion candidate buffer
-in the current window."
- (interactive)
- (let ((ivy-update-fns-alist
- '((ivy-switch-buffer . counsel--switch-buffer-update-fn)))
- (ivy-unwind-fns-alist
- '((ivy-switch-buffer . counsel--switch-buffer-unwind))))
- (ivy-switch-buffer)))
-
-;;;###autoload
-(defun counsel-switch-buffer-other-window ()
- "Switch to another buffer in another window.
-Display a preview of the selected ivy completion candidate buffer
-in the current window."
- (interactive)
- (let ((ivy-update-fns-alist
- '((ivy-switch-buffer-other-window .
counsel--switch-buffer-update-fn)))
- (ivy-unwind-fns-alist
- '((ivy-switch-buffer-other-window . counsel--switch-buffer-unwind))))
- (ivy-switch-buffer-other-window)))
-
-(defun counsel-open-buffer-file-externally (buffer)
- "Open the file associated with BUFFER with an external program."
- (when (zerop (length buffer))
- (user-error "Can't open that"))
- (let* ((virtual (assoc buffer ivy--virtual-buffers))
- (filename (if virtual
- (cdr virtual)
- (buffer-file-name (get-buffer buffer)))))
- (unless filename
- (user-error "Can't open `%s' externally" buffer))
- (counsel-locate-action-extern (expand-file-name filename))))
-
-(ivy-add-actions
- 'ivy-switch-buffer
- '(("x" counsel-open-buffer-file-externally "open externally")))
-
-(ivy-set-actions
- 'counsel-switch-buffer
- '(("x" counsel-open-buffer-file-externally "open externally")
- ("j" ivy--switch-buffer-other-window-action "other window")))
-
-;;** `counsel-compile'
-(defvar counsel-compile-history nil
- "History for `counsel-compile'.
-
-This is a list of strings with additional properties which allow
-the history to be filtered depending on the context of the call.
-The properties include:
-
-`srcdir'
- the root directory of the source code
-`blddir'
- the root directory of the build (in or outside the `srcdir')
-`bldenv'
- the build environment as passed to `compilation-environment'
-`recursive'
- the completion should be run again in `blddir' of this result
-`cmd'
- if set, pass only the substring with this property to `compile'
-
-This variable is suitable for addition to
-`savehist-additional-variables'.")
-
-(defvar counsel-compile-root-functions
- '(counsel--project-current
- counsel--configure-root
- counsel--git-root
- counsel--dir-locals-root)
- "Special hook to find the project root for compile commands.
-Each function on this hook is called in turn with no arguments
-and should return either a directory, or nil if no root was
-found.")
-
-(defun counsel--compile-root ()
- "Return root of current project or signal an error on failure.
-The root is determined by `counsel-compile-root-functions'."
- (or (run-hook-with-args-until-success 'counsel-compile-root-functions)
- (error "Couldn't find project root")))
-
-(defun counsel--project-current ()
- "Return root of current project or nil on failure.
-Use `project-current' to determine the root."
- (and (fboundp 'project-current)
- (cdr (project-current))))
-
-(defun counsel--configure-root ()
- "Return root of current project or nil on failure.
-Use the presence of a \"configure\" file to determine the root."
- (counsel--dominating-file "configure"))
-
-(defun counsel--git-root ()
- "Return root of current project or nil on failure.
-Use the presence of a \".git\" file to determine the root."
- (counsel--dominating-file ".git"))
-
-(defun counsel--dir-locals-root ()
- "Return root of current project or nil on failure.
-Use the presence of a `dir-locals-file' to determine the root."
- (counsel--dominating-file dir-locals-file))
-
-(defvar counsel-compile-local-builds
- '(counsel-compile-get-filtered-history
- counsel-compile-get-build-directories
- counsel-compile-get-make-invocation)
- "Additional compile invocations to feed into `counsel-compile'.
-
-This can either be a list of compile invocation strings or
-functions that will provide such a list. You should customize
-this if you want to provide specific non-standard build types to
-`counsel-compile'. The default helpers are set up to handle
-common build environments.")
-
-(defcustom counsel-compile-make-args "-k"
- "Additional arguments for make.
-You may, for example, want to add \"-jN\" for the number of cores
-N in your system."
- :type 'string)
-
-(defcustom counsel-compile-env nil
- "List of environment variables for compilation to inherit.
-Each element should be a string of the form ENVVARNAME=VALUE. This
-list is passed to `compilation-environment'."
- :type '(repeat (string :tag "ENVVARNAME=VALUE")))
-
-(defvar counsel-compile-env-history nil
- "History for `counsel-compile-env'.")
-
-(defvar counsel-compile-env-pattern
- "[_[:digit:][:upper:]]+=[/[:alnum:]]*"
- "Pattern to match valid environment variables.")
-
-(defcustom counsel-compile-make-pattern "\\`\\(?:GNUm\\|[Mm]\\)akefile\\'"
- "Regexp for matching the names of Makefiles."
- :type 'regexp)
-
-(defcustom counsel-compile-build-directories
- '("build" "builds" "bld" ".build")
- "List of potential build subdirectory names to check for."
- :type '(repeat directory))
-
-(defvar counsel-compile-phony-pattern "^\\.PHONY:[\t ]+\\(.+\\)$"
- "Regexp for extracting phony targets from Makefiles.")
-
-;; This is loosely based on the Bash Make completion code
-(defun counsel-compile--probe-make-targets (dir)
- "Return a list of Make targets for DIR.
-
-Return an empty list is Make exits with an error. This might
-happen because some sort of configuration needs to be done first
-or the source tree is pristine and being used for multiple build
-trees."
- (let ((default-directory dir)
- (targets nil))
- (with-temp-buffer
- ;; 0 = no-rebuild, -q & 1 needs rebuild, 2 error (for GNUMake at
- ;; least)
- (when (< (call-process "make" nil t nil "-nqp") 2)
- (goto-char (point-min))
- (while (re-search-forward counsel-compile-phony-pattern nil t)
- (setq targets
- (nconc targets (split-string
- (match-string-no-properties 1)))))))
- (sort targets #'string-lessp)))
-
-(defun counsel-compile--pretty-propertize (leader text face)
- "Return a pretty string of the form \" LEADER TEXT\".
-LEADER is propertized with a warning face and the remaining
-text with FACE."
- (concat (propertize (concat " " leader " ")
- 'face
- 'font-lock-warning-face)
- (propertize text 'face face)))
-
-(defun counsel--compile-get-make-targets (srcdir &optional blddir)
- "Return a list of Make targets for a given SRCDIR/BLDDIR combination.
-
-We search the Makefile for a list of phony targets which are
-generally the top level targets a Make system provides.
-The resulting strings are tagged with properties that
-`counsel-compile-history' can use for filtering results."
- (let ((fmt (format (propertize "make %s %%s" 'cmd t)
- counsel-compile-make-args))
- (suffix (and blddir
- (counsel-compile--pretty-propertize "in" blddir
- 'dired-directory)))
- (build-env (and counsel-compile-env
- (counsel-compile--pretty-propertize
- "with"
- (mapconcat #'identity counsel-compile-env " ")
- 'font-lock-variable-name-face)))
- (props `(srcdir ,srcdir blddir ,blddir bldenv ,counsel-compile-env)))
- (mapcar (lambda (target)
- (setq target (concat (format fmt target) suffix build-env))
- (add-text-properties 0 (length target) props target)
- target)
- (counsel-compile--probe-make-targets (or blddir srcdir)))))
-
-(defun counsel-compile-get-make-invocation (&optional blddir)
- "Have a look in the root directory for any build control files.
-
-The optional BLDDIR is useful for other helpers that have found
-sub-directories that builds may be invoked in."
- (let ((srcdir (counsel--compile-root)))
- (when (directory-files (or blddir srcdir) nil
- counsel-compile-make-pattern t)
- (counsel--compile-get-make-targets srcdir blddir))))
-
-(defun counsel--find-build-subdir (srcdir)
- "Return builds subdirectory of SRCDIR, if one exists."
- (cl-some (lambda (dir)
- (setq dir (expand-file-name dir srcdir))
- (and (file-directory-p dir) dir))
- counsel-compile-build-directories))
-
-(defun counsel--get-build-subdirs (blddir)
- "Return all subdirs under BLDDIR sorted by modification time.
-If there are non-directory files in BLDDIR, include BLDDIR in the
-list as it may also be a build directory."
- (let* ((files (directory-files-and-attributes
- blddir t directory-files-no-dot-files-regexp t))
- (dirs (cl-remove-if-not #'cl-second files)))
- ;; Any non-dir files?
- (when (< (length dirs)
- (length files))
- (push (cons blddir (file-attributes blddir)) dirs))
- (mapcar #'car (sort dirs (lambda (x y)
- (time-less-p (nth 6 y) (nth 6 x)))))))
-
-(defun counsel-compile-get-build-directories (&optional dir)
- "Return a list of potential build directories."
- (let* ((srcdir (or dir (counsel--compile-root)))
- (blddir (counsel--find-build-subdir srcdir))
- (props `(srcdir ,srcdir recursive t))
- (fmt (concat (propertize "Select build in "
- 'face 'font-lock-warning-face)
- (propertize "%s" 'face 'dired-directory))))
- (mapcar (lambda (subdir)
- (let ((s (format fmt subdir)))
- (add-text-properties 0 (length s) `(blddir ,subdir ,@props) s)
- s))
- (and blddir (counsel--get-build-subdirs blddir)))))
-
-;; This is a workaround for the fact there is no concept of "project"
-;; local variables (as opposed to for example buffer-local). So we
-;; store all our history in a global list filter out the results we
-;; don't want.
-(defun counsel-compile-get-filtered-history (&optional dir)
- "Return a compile history relevant to current project."
- (let ((root (or dir (counsel--compile-root)))
- history)
- (dolist (item counsel-compile-history)
- (let ((srcdir (get-text-property 0 'srcdir item))
- (blddir (get-text-property 0 'blddir item)))
- (when (or (and srcdir (file-in-directory-p srcdir root))
- (and blddir (file-in-directory-p blddir root)))
- (push item history))))
- (nreverse history)))
-
-(defun counsel--get-compile-candidates (&optional dir)
- "Return the list of compile commands.
-This is determined by `counsel-compile-local-builds', which see."
- (let (cands)
- (dolist (cmds counsel-compile-local-builds)
- (when (functionp cmds)
- (setq cmds (funcall cmds dir)))
- (when cmds
- (push (if (listp cmds) cmds (list cmds)) cands)))
- (apply #'append (nreverse cands))))
-
-;; This is a workaround to ensure we tag all the relevant metadata in
-;; our compile history. This also allows M-x compile to do fancy
-;; things like infer `default-directory' from 'cd's in the string.
-(defun counsel-compile--update-history (_proc)
- "Update `counsel-compile-history' from the compilation state."
- (let* ((srcdir (counsel--compile-root))
- (blddir default-directory)
- (bldenv compilation-environment)
- (cmd (concat
- (propertize (car compilation-arguments) 'cmd t)
- (unless (file-equal-p blddir srcdir)
- (counsel-compile--pretty-propertize "in" blddir
- 'dired-directory))
- (when bldenv
- (counsel-compile--pretty-propertize "with"
- (mapconcat #'identity
bldenv " ")
-
'font-lock-variable-name-face)))))
- (add-text-properties 0 (length cmd)
- `(srcdir ,srcdir blddir ,blddir bldenv ,bldenv) cmd)
- (add-to-history 'counsel-compile-history cmd)))
-
-(defvar counsel-compile--current-build-dir nil
- "Tracks the last directory `counsel-compile' was called with.
-
-This state allows us to set it correctly if the user has manually
-edited the command, thus losing our embedded state.")
-
-(defun counsel-compile--action (cmd)
- "Process CMD to call `compile'.
-
-If CMD has the `recursive' property set we call `counsel-compile'
-again to further refine the compile options in the directory
-specified by the `blddir' property."
- (let ((blddir (get-text-property 0 'blddir cmd))
- (bldenv (get-text-property 0 'bldenv cmd)))
- (if (get-text-property 0 'recursive cmd)
- (counsel-compile blddir)
- (when (get-char-property 0 'cmd cmd)
- (setq cmd (substring-no-properties
- cmd 0 (next-single-property-change 0 'cmd cmd))))
- (let ((default-directory (or blddir
- counsel-compile--current-build-dir
- default-directory))
- (compilation-environment bldenv))
- ;; No need to specify `:history' because of this hook.
- (add-hook 'compilation-start-hook #'counsel-compile--update-history)
- (unwind-protect
- (compile cmd)
- (remove-hook 'compilation-start-hook
#'counsel-compile--update-history))))))
-
-;;;###autoload
-(defun counsel-compile (&optional dir)
- "Call `compile' completing with smart suggestions, optionally for DIR."
- (interactive)
- (setq counsel-compile--current-build-dir (or dir
- (counsel--compile-root)
- default-directory))
- (ivy-read "Compile command: "
- (delete-dups (counsel--get-compile-candidates dir))
- :action #'counsel-compile--action
- :caller 'counsel-compile))
-
-
-(defun counsel-compile-env--format-hint (cands)
- "Return a formatter for compile-env CANDS."
- (let ((rmstr
- (propertize "remove" 'face 'font-lock-warning-face))
- (addstr
- (propertize "add" 'face 'font-lock-variable-name-face)))
- (ivy--format-function-generic
- (lambda (selected)
- (format "%s %s"
- (if (member selected counsel-compile-env) rmstr addstr)
- selected))
- #'identity
- cands
- "\n")))
-
-(defun counsel-compile-env--update (var)
- "Update `counsel-compile-env' either adding or removing VAR."
- (cond ((member var counsel-compile-env)
- (setq counsel-compile-env (delete var counsel-compile-env)))
- ((string-match-p counsel-compile-env-pattern var)
- (push var counsel-compile-env))
- (t (user-error "Ignoring malformed variable: '%s'" var))))
-
-;;;###autoload
-(defun counsel-compile-env ()
- "Update `counsel-compile-env' interactively."
- (interactive)
- (ivy-read "Compile environment variable: "
- (delete-dups (append
- counsel-compile-env counsel-compile-env-history))
- :action #'counsel-compile-env--update
- :predicate (lambda (cand)
- (string-match-p counsel-compile-env-pattern
- cand))
- :history 'counsel-compile-env-history
- :caller 'counsel-compile-env))
-
-(ivy-configure 'counsel-compile-env
- :format-fn #'counsel-compile-env--format-hint)
-
-;;** `counsel-minor'
-(defvar counsel-minor-history nil
- "History for `counsel-minor'.")
-
-(defun counsel--minor-candidates ()
- "Return completion alist for `counsel-minor'.
-
-The alist element is cons of minor mode string with its lighter
-and minor mode symbol."
- (delq nil
- (mapcar
- (lambda (mode)
- (when (and (boundp mode) (commandp mode))
- (let ((lighter (alist-get mode minor-mode-alist)))
- (cons (concat
- (if (symbol-value mode) "-" "+")
- (symbol-name mode)
- (propertize
- (if lighter
- (format " \"%s\""
- (format-mode-line (cons t lighter)))
- "")
- 'face font-lock-string-face))
- mode))))
- minor-mode-list)))
-
-;;;###autoload
-(defun counsel-minor ()
- "Enable or disable minor mode.
-
-Disabled minor modes are prefixed with \"+\", and
-selecting one of these will enable it.
-Enabled minor modes are prefixed with \"-\", and
-selecting one of these will enable it.
-
-Additional actions:\\<ivy-minibuffer-map>
-
- \\[ivy-dispatching-done] d: Go to minor mode definition
- \\[ivy-dispatching-done] h: Describe minor mode"
-
- (interactive)
- (ivy-read "Minor modes (enable +mode or disable -mode): "
- (counsel--minor-candidates)
- :require-match t
- :history 'counsel-minor-history
- :action (lambda (x)
- (call-interactively (cdr x)))))
-
-(ivy-configure 'counsel-minor
- :initial-input "^+"
- :sort-fn #'ivy-string<)
-
-(ivy-set-actions
- 'counsel-minor
- `(("d" ,(lambda (x) (find-function (cdr x))) "definition")
- ("h" ,(lambda (x) (describe-function (cdr x))) "help")))
-
-;;;###autoload
-(defun counsel-major ()
- (interactive)
- (ivy-read "Major modes: " obarray
- :predicate (lambda (f)
- (and (commandp f) (string-match "-mode$" (symbol-name
f))
- (or (and (autoloadp (symbol-function f))
- (let ((doc-split (help-split-fundoc
(documentation f) f)))
- ;; major mode starters have no
arguments
- (and doc-split (null (cdr (read (car
doc-split)))))))
- (null (help-function-arglist f)))))
- :action #'counsel-M-x-action
- :caller 'counsel-major))
-
-;;* `counsel-google'
-(declare-function request "ext:request")
-(defun counsel-google-function (input)
- "Create a request to Google with INPUT.
-Return 0 tells `ivy--exhibit' not to update the minibuffer.
-We update it in the callback with `ivy-update-candidates'."
- (or
- (ivy-more-chars)
- (progn
- (require 'request)
- (require 'json)
- (request
- "http://suggestqueries.google.com/complete/search";
- :type "GET"
- :params (list
- (cons "client" "firefox")
- (cons "q" input))
- :parser 'json-read
- :success (cl-function
- (lambda (&key data &allow-other-keys)
- (ivy-update-candidates
- (mapcar #'identity (aref data 1))))))
- 0)))
-
-(defun counsel-google ()
- "Ivy interface for Google."
- (interactive)
- (ivy-read "search: " #'counsel-google-function
- :action (lambda (x)
- (browse-url (concat "https://www.google.com/search?q=";
x)))
- :dynamic-collection t
- :caller 'counsel-google))
-
-;;* `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)
- (apropos-command . counsel-apropos)
- (describe-face . counsel-describe-face)
- (list-faces-display . counsel-faces)
- (find-file . counsel-find-file)
- (find-library . counsel-find-library)
- (imenu . counsel-imenu)
- (load-library . counsel-load-library)
- (load-theme . counsel-load-theme)
- (yank-pop . counsel-yank-pop)
- (info-lookup-symbol . counsel-info-lookup-symbol)
- (pop-to-mark-command . counsel-mark-ring)
- (bookmark-jump . counsel-bookmark)))
- (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."
- :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.
-
-Local bindings (`counsel-mode-map'):
-\\{counsel-mode-map}"
- :global t
- :keymap counsel-mode-map
- :lighter " counsel"
- (if counsel-mode
- (progn
- (when (and (fboundp 'advice-add)
- counsel-mode-override-describe-bindings)
- (advice-add #'describe-bindings :override #'counsel-descbinds))
- (define-key minibuffer-local-map (kbd "C-r")
- 'counsel-minibuffer-history))
- (when (fboundp 'advice-remove)
- (advice-remove #'describe-bindings #'counsel-descbinds))))
-
-(provide 'counsel)
-
-;;; counsel.el ends here
diff --git a/elpa.el b/elpa.el
deleted file mode 100644
index e49b8d4..0000000
--- a/elpa.el
+++ /dev/null
@@ -1,6 +0,0 @@
-(setq package-user-dir
- (expand-file-name
- (format "~/.elpa/%s/elpa"
- (concat emacs-version (when (getenv "MELPA_STABLE")
"-stable")))))
-(package-initialize)
-(add-to-list 'load-path default-directory)
diff --git a/swiper.el b/swiper.el
deleted file mode 100644
index 654dc31..0000000
--- a/swiper.el
+++ /dev/null
@@ -1,1673 +0,0 @@
-;;; swiper.el --- Isearch with an overview. Oh, man! -*- lexical-binding: t -*-
-
-;; Copyright (C) 2015-2018 Free Software Foundation, Inc.
-
-;; Author: Oleh Krehel <ohwoeowho@gmail.com>
-;; URL: https://github.com/abo-abo/swiper
-;; Version: 0.12.0
-;; Package-Requires: ((emacs "24.1") (ivy "0.12.0"))
-;; Keywords: matching
-
-;; This file is part of GNU Emacs.
-
-;; This file is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; For a full copy of the GNU General Public License
-;; see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This package gives an overview of the current regex search
-;; candidates. The search regex can be split into groups with a
-;; space. Each group is highlighted with a different face.
-;;
-;; It can double as a quick `regex-builder', although only single
-;; lines will be matched.
-
-;;; Code:
-
-(require 'ivy)
-
-(defgroup swiper nil
- "`isearch' with an overview."
- :group 'matching
- :prefix "swiper-")
-
-(defface swiper-match-face-1
- '((t (:inherit lazy-highlight)))
- "The background face for `swiper' matches."
- :group 'ivy-faces)
-
-(defface swiper-match-face-2
- '((t (:inherit isearch)))
- "Face for `swiper' matches modulo 1."
- :group 'ivy-faces)
-
-(defface swiper-match-face-3
- '((t (:inherit match)))
- "Face for `swiper' matches modulo 2."
- :group 'ivy-faces)
-
-(defface swiper-match-face-4
- '((t (:inherit isearch-fail)))
- "Face for `swiper' matches modulo 3."
- :group 'ivy-faces)
-
-(defface swiper-background-match-face-1
- '((t (:inherit swiper-match-face-1)))
- "The background face for non-current `swiper' matches."
- :group 'ivy-faces)
-
-(defface swiper-background-match-face-2
- '((t (:inherit swiper-match-face-2)))
- "Face for non-current `swiper' matches modulo 1."
- :group 'ivy-faces)
-
-(defface swiper-background-match-face-3
- '((t (:inherit swiper-match-face-3)))
- "Face for non-current `swiper' matches modulo 2."
- :group 'ivy-faces)
-
-(defface swiper-background-match-face-4
- '((t (:inherit swiper-match-face-4)))
- "Face for non-current `swiper' matches modulo 3."
- :group 'ivy-faces)
-
-(defface swiper-line-face
- '((t (:inherit highlight)))
- "Face for current `swiper' line."
- :group 'ivy-faces)
-
-(defcustom swiper-faces '(swiper-match-face-1
- swiper-match-face-2
- swiper-match-face-3
- swiper-match-face-4)
- "List of `swiper' faces for group matches."
- :group 'ivy-faces
- :type '(repeat face))
-
-(defvar swiper-background-faces
- '(swiper-background-match-face-1
- swiper-background-match-face-2
- swiper-background-match-face-3
- swiper-background-match-face-4)
- "Like `swiper-faces', but used for all matches except the current one.")
-
-(defun swiper--recompute-background-faces ()
- (let ((faces '(swiper-background-match-face-1
- swiper-background-match-face-2
- swiper-background-match-face-3
- swiper-background-match-face-4))
- (colir-compose-method #'colir-compose-soft-light))
- (cl-mapc (lambda (f1 f2)
- (let ((bg (face-background f1)))
- (when bg
- (set-face-background
- f2
- (colir-blend
- (colir-color-parse bg)
- (colir-color-parse "#ffffff"))))))
- swiper-faces
- faces)))
-(swiper--recompute-background-faces)
-
-(defcustom swiper-min-highlight 2
- "Only highlight matches for regexps at least this long."
- :type 'integer)
-
-(defcustom swiper-include-line-number-in-search nil
- "Include line number in text of search candidates."
- :type 'boolean
- :group 'swiper)
-
-(defcustom swiper-goto-start-of-match nil
- "When non-nil, go to the start of the match, not its end.
-Treated as non-nil when searching backwards."
- :type 'boolean
- :group 'swiper)
-
-(defvar swiper-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "M-q") 'swiper-query-replace)
- (define-key map (kbd "C-l") 'swiper-recenter-top-bottom)
- (define-key map (kbd "C-'") 'swiper-avy)
- (define-key map (kbd "C-7") 'swiper-mc)
- (define-key map (kbd "C-c C-f") 'swiper-toggle-face-matching)
- map)
- "Keymap for swiper.")
-
-(defvar swiper--query-replace-overlays nil)
-
-(defun swiper--query-replace-updatefn ()
- (let ((lisp (ignore-errors (nth 2 (query-replace-compile-replacement
ivy-text t)))))
- (dolist (ov swiper--query-replace-overlays)
- (when lisp
- (dolist (x (overlay-get ov 'matches))
- (setq lisp (cl-subst (cadr x) (car x) lisp :test #'equal)))
- (setq lisp (ignore-errors (eval lisp))))
- (overlay-put
- ov 'after-string
- (propertize
- (if (stringp lisp)
- lisp
- ivy-text)
- 'face 'error)))))
-
-(defun swiper--query-replace-cleanup ()
- (while swiper--query-replace-overlays
- (delete-overlay (pop swiper--query-replace-overlays))))
-
-(defun swiper--query-replace-setup ()
- (with-ivy-window
- (let ((end (window-end (selected-window) t))
- (re (ivy--regex ivy-text)))
- (save-excursion
- (beginning-of-line)
- (while (and (re-search-forward re end t)
- (not (eobp)))
- (let ((ov (make-overlay (1- (match-end 0)) (match-end 0)))
- (md (match-data)))
- (overlay-put
- ov 'matches
- (mapcar
- (lambda (x)
- (list `(match-string ,x) (match-string x)))
- (number-sequence 0 (1- (/ (length md) 2)))))
- (push ov swiper--query-replace-overlays))
- (unless (> (match-end 0) (match-beginning 0))
- (forward-char)))))))
-
-(defun swiper-query-replace ()
- "Start `query-replace' with string to replace from last search string."
- (interactive)
- (cond ((null (window-minibuffer-p))
- (user-error "Should only be called in the minibuffer through
`swiper-map'"))
- ((string= "" ivy-text)
- (user-error "Empty input"))
- (t
- (swiper--query-replace-setup)
- (unwind-protect
- (let* ((enable-recursive-minibuffers t)
- (from (ivy--regex ivy-text))
- (default
- (format "\\,(concat %s)"
- (if (<= ivy--subexps 1)
- "\\&"
- (mapconcat (lambda (i) (format "\\%d" i))
- (number-sequence 1 ivy--subexps)
- " \" \" "))))
- (to
- (query-replace-compile-replacement
- (ivy-read
- (format "Query replace %s with: " from) nil
- :def default
- :caller 'swiper-query-replace)
- t)))
- (swiper--cleanup)
- (ivy-exit-with-action
- (lambda (_)
- (with-ivy-window
- (move-beginning-of-line 1)
- (let ((inhibit-read-only t))
- (perform-replace from to
- t t nil))))))
- (swiper--query-replace-cleanup)))))
-
-(ivy-configure 'swiper-query-replace
- :update-fn #'swiper--query-replace-updatefn)
-
-(defvar inhibit-message)
-
-(defun swiper-all-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 `swiper-all-map'")
- (let* ((enable-recursive-minibuffers t)
- (from (ivy--regex ivy-text))
- (to (query-replace-read-to from "Query replace" t)))
- (swiper--cleanup)
- (ivy-exit-with-action
- (lambda (_)
- (let ((wnd-conf (current-window-configuration))
- (inhibit-message t))
- (unwind-protect
- (dolist (cand ivy--old-cands)
- (let ((buffer (get-text-property 0 'buffer cand)))
- (switch-to-buffer buffer)
- (goto-char (point-min))
- (perform-replace from to t t nil)))
- (set-window-configuration wnd-conf))))))))
-
-(defvar avy-all-windows)
-(defvar avy-style)
-(defvar avy-keys)
-(declare-function avy--overlay-post "ext:avy")
-(declare-function avy-action-goto "ext:avy")
-(declare-function avy-candidate-beg "ext:avy")
-(declare-function avy--done "ext:avy")
-(declare-function avy--make-backgrounds "ext:avy")
-(declare-function avy-window-list "ext:avy")
-(declare-function avy-read "ext:avy")
-(declare-function avy-read-de-bruijn "ext:avy")
-(declare-function avy-tree "ext:avy")
-(declare-function avy-push-mark "ext:avy")
-(declare-function avy--remove-leading-chars "ext:avy")
-
-(defun swiper--avy-candidates ()
- (let* (
- ;; We'll have overlapping overlays, so we sort all the
- ;; overlays in the visible region by their start, and then
- ;; throw out non-Swiper overlays or overlapping Swiper
- ;; overlays.
- (visible-overlays (cl-sort (with-ivy-window
- (overlays-in (window-start)
- (window-end)))
- #'< :key #'overlay-start))
- (min-overlay-start 0)
- (overlays-for-avy
- (cl-remove-if-not
- (lambda (ov)
- (when (and (>= (overlay-start ov)
- min-overlay-start)
- (memq (overlay-get ov 'face)
- (append swiper-faces swiper-background-faces)))
- (setq min-overlay-start (overlay-start ov))))
- visible-overlays))
- (offset (if (eq (ivy-state-caller ivy-last) 'swiper) 1 0)))
- (nconc
- (mapcar (lambda (ov)
- (cons (overlay-start ov)
- (overlay-get ov 'window)))
- overlays-for-avy)
- (save-excursion
- (save-restriction
- (narrow-to-region (window-start) (window-end))
- (goto-char (point-min))
- (forward-line)
- (let ((win (selected-window))
- cands)
- (while (not (eobp))
- (push (cons (+ (point) offset) win)
- cands)
- (forward-line))
- cands))))))
-
-(defun swiper--avy-candidate ()
- (let ((candidates (swiper--avy-candidates))
- (avy-all-windows nil))
- (unwind-protect
- (prog2
- (avy--make-backgrounds
- (append (avy-window-list)
- (list (ivy-state-window ivy-last))))
- (if (eq avy-style 'de-bruijn)
- (avy-read-de-bruijn candidates avy-keys)
- (avy-read (avy-tree candidates avy-keys)
- #'avy--overlay-post
- #'avy--remove-leading-chars))
- (avy-push-mark))
- (avy--done))))
-
-(defun swiper--avy-goto (candidate)
- (cond ((let ((win (cdr-safe candidate)))
- (and win (window-minibuffer-p win)))
- (let ((nlines (count-lines (point-min) (point-max))))
- (ivy-set-index
- (+ (car (ivy--minibuffer-index-bounds
- ivy--index ivy--length ivy-height))
- (line-number-at-pos (car candidate))
- (if (or (= nlines (1+ ivy-height))
- (< ivy--length ivy-height))
- 0
- (- ivy-height nlines))
- -2)))
- (ivy--exhibit)
- (ivy-done)
- (ivy-call))
- ((or (consp candidate)
- (number-or-marker-p candidate))
- (ivy-quit-and-run
- (avy-action-goto (avy-candidate-beg candidate))))))
-
-;;;###autoload
-(defun swiper-avy ()
- "Jump to one of the current swiper candidates."
- (interactive)
- (unless (require 'avy nil 'noerror)
- (error "Package avy isn't installed"))
- (cl-case (length ivy-text)
- (0
- (user-error "Need at least one char of input"))
- (1
- (let ((swiper-min-highlight 1))
- (swiper--update-input-ivy))))
- (swiper--avy-goto (swiper--avy-candidate)))
-
-(declare-function mc/create-fake-cursor-at-point "ext:multiple-cursors-core")
-(declare-function multiple-cursors-mode "ext:multiple-cursors-core")
-
-(defun swiper-mc ()
- "Create a fake cursor for each `swiper' candidate.
-Make sure `swiper-mc' is on `mc/cmds-to-run-once' list."
- (interactive)
- (unless (require 'multiple-cursors nil t)
- (error "Multiple-cursors isn't installed"))
- (unless (window-minibuffer-p)
- (error "Call me only from `swiper'"))
- (let ((cands (nreverse ivy--old-cands))
- (action (ivy--get-action ivy-last)))
- (unless (string= ivy-text "")
- (ivy-exit-with-action
- (lambda (_)
- (let (cand)
- (while (setq cand (pop cands))
- (funcall action cand)
- (when cands
- (mc/create-fake-cursor-at-point))))
- (multiple-cursors-mode 1))))))
-
-(defvar swiper--current-window-start nil
- "Store `window-start' to restore it later.
-This prevents a \"jumping\" behavior which occurs when variables
-such as `scroll-conservatively' are set to a high value.")
-
-(defun swiper-recenter-top-bottom (&optional arg)
- "Call (`recenter-top-bottom' ARG)."
- (interactive "P")
- (with-ivy-window
- (recenter-top-bottom arg)
- (setq swiper--current-window-start (window-start))))
-
-(defvar swiper-font-lock-exclude
- '(Man-mode
- adoc-mode
- bbdb-mode
- bongo-library-mode
- bongo-mode
- bongo-playlist-mode
- bookmark-bmenu-mode
- circe-channel-mode
- circe-query-mode
- circe-server-mode
- deadgrep-mode
- debbugs-gnu-mode
- dired-mode
- elfeed-search-mode
- elfeed-show-mode
- emms-playlist-mode
- emms-stream-mode
- erc-mode
- eshell-mode
- eww-mode
- forth-block-mode
- forth-mode
- fundamental-mode
- gnus-article-mode
- gnus-group-mode
- gnus-summary-mode
- help-mode
- helpful-mode
- jabber-chat-mode
- magit-popup-mode
- matrix-client-mode
- matrix-client-room-list-mode
- mu4e-headers-mode
- mu4e-view-mode
- nix-mode
- notmuch-search-mode
- notmuch-tree-mode
- occur-edit-mode
- occur-mode
- org-agenda-mode
- package-menu-mode
- rcirc-mode
- sauron-mode
- treemacs-mode
- twittering-mode
- vc-dir-mode
- w3m-mode
- woman-mode
- xref--xref-buffer-mode)
- "List of major-modes that are incompatible with `font-lock-ensure'.")
-
-(defun swiper-font-lock-ensure-p ()
- "Return non-nil if we should `font-lock-ensure'."
- (or (derived-mode-p 'magit-mode)
- (bound-and-true-p magit-blame-mode)
- (memq major-mode swiper-font-lock-exclude)
- (not (derived-mode-p 'prog-mode))))
-
-(defun swiper-font-lock-ensure ()
- "Ensure the entire buffer is highlighted."
- (unless (swiper-font-lock-ensure-p)
- (unless (or (> (buffer-size) 100000) (null font-lock-mode))
- (if (fboundp 'font-lock-ensure)
- (font-lock-ensure)
- (with-no-warnings (font-lock-fontify-buffer))))))
-
-(defvar swiper--format-spec ""
- "Store the current candidates format spec.")
-
-(defvar swiper--width nil
- "Store the number of digits needed for the longest line number.")
-
-(defvar swiper-use-visual-line nil
- "When non-nil, use `line-move' instead of `forward-line'.")
-
-(defvar dired-isearch-filenames)
-(declare-function dired-move-to-filename "dired")
-
-(defun swiper--line ()
- (let* ((beg (cond ((and (eq major-mode 'dired-mode)
- (bound-and-true-p dired-isearch-filenames))
- (dired-move-to-filename)
- (point))
- (swiper-use-visual-line
- (save-excursion
- (beginning-of-visual-line)
- (point)))
- (t
- (point))))
- (end (if swiper-use-visual-line
- (save-excursion
- (end-of-visual-line)
- (point))
- (line-end-position))))
-
- (concat
- " "
- (buffer-substring beg end))))
-
-(declare-function outline-show-all "outline")
-
-(defvar swiper-use-visual-line-p
- (lambda (n-lines)
- (and visual-line-mode
- ;; super-slow otherwise
- (< (buffer-size) 20000)
- (< n-lines 400)))
- "A predicate that decides whether `line-move' or `forward-line' is used.
-Note that `line-move' can be very slow.")
-
-(defun swiper--candidates (&optional numbers-width)
- "Return a list of this buffer lines.
-
-NUMBERS-WIDTH, when specified, is used for width spec of line
-numbers; replaces calculating the width from buffer line count."
- (let* ((inhibit-field-text-motion t)
- (n-lines (count-lines (point-min) (point-max))))
- (if (funcall swiper-use-visual-line-p n-lines)
- (progn
- (when (eq major-mode 'org-mode)
- (require 'outline)
- (if (fboundp 'outline-show-all)
- (outline-show-all)
- (with-no-warnings
- (show-all))))
- (setq swiper-use-visual-line t))
- (setq swiper-use-visual-line nil))
- (unless (zerop n-lines)
- (setq swiper--width (or numbers-width
- (1+ (floor (log n-lines 10)))))
- (setq swiper--format-spec
- (format "%%-%dd " swiper--width))
- (let ((line-number 1)
- (advancer (if swiper-use-visual-line
- (lambda (arg) (line-move arg t))
- #'forward-line))
- candidates)
- (save-excursion
- (goto-char (point-min))
- (swiper-font-lock-ensure)
- (while (< (point) (point-max))
- (when (swiper-match-usable-p)
- (let ((str (swiper--line)))
- (setq str (ivy-cleanup-string str))
- (let ((line-number-str
- (format swiper--format-spec line-number)))
- (if swiper-include-line-number-in-search
- (setq str (concat line-number-str str))
- (put-text-property
- 0 1 'display line-number-str str))
- (put-text-property
- 0 1 'swiper-line-number line-number str))
- (push str candidates)))
- (funcall advancer 1)
- (cl-incf line-number))
- (nreverse candidates))))))
-
-(defvar swiper--opoint 1
- "The point when `swiper' starts.")
-
-;;;###autoload
-(defun swiper-backward (&optional initial-input)
- "`isearch-backward' with an overview.
-When non-nil, INITIAL-INPUT is the initial search pattern."
- (interactive)
- (let ((ivy-index-functions-alist
- '((swiper . ivy-recompute-index-swiper-backward))))
- (swiper initial-input)))
-
-;;;###autoload
-(defun swiper-thing-at-point ()
- "`swiper' with `ivy-thing-at-point'."
- (interactive)
- (let ((thing (ivy-thing-at-point)))
- (when (use-region-p)
- (deactivate-mark))
- (swiper thing)))
-
-;;;###autoload
-(defun swiper-all-thing-at-point ()
- "`swiper-all' with `ivy-thing-at-point'."
- (interactive)
- (let ((thing (ivy-thing-at-point)))
- (when (use-region-p)
- (deactivate-mark))
- (swiper-all thing)))
-
-(defun swiper--extract-matches (regex cands)
- "Extract captured REGEX groups from CANDS."
- (let (res)
- (dolist (cand cands)
- (setq cand (substring cand 1))
- (when (string-match regex cand)
- (push (mapconcat (lambda (n) (match-string-no-properties n cand))
- (number-sequence
- 1
- (/ (- (length (match-data)) 2) 2))
- " ")
- res)))
- (nreverse res)))
-
-(defun swiper--occur-cands (fname cands)
- (when cands
- (with-current-buffer (ivy-state-buffer ivy-last)
- (when (eq (ivy-state-caller ivy-last) 'swiper-isearch)
- (setq cands (mapcar #'swiper--line-at-point cands)))
- (let* ((pt-min (point-min))
- (line-delta
- (save-restriction
- (widen)
- (1- (line-number-at-pos pt-min))))
- (lines
- (if (eq (ivy-state-caller ivy-last) 'swiper-isearch)
- (swiper--isearch-occur-cands cands)
- (mapcar (lambda (s)
- (let ((n (get-text-property 0 'swiper-line-number
s)))
- (setq s (substring s 1))
- (add-text-properties 0 1 (list 'swiper-line-number
n) s)
- (cons n s)))
- cands)))
- (offset (+ (length fname) 2)))
- (mapcar (lambda (x)
- (let ((nn (number-to-string
- (+ (car x) line-delta))))
- (remove-text-properties 0 1 '(display) (cdr x))
- (put-text-property 0 (length nn) 'face
'ivy-grep-line-number nn)
- (put-text-property 0 1 'offset (+ offset (length nn))
fname)
- (format "%s:%s:%s" fname nn (cdr x))))
- lines)))))
-
-(defun swiper--isearch-occur-cands (cands)
- (let* ((last-pt (get-text-property 0 'point (car cands)))
- (line (1+ (line-number-at-pos last-pt)))
- res pt)
- (dolist (cand cands)
- (setq pt (get-text-property 0 'point cand))
- (cl-incf line (1- (count-lines last-pt pt)))
- (push (cons line cand) res)
- (setq last-pt pt))
- (nreverse res)))
-
-(defun swiper--occur-insert-lines (cands)
- (let ((inhibit-read-only 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 cands)
- (goto-char (point-min))
- (forward-line 4)))
-
-(defun swiper--occur-buffer ()
- (let ((buffer (ivy-state-buffer ivy-last)))
- (unless (buffer-live-p buffer)
- (setq buffer
- (setf (ivy-state-buffer ivy-last)
- (find-file-noselect
- (plist-get (ivy-state-extra-props ivy-last) :fname))))
- (save-selected-window
- (pop-to-buffer buffer))
- (setf (ivy-state-window ivy-last) (selected-window)))
- buffer))
-
-(defun swiper-occur (&optional cands)
- "Generate a custom occur buffer for `swiper'.
-When capture groups are present in the input, print them instead of lines."
- (let* ((buffer (swiper--occur-buffer))
- (fname (propertize
- (with-ivy-window
- (if (buffer-file-name buffer)
- (file-name-nondirectory
- (buffer-file-name buffer))
- (buffer-name buffer)))
- 'face
- 'ivy-grep-info))
- (ivy-text (progn (string-match "\"\\(.*\\)\"" (buffer-name))
- (match-string 1 (buffer-name))))
- (re (mapconcat #'identity (ivy--split ivy-text) ".*?"))
- (cands
- (swiper--occur-cands
- fname
- (or cands
- (save-window-excursion
- (setq ivy--old-re nil)
- (switch-to-buffer buffer)
- (if (eq (ivy-state-caller ivy-last) 'swiper)
- (let ((ivy--regex-function 'swiper--re-builder))
- (ivy--filter re (swiper--candidates)))
- (swiper-isearch-function ivy-text)))))))
- (if (string-match-p "\\\\(" re)
- (insert
- (mapconcat #'identity
- (swiper--extract-matches
- re (with-current-buffer buffer
- (swiper--candidates)))
- "\n"))
- (unless (eq major-mode 'ivy-occur-grep-mode)
- (ivy-occur-grep-mode)
- (font-lock-mode -1))
- (swiper--occur-insert-lines
- (mapcar (lambda (cand) (concat "./" cand)) cands)))))
-
-(declare-function evil-set-jump "ext:evil-jumps")
-
-(defvar swiper--current-line nil)
-(defvar swiper--current-match-start nil)
-(defvar swiper--point-min nil)
-(defvar swiper--point-max nil)
-(defvar swiper--reveal-mode nil)
-
-(defun swiper--init ()
- "Perform initialization common to both completion methods."
- (setq swiper--current-line nil)
- (setq swiper--current-match-start nil)
- (setq swiper--current-window-start nil)
- (setq swiper--opoint (point))
- (setq swiper--point-min (point-min))
- (setq swiper--point-max (point-max))
- (when (setq swiper--reveal-mode
- (bound-and-true-p reveal-mode))
- (reveal-mode -1))
- (lazy-highlight-cleanup t)
- (setq isearch-opened-overlays nil)
- (when (bound-and-true-p evil-mode)
- (evil-set-jump)))
-
-(declare-function char-fold-to-regexp "char-fold")
-
-(defun swiper--re-builder (str)
- "Transform STR into a swiper regex.
-This is the regex used in the minibuffer where candidates have
-line numbers. For the buffer, use `ivy--regex' instead."
- (let* ((re-builder (ivy-alist-setting ivy-re-builders-alist))
- (re (cond
- ((equal str "")
- "")
- ((equal str "^")
- (setq ivy--subexps 0)
- ".")
- ((= (aref str 0) ?^)
- (let* ((re (funcall re-builder (substring str 1)))
- (re (if (listp re)
- (mapconcat (lambda (x)
- (format "\\(%s\\)" (car x)))
- (cl-remove-if-not #'cdr re)
- ".*?")
- re)))
- (cond
- ((string= re "$")
- "^$")
- ((zerop ivy--subexps)
- (prog1 (format "^ ?\\(%s\\)" re)
- (setq ivy--subexps 1)))
- (t
- (format "^ %s" re)))))
- ((eq (bound-and-true-p search-default-mode)
'char-fold-to-regexp)
- (if (string-match "\\`\\\\_<\\(.+\\)\\\\_>\\'" str)
- (concat
- "\\_<"
- (char-fold-to-regexp (match-string 1 str))
- "\\_>")
- (let ((subs (ivy--split str)))
- (setq ivy--subexps (length subs))
- (mapconcat
- (lambda (s) (format "\\(%s\\)" (char-fold-to-regexp s)))
- subs
- ".*?"))))
- (t
- (funcall re-builder str)))))
- re))
-
-(defvar swiper-history nil
- "History for `swiper'.")
-
-(defvar swiper-invocation-face nil
- "The face at the point of invocation of `swiper'.")
-
-(defcustom swiper-stay-on-quit nil
- "When non-nil don't go back to search start on abort."
- :type 'boolean)
-
-;;;###autoload
-(defun swiper (&optional initial-input)
- "`isearch-forward' with an overview.
-When non-nil, INITIAL-INPUT is the initial search pattern."
- (interactive)
- (let ((candidates (swiper--candidates)))
- (swiper--init)
- (setq swiper-invocation-face
- (plist-get (text-properties-at (point)) 'face))
- (let ((preselect
- (if (or swiper-use-visual-line (null search-invisible))
- (count-screen-lines
- (point-min)
- (save-excursion (beginning-of-visual-line) (point)))
- (1- (line-number-at-pos))))
- (minibuffer-allow-text-properties t)
- res)
- (unwind-protect
- (and
- (setq res
- (ivy-read
- "Swiper: "
- candidates
- :initial-input initial-input
- :keymap swiper-map
- :preselect
- (if initial-input
- (cl-position-if
- (lambda (x)
- (= (1+ preselect) (get-text-property 0
'swiper-line-number x)))
- (progn
- (setq ivy--old-re nil)
- (ivy--filter initial-input candidates)))
- preselect)
- :require-match t
- :action #'swiper--action
- :re-builder #'swiper--re-builder
- :history 'swiper-history
- :extra-props (list :fname (buffer-file-name))
- :caller 'swiper))
- (point))
- (unless (or res swiper-stay-on-quit)
- (goto-char swiper--opoint))
- (unless (or res (string= ivy-text ""))
- (cl-pushnew ivy-text swiper-history))
- (setq swiper--current-window-start nil)
- (when swiper--reveal-mode
- (reveal-mode 1))))))
-
-(ivy-configure 'swiper
- :occur #'swiper-occur
- :update-fn #'swiper--update-input-ivy
- :unwind-fn #'swiper--cleanup
- :index-fn #'ivy-recompute-index-swiper)
-
-(defun swiper-toggle-face-matching ()
- "Toggle matching only the candidates with `swiper-invocation-face'."
- (interactive)
- (setf (ivy-state-matcher ivy-last)
- (if (ivy-state-matcher ivy-last)
- nil
- #'swiper--face-matcher))
- (setq ivy--old-re nil))
-
-(defun swiper--face-matcher (regexp candidates)
- "Return REGEXP matching CANDIDATES.
-Matched candidates should have `swiper-invocation-face'."
- (cl-remove-if-not
- (lambda (x)
- (and (string-match regexp x)
- (let* ((s (match-string 0 x))
- (n (length s))
- (i 0))
- (while (and (< i n)
- (text-property-any
- i (1+ i)
- 'face swiper-invocation-face
- s))
- (cl-incf i))
- (= i n))))
- candidates))
-
-(defun swiper--ensure-visible ()
- "Remove overlays hiding point."
- (let ((overlays (overlays-at (1- (point))))
- ov expose)
- (while (setq ov (pop overlays))
- (if (and (invisible-p (overlay-get ov 'invisible))
- (setq expose (overlay-get ov 'isearch-open-invisible)))
- (funcall expose ov)))))
-
-(defvar swiper--overlays nil
- "Store overlays.")
-
-(defvar swiper--isearch-highlight-timer nil
- "This timer used by `swiper--delayed-add-overlays'.")
-
-(defun swiper--cleanup ()
- "Clean up the overlays."
- (while swiper--overlays
- (delete-overlay (pop swiper--overlays)))
- ;; force cleanup unless it's :unwind
- (lazy-highlight-cleanup
- (if (eq ivy-exit 'done) lazy-highlight-cleanup t))
- (when (timerp swiper--isearch-highlight-timer)
- (cancel-timer swiper--isearch-highlight-timer)
- (setq swiper--isearch-highlight-timer nil)))
-
-(defun swiper--add-cursor-overlay (wnd)
- (let* ((special (or (eolp) (looking-at "\t")))
- (ov (make-overlay (point) (if special (point) (1+ (point))))))
- (if special
- (overlay-put ov 'after-string (propertize " " 'face 'ivy-cursor))
- (overlay-put ov 'face 'ivy-cursor))
- (overlay-put ov 'window wnd)
- (overlay-put ov 'priority 2)
- (push ov swiper--overlays)))
-
-(defun swiper--add-line-overlay (wnd)
- (let ((beg (if visual-line-mode
- (save-excursion
- (beginning-of-visual-line)
- (point))
- (line-beginning-position)))
- (end (if visual-line-mode
- (save-excursion
- (end-of-visual-line)
- (point))
- (1+ (line-end-position)))))
- (push (swiper--make-overlay beg end 'swiper-line-face wnd 0)
- swiper--overlays)))
-
-(defun swiper--make-overlay (beg end face wnd priority)
- "Create an overlay bound by BEG and END.
-FACE, WND and PRIORITY are properties corresponding to
-the face, window and priority of the overlay."
- (let ((overlay (make-overlay beg end)))
- (overlay-put overlay 'face face)
- (overlay-put overlay 'window wnd)
- (overlay-put overlay 'priority priority)
- overlay))
-
-(defun swiper--recenter-p ()
- (or (display-graphic-p)
- (not recenter-redisplay)))
-
-(defun swiper--positive-regexps (str)
- (let ((regexp-or-regexps
- (funcall ivy--regex-function str)))
- (if (listp regexp-or-regexps)
- (mapcar #'car (cl-remove-if-not #'cdr regexp-or-regexps))
- (list regexp-or-regexps))))
-
-(defun swiper--update-input-ivy ()
- "Called when `ivy' input is updated."
- (with-ivy-window
- (swiper--cleanup)
- (when (> (length (ivy-state-current ivy-last)) 0)
- (let ((regexps (swiper--positive-regexps ivy-text))
- (re-idx -1)
- (case-fold-search (ivy--case-fold-p ivy-text)))
- (dolist (re regexps)
- (setq re-idx (1+ re-idx))
- (let* ((re (replace-regexp-in-string
- " " "\t"
- re))
- (num (get-text-property 0 'swiper-line-number
(ivy-state-current ivy-last))))
- (unless (memq this-command '(ivy-yank-word
- ivy-yank-symbol
- ivy-yank-char
- scroll-other-window))
- (when (cl-plusp num)
- (unless (if swiper--current-line
- (eq swiper--current-line num)
- (eq (line-number-at-pos) num))
- (goto-char swiper--point-min)
- (if swiper-use-visual-line
- (line-move (1- num))
- (forward-line (1- num))))
- (if (and (equal ivy-text "")
- (>= swiper--opoint (line-beginning-position))
- (<= swiper--opoint (line-end-position)))
- (goto-char swiper--opoint)
- (if (eq swiper--current-line num)
- (when swiper--current-match-start
- (goto-char swiper--current-match-start))
- (setq swiper--current-line num))
- (when (re-search-forward re (line-end-position) t)
- (setq swiper--current-match-start (match-beginning 0))))
- (isearch-range-invisible (line-beginning-position)
- (line-end-position))
- (swiper--maybe-recenter)))
- (swiper--add-overlays
- re
- (max
- (if (swiper--recenter-p)
- (window-start)
- (line-beginning-position (- (window-height))))
- swiper--point-min)
- (min
- (if (swiper--recenter-p)
- (window-end (selected-window) t)
- (line-end-position (window-height)))
- swiper--point-max)
- nil
- re-idx)))))))
-
-(defun swiper--add-overlays (re &optional beg end wnd re-idx)
- "Add overlays for RE regexp in visible part of the current buffer.
-BEG and END, when specified, are the point bounds.
-WND, when specified is the window."
- (setq wnd (or wnd (ivy-state-window ivy-last)))
- (swiper--add-line-overlay wnd)
- (let* ((pt (point))
- (wh (window-height))
- (beg (or beg (save-excursion
- (forward-line (- wh))
- (point))))
- (end (or end (save-excursion
- (forward-line wh)
- (point))))
- (case-fold-search (ivy--case-fold-p re)))
- (when (>= (length re) swiper-min-highlight)
- (save-excursion
- (goto-char beg)
- ;; RE can become an invalid regexp
- (while (and (ignore-errors (re-search-forward re end t))
- (> (- (match-end 0) (match-beginning 0)) 0))
- ;; Don't highlight a match if it spans multiple
- ;; lines. `count-lines' returns 1 if the match is within a
- ;; single line, even if it includes the newline, and 2 or
- ;; greater otherwise. We hope that the inclusion of the
- ;; newline will not ever be a problem in practice.
- (when (< (count-lines (match-beginning 0) (match-end 0)) 2)
- (let* ((faces (if (= (match-end 0) pt)
- swiper-faces
- swiper-background-faces))
- (adder-fn (lambda (beg end face priority)
- (push (swiper--make-overlay beg end face wnd
priority)
- isearch-lazy-highlight-overlays))))
- (unless (and (consp ivy--old-re)
- (null
- (save-match-data
- (ivy--re-filter ivy--old-re
- (list
- (buffer-substring-no-properties
- (line-beginning-position)
- (line-end-position)))))))
- (swiper--add-properties faces adder-fn re-idx)))))))))
-
-(defun swiper--add-properties (faces adder-fn &optional re-idx)
- (let ((mb (match-beginning 0))
- (me (match-end 0)))
- (unless (> (- me mb) 2017)
- (funcall adder-fn
- mb me
- (if (zerop ivy--subexps)
- (nth (1+ (mod (or re-idx 0) (1- (length faces)))) faces)
- (car faces))
- 0)))
- (let ((i 1)
- (j 0))
- (while (<= (cl-incf j) ivy--subexps)
- (let ((bm (match-beginning j))
- (em (match-end j)))
- (when (and (integerp em)
- (integerp bm))
- (while (and (< j ivy--subexps)
- (integerp (match-beginning (+ j 1)))
- (= em (match-beginning (+ j 1))))
- (setq em (match-end (cl-incf j))))
- (funcall adder-fn
- bm em
- (nth (1+ (mod (+ i 2) (1- (length faces))))
- faces)
- i)
- (cl-incf i))))))
-
-(defcustom swiper-action-recenter nil
- "When non-nil, recenter after exiting `swiper'."
- :type 'boolean)
-(defvar evil-search-module)
-(defvar evil-ex-search-pattern)
-(defvar evil-ex-search-persistent-highlight)
-(defvar evil-ex-search-direction)
-(declare-function evil-ex-search-activate-highlight "evil-ex")
-
-(defun swiper--maybe-recenter ()
- (cond (swiper-action-recenter
- (recenter))
- ((swiper--recenter-p)
- (when swiper--current-window-start
- (set-window-start (selected-window) swiper--current-window-start))
- (when (or
- (< (point) (window-start))
- (> (point) (window-end (ivy-state-window ivy-last) t)))
- (recenter))))
- (setq swiper--current-window-start (window-start)))
-
-(defun swiper--action (x)
- "Goto line X."
- (let ((ln (1- (get-text-property 0 'swiper-line-number x)))
- (re (ivy--regex ivy-text))
- (case-fold-search (ivy--case-fold-p ivy-text)))
- (if (null x)
- (user-error "No candidates")
- (with-ivy-window
- (unless (equal (current-buffer)
- (ivy-state-buffer ivy-last))
- (switch-to-buffer (ivy-state-buffer ivy-last)))
- (goto-char
- (if (buffer-narrowed-p)
- swiper--point-min
- (point-min)))
- (funcall (if swiper-use-visual-line
- #'line-move
- #'forward-line)
- ln)
- (when (and (re-search-forward re (line-end-position) t)
swiper-goto-start-of-match)
- (goto-char (match-beginning 0)))
- (swiper--ensure-visible)
- (swiper--maybe-recenter)
- (when (/= (point) swiper--opoint)
- (unless (and transient-mark-mode mark-active)
- (when (eq ivy-exit 'done)
- (push-mark swiper--opoint t)
- (message "Mark saved where search started"))))
- (add-to-history
- 'regexp-search-ring
- re
- regexp-search-ring-max)
- ;; integration with evil-mode's search
- (when (bound-and-true-p evil-mode)
- (when (eq evil-search-module 'isearch)
- (setq isearch-string ivy-text))
- (when (eq evil-search-module 'evil-search)
- (add-to-history 'evil-ex-search-history re)
- (setq evil-ex-search-pattern (list re t t))
- (setq evil-ex-search-direction 'forward)
- (when evil-ex-search-persistent-highlight
- (evil-ex-search-activate-highlight evil-ex-search-pattern))))))))
-
-(defun swiper-from-isearch ()
- "Invoke `swiper' from isearch."
- (interactive)
- (let ((query (if isearch-regexp
- isearch-string
- (regexp-quote isearch-string))))
- (isearch-exit)
- (swiper query)))
-
-(defvar swiper-multi-buffers nil
- "Store the current list of buffers.")
-
-(defvar swiper-multi-candidates nil
- "Store the list of candidates for `swiper-multi'.")
-
-(defun swiper-multi-prompt ()
- "Return prompt for `swiper-multi'."
- (format "Buffers (%s): "
- (mapconcat #'identity swiper-multi-buffers ", ")))
-
-(defvar swiper-window-width 80)
-
-(defun swiper-multi ()
- "Select one or more buffers.
-Run `swiper' for those buffers."
- (interactive)
- (setq swiper-multi-buffers nil)
- (let ((ivy-use-virtual-buffers nil))
- (ivy-read (swiper-multi-prompt)
- #'internal-complete-buffer
- :action #'swiper-multi-action-1))
- (let ((swiper-window-width (- (- (frame-width) (if (display-graphic-p) 0 1))
4)))
- (ivy-read "Swiper: " swiper-multi-candidates
- :action #'swiper-multi-action-2
- :caller 'swiper-multi)))
-
-(ivy-configure 'swiper-multi
- :unwind-fn #'swiper--cleanup
- :index-fn #'ivy-recompute-index-swiper
- :format-fn #'swiper--all-format-function)
-
-(defun swiper-multi-action-1 (x)
- "Add X to list of selected buffers `swiper-multi-buffers'.
-If X is already part of the list, remove it instead. Quit the selection if
-X is selected by either `ivy-done', `ivy-alt-done' or `ivy-immediate-done',
-otherwise continue prompting for buffers."
- (if (member x swiper-multi-buffers)
- (progn
- (setq swiper-multi-buffers (delete x swiper-multi-buffers)))
- (unless (equal x "")
- (setq swiper-multi-buffers (append swiper-multi-buffers (list x)))))
- (let ((prompt (swiper-multi-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))
- (setq swiper-multi-candidates
- (swiper--multi-candidates
- (mapcar #'get-buffer swiper-multi-buffers))))
- ((eq this-command 'ivy-call)
- (with-selected-window (active-minibuffer-window)
- (delete-minibuffer-contents)))))
-
-(defun swiper-multi-action-2 (x)
- "Move to candidate X from `swiper-multi'."
- (when (> (length x) 0)
- (let ((buffer-name (get-text-property 0 'buffer x)))
- (when buffer-name
- (with-ivy-window
- (switch-to-buffer buffer-name)
- (goto-char (point-min))
- (forward-line (1- (get-text-property 0 'swiper-line-number x)))
- (re-search-forward
- (ivy--regex ivy-text)
- (line-end-position) t)
- (isearch-range-invisible (line-beginning-position)
- (line-end-position))
- (unless (eq ivy-exit 'done)
- (swiper--cleanup)
- (swiper--add-overlays (ivy--regex ivy-text))))))))
-
-(defun swiper-all-buffer-p (buffer)
- "Return non-nil if BUFFER should be considered by `swiper-all'."
- (let ((mode (buffer-local-value 'major-mode (get-buffer buffer))))
- (cond
- ;; Ignore TAGS buffers, they tend to add duplicate results.
- ((eq mode #'tags-table-mode) nil)
- ;; Always consider dired buffers, even though they're not backed
- ;; by a file.
- ((eq mode #'dired-mode) t)
- ;; Always consider stash buffers too, as they may have
- ;; interesting content not present in any buffers. We don't #'
- ;; quote to satisfy the byte-compiler.
- ((eq mode 'magit-stash-mode) t)
- ;; Email buffers have no file, but are useful to search
- ((eq mode 'gnus-article-mode) t)
- ;; Otherwise, only consider the file if it's backed by a file.
- (t (buffer-file-name buffer)))))
-
-;;* `swiper-all'
-(defun swiper-all-function (str)
- "Search in all open buffers for STR."
- (or
- (ivy-more-chars)
- (let* ((buffers (cl-remove-if-not #'swiper-all-buffer-p (buffer-list)))
- (re-full (funcall ivy--regex-function str))
- re re-tail
- cands match
- (case-fold-search (ivy--case-fold-p str)))
- (setq re (ivy-re-to-str re-full))
- (when (consp re-full)
- (setq re-tail (cdr re-full)))
- (dolist (buffer buffers)
- (with-current-buffer buffer
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward re nil t)
- (setq match (if (memq major-mode '(org-mode dired-mode))
- (buffer-substring-no-properties
- (line-beginning-position)
- (line-end-position))
- (buffer-substring
- (line-beginning-position)
- (line-end-position))))
- (put-text-property
- 0 1 'buffer
- (buffer-name)
- match)
- (put-text-property 0 1 'point (point) match)
- (when (or (null re-tail) (ivy-re-match re-tail match))
- (push match cands))))))
- (setq ivy--old-re re-full)
- (if (null cands)
- (list "")
- (setq ivy--old-cands (nreverse cands))))))
-
-(defun swiper--all-format-function (cands)
- "Format CANDS for `swiper-all'.
-See `ivy-format-functions-alist' for further information."
- (let* ((ww swiper-window-width)
- (col2 1)
- (cands-with-buffer
- (mapcar (lambda (s)
- (let ((buffer (get-text-property 0 'buffer s)))
- (setq col2 (max col2 (length buffer)))
- (cons s buffer))) cands))
- (col1 (- ww 4 col2)))
- (setq cands
- (mapcar (lambda (x)
- (if (cdr x)
- (let ((s (ivy--truncate-string (car x) col1)))
- (concat
- s
- (make-string
- (max 0
- (- ww (string-width s) (length (cdr x))))
- ?\ )
- (cdr x)))
- (car x)))
- cands-with-buffer))
- (ivy--format-function-generic
- (lambda (str)
- (ivy--add-face str 'ivy-current-match))
- (lambda (str)
- str)
- cands
- "\n")))
-
-(defvar swiper-all-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "M-q") 'swiper-all-query-replace)
- map)
- "Keymap for `swiper-all'.")
-
-;;;###autoload
-(defun swiper-all (&optional initial-input)
- "Run `swiper' for all open buffers."
- (interactive)
- (let ((swiper-window-width (- (frame-width) (if (display-graphic-p) 0 1))))
- (ivy-read "swiper-all: " 'swiper-all-function
- :action #'swiper-all-action
- :dynamic-collection t
- :keymap swiper-all-map
- :initial-input initial-input
- :caller 'swiper-all)))
-
-(ivy-configure 'swiper-all
- :update-fn 'auto
- :unwind-fn #'swiper--cleanup
- :format-fn #'swiper--all-format-function)
-
-(defun swiper-all-action (x)
- "Move to candidate X from `swiper-all'."
- (when (> (length x) 0)
- (let ((buffer-name (get-text-property 0 'buffer x)))
- (when buffer-name
- (with-ivy-window
- (switch-to-buffer buffer-name)
- (goto-char (get-text-property 0 'point x))
- (isearch-range-invisible (line-beginning-position)
- (line-end-position))
- (unless (eq ivy-exit 'done)
- (swiper--cleanup)
- (swiper--add-overlays (ivy--regex ivy-text))))))))
-
-(defun swiper--multi-candidates (buffers)
- "Extract candidates from BUFFERS."
- (let ((res nil))
- (dolist (buf buffers)
- (with-current-buffer buf
- (setq res
- (nconc
- (mapcar
- (lambda (s) (put-text-property 0 1 'buffer (buffer-name) s) s)
- (swiper--candidates 4))
- res))))
- res))
-
-;;* `swiper-isearch'
-(defun swiper-isearch-function (str)
- "Collect STR matches in the current buffer for `swiper-isearch'."
- (with-ivy-window
- (swiper--isearch-function str)))
-
-(defun swiper-match-usable-p ()
- (or search-invisible
- (not (cl-find-if
- (lambda (ov)
- (invisible-p (overlay-get ov 'invisible)))
- (overlays-at (point))))))
-
-(defvar swiper--isearch-backward nil)
-(defvar swiper--isearch-start-point nil)
-
-(defun swiper--isearch-function-1 (re backward)
- (unless (string= re ".")
- (let (cands)
- (save-excursion
- (goto-char (if backward (point-max) (point-min)))
- (while (and (funcall (if backward #'re-search-backward
#'re-search-forward) re nil t)
- (not (if backward (bobp) (eobp))))
- (when (swiper-match-usable-p)
- (let ((pos (if (or backward swiper-goto-start-of-match)
- (match-beginning 0)
- (point))))
- (push pos cands)))
- (when (= (match-beginning 0) (match-end 0))
- (if backward
- (backward-char)
- (forward-char)))))
- (if backward
- cands
- (nreverse cands)))))
-
-(defun swiper--isearch-next-item (re cands)
- (if swiper--isearch-backward
- (or
- (cl-position-if
- (lambda (x)
- (and
- (< x swiper--isearch-start-point)
- (eq 0 (string-match-p
- re
- (buffer-substring-no-properties
- x swiper--isearch-start-point)))))
- cands
- :from-end t)
- 0)
- (or
- (cl-position-if
- (lambda (x) (> x swiper--isearch-start-point))
- cands)
- 0)))
-
-(defun swiper--isearch-filter-ignore-order (re-full cands)
- (let (filtered-cands)
- (dolist (re-cons re-full cands)
- (save-excursion
- (dolist (cand cands)
- (goto-char cand)
- (beginning-of-line)
- (unless (if (re-search-forward (car re-cons) (line-end-position) t)
- (not (cdr re-cons))
- (cdr re-cons))
- (push cand filtered-cands))))
- (setq cands (nreverse filtered-cands))
- (setq filtered-cands nil))))
-
-(defun swiper--isearch-function (str)
- (let ((re-full (funcall ivy--regex-function str)))
- (unless (equal re-full "")
- (let* ((case-fold-search (ivy--case-fold-p str))
- (re
- (if (stringp re-full)
- re-full
- (mapconcat
- #'ivy--regex-or-literal
- (delq nil (mapcar (lambda (x) (and (cdr x) (car x))) re-full))
- "\\|")))
- (cands (swiper--isearch-function-1 re swiper--isearch-backward)))
- (when (consp re-full)
- (setq cands (swiper--isearch-filter-ignore-order re-full cands)))
- (setq ivy--old-re re)
- (ivy-set-index (swiper--isearch-next-item re cands))
- (setq ivy--old-cands cands)))))
-
-(defcustom swiper-isearch-highlight-delay '(2 0.2)
- "When `ivy-text' is too short, delay showing the overlay.
-
-The default value will delay showing the overlay by 0.2 seconds
-if `ivy-text' is shorter than 2 characters.
-
-The aim is to reduce the visual clutter, since it's very rare
-that we search only for one character."
- :type '(list
- (integer :tag "Text length")
- (float :tag "Delay in seconds")))
-
-(defun swiper--delayed-add-overlays ()
- (if (and swiper-isearch-highlight-delay
- (< (length ivy-text) (car swiper-isearch-highlight-delay)))
- (setq swiper--isearch-highlight-timer
- (run-with-idle-timer
- (cadr swiper-isearch-highlight-delay) nil
- (lambda ()
- (with-ivy-window
- (swiper--add-overlays (ivy--regex ivy-text))))))
- (dolist (re (swiper--positive-regexps ivy-text))
- (swiper--add-overlays re))))
-
-(defun swiper-isearch-action (x)
- "Move to X for `swiper-isearch'."
- (if (or (numberp x)
- (and (> (length x) 0)
- (setq x (get-text-property 0 'point x))))
- (with-ivy-window
- (goto-char x)
- (when (and (or (eq this-command 'ivy-previous-line-or-history)
- (and (eq this-command 'ivy-done)
- (eq last-command 'ivy-previous-line-or-history)))
- (looking-back ivy--old-re (line-beginning-position)))
- (goto-char (match-beginning 0)))
- (isearch-range-invisible (point) (1+ (point)))
- (swiper--maybe-recenter)
- (unless (eq ivy-exit 'done)
- (swiper--cleanup)
- (swiper--delayed-add-overlays)
- (swiper--add-cursor-overlay
- (ivy-state-window ivy-last))))
- (swiper--cleanup)))
-
-(defun swiper-action-copy (_x)
- "Copy line at point and go back."
- (kill-new
- (buffer-substring-no-properties
- (line-beginning-position) (line-end-position)))
- (goto-char swiper--opoint))
-
-(ivy-add-actions 'swiper-isearch '(("w" swiper-action-copy "copy")))
-(ivy-add-actions 'swiper '(("w" swiper-action-copy "copy")))
-
-(defun swiper-isearch-thing-at-point ()
- "Insert `symbol-at-point' into the minibuffer of `swiper-isearch'.
-When not running `swiper-isearch' already, start it."
- (interactive)
- (if (window-minibuffer-p)
- (let (bnd str regionp)
- (with-ivy-window
- (setq bnd
- (if (setq regionp (region-active-p))
- (prog1 (cons (region-beginning) (region-end))
- (deactivate-mark))
- (bounds-of-thing-at-point 'symbol)))
- (setq str (buffer-substring-no-properties (car bnd) (cdr bnd))))
- (insert str)
- (unless regionp
- (ivy--insert-symbol-boundaries)))
- (let (thing)
- (if (use-region-p)
- (progn
- (setq thing (buffer-substring-no-properties
- (region-beginning) (region-end)))
- (goto-char (region-beginning))
- (deactivate-mark))
- (let ((bnd (bounds-of-thing-at-point 'symbol)))
- (when bnd
- (goto-char (car bnd)))
- (setq thing (ivy-thing-at-point))))
- (swiper-isearch thing))))
-
-(defvar swiper-isearch-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map swiper-map)
- (define-key map (kbd "M-n") 'swiper-isearch-thing-at-point)
- map)
- "Keymap for `swiper-isearch'.")
-
-(defun swiper--isearch-same-line-p (s1 s2)
- "Check if S1 and S2 are equal and on the same line."
- (and (equal s1 s2)
- (<= (count-lines
- (get-text-property 0 'point s2)
- (get-text-property 0 'point s1))
- 1)))
-
-(defun swiper-isearch-format-function (cands)
- (if (numberp (car-safe cands))
- (if (string= ivy--old-re "^$")
- ""
- (swiper--isearch-format
- ivy--index ivy--length ivy--old-cands
- ivy--old-re
- (ivy-state-current ivy-last)
- (ivy-state-buffer ivy-last)))
- (ivy-format-function-default cands)))
-
-(defun swiper--line-at-point (pt)
- (save-excursion
- (goto-char pt)
- (let ((s (buffer-substring
- (line-beginning-position)
- (line-end-position))))
- (put-text-property 0 1 'point pt s)
- (ivy-cleanup-string s))))
-
-(defun swiper--isearch-highlight (str &optional current)
- (let ((start 0)
- (i 0))
- (while (string-match ivy--old-re str start)
- (setq start (match-end 0))
- (swiper--add-properties
- (if (eq current i)
- swiper-faces
- swiper-background-faces)
- (lambda (beg end face _priority)
- (ivy-add-face-text-property
- beg end face str)))
- (cl-incf i))
- str))
-
-(defun swiper--isearch-format (index length cands regex current buffer)
- (let* ((half-height (/ ivy-height 2))
- (i (1- index))
- (j 0)
- (len 0)
- res s)
- (with-current-buffer buffer
- (while (and (>= i 0)
- (swiper--isearch-same-line-p
- (swiper--line-at-point (nth i cands))
- (swiper--line-at-point current)))
- (cl-decf i)
- (cl-incf j))
- (while (and (>= i 0)
- (< len half-height))
- (setq s (swiper--line-at-point (nth i cands)))
- (unless (swiper--isearch-same-line-p s (car res))
- (push (swiper--isearch-highlight s) res)
- (cl-incf len))
- (cl-decf i))
- (setq res (nreverse res))
- (let ((current-str
- (swiper--line-at-point current))
- (start 0))
- (dotimes (_ (1+ j))
- (string-match regex current-str start)
- (setq start (match-end 0)))
- (swiper--isearch-highlight current-str j)
- (font-lock-append-text-property
- 0 (length current-str)
- 'face 'swiper-line-face current-str)
- (push current-str res))
- (cl-incf len)
- (setq i (1+ index))
- (while (and (< i length)
- (swiper--isearch-same-line-p
- (swiper--line-at-point (nth i cands))
- (swiper--line-at-point current)))
- (cl-incf i))
- (while (and (< i length)
- (< len ivy-height))
- (setq s (swiper--line-at-point (nth i cands)))
- (unless (swiper--isearch-same-line-p s (car res))
- (push (swiper--isearch-highlight s) res)
- (cl-incf len))
- (cl-incf i))
- (mapconcat #'identity (nreverse res) "\n"))))
-
-;;;###autoload
-(defun swiper-isearch (&optional initial-input)
- "A `swiper' that's not line-based."
- (interactive)
- (swiper--init)
- (setq swiper--isearch-start-point (point))
- (swiper-font-lock-ensure)
- (let ((ivy-fixed-height-minibuffer t)
- (cursor-in-non-selected-windows nil)
- (swiper-min-highlight 1)
- res)
- (unwind-protect
- (and
- (setq res
- (ivy-read
- "Swiper: "
- #'swiper-isearch-function
- :initial-input initial-input
- :keymap swiper-isearch-map
- :dynamic-collection t
- :require-match t
- :action #'swiper-isearch-action
- :re-builder #'swiper--re-builder
- :history 'swiper-history
- :extra-props (list :fname (buffer-file-name))
- :caller 'swiper-isearch))
- (point))
- (unless (or res swiper-stay-on-quit)
- (goto-char swiper--opoint))
- (isearch-clean-overlays)
- (swiper--ensure-visible)
- (unless (or res (string= ivy-text ""))
- (cl-pushnew ivy-text swiper-history)))))
-
-(ivy-configure 'swiper-isearch
- :occur #'swiper-occur
- :update-fn 'auto
- :unwind-fn #'swiper--cleanup
- :format-fn #'swiper-isearch-format-function)
-
-;;;###autoload
-(defun swiper-isearch-backward (&optional initial-input)
- "Like `swiper-isearch' but the first result is before the point."
- (interactive)
- (let ((swiper--isearch-backward t))
- (swiper-isearch initial-input)))
-
-(defun swiper-isearch-toggle ()
- "Two-way toggle between `swiper-isearch' and isearch.
-Intended to be bound in `isearch-mode-map' and `swiper-map'."
- (interactive)
- (if isearch-mode
- (let ((query (if isearch-regexp
- isearch-string
- (regexp-quote isearch-string))))
- (isearch-exit)
- (goto-char (or (and isearch-forward isearch-other-end)
- (point)))
- (swiper-isearch query))
- (ivy-exit-with-action
- (lambda (_)
- (when (looking-back ivy--old-re (line-beginning-position))
- (goto-char (match-beginning 0)))
- (isearch-mode t)
- (unless (string= ivy-text "")
- (isearch-yank-string ivy-text))))))
-
-(provide 'swiper)
-
-;;; swiper.el ends here
diff --git a/targets/checkdoc.el b/targets/checkdoc.el
deleted file mode 100644
index 3162d36..0000000
--- a/targets/checkdoc.el
+++ /dev/null
@@ -1,6 +0,0 @@
-(checkdoc-file "colir.el")
-(checkdoc-file "counsel.el")
-(checkdoc-file "ivy-overlay.el")
-(checkdoc-file "ivy-test.el")
-(checkdoc-file "ivy.el")
-(checkdoc-file "swiper.el")
diff --git a/targets/install-deps.el b/targets/install-deps.el
deleted file mode 100644
index 3089fc7..0000000
--- a/targets/install-deps.el
+++ /dev/null
@@ -1,38 +0,0 @@
-(setq melpa-stable (getenv "MELPA_STABLE"))
-(setq package-user-dir
- (expand-file-name
- (format "~/.elpa/%s/elpa"
- (concat emacs-version (when melpa-stable "-stable")))))
-(message "installing in %s ...\n" package-user-dir)
-(package-initialize)
-(setq package-archives
- (list (if melpa-stable
- '("melpa-stable" . "https://stable.melpa.org/packages/";)
- '("melpa" . "http://melpa.org/packages/";))
- ;; '("gnu" . "http://elpa.gnu.org/packages/";)
- ))
-(package-refresh-contents)
-
-(defconst ivy-dev-packages
- '(avy
- hydra
- wgrep))
-
-(dolist (package ivy-dev-packages)
- (if (package-installed-p package)
- (message "%S: OK" package)
- (condition-case nil
- (progn
- (package-install package)
- (message "%S: ...OK" package))
- (error
- (message "%S: FAIL" package)))))
-
-(save-window-excursion
- (package-list-packages t)
- (condition-case nil
- (progn
- (package-menu-mark-upgrades)
- (package-menu-execute t))
- (error
- (message "All packages up to date"))))
diff --git a/targets/obsolete-config.el b/targets/obsolete-config.el
deleted file mode 100644
index d38c7da..0000000
--- a/targets/obsolete-config.el
+++ /dev/null
@@ -1,3 +0,0 @@
-(add-to-list 'load-path default-directory)
-(require 'counsel)
-(byte-compile-file (expand-file-name "targets/obsolete-config.el"))
diff --git a/targets/plain.el b/targets/plain.el
deleted file mode 100644
index 140db3e..0000000
--- a/targets/plain.el
+++ /dev/null
@@ -1,9 +0,0 @@
-;; (package-initialize)
-(ivy-mode)
-(counsel-mode)
-(setq enable-recursive-minibuffers t)
-(global-set-key (kbd "C-c C-r") 'ivy-resume)
-(global-set-key (kbd "C-s") 'swiper)
-(global-set-key (kbd "C-c j") 'counsel-git-grep)
-(global-set-key (kbd "C-c k") 'counsel-rg)
-(global-set-key (kbd "C-c s") 'isearch-forward-regexp)