]> code.delx.au - gnu-emacs-elpa/blob - ivy.el
19fc0e9ccfba9a0b8fd2e4ee3b87be1eff5f99db
[gnu-emacs-elpa] / ivy.el
1 ;;; ivy.el --- Incremental Vertical completYon -*- lexical-binding: t -*-
2
3 ;; Copyright (C) 2015 Free Software Foundation, Inc.
4
5 ;; Author: Oleh Krehel <ohwoeowho@gmail.com>
6 ;; URL: https://github.com/abo-abo/swiper
7 ;; Package-Requires: ((emacs "24.1"))
8 ;; Keywords: matching
9
10 ;; This file is part of GNU Emacs.
11
12 ;; This file is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 3, or (at your option)
15 ;; any later version.
16
17 ;; This program is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
21
22 ;; For a full copy of the GNU General Public License
23 ;; see <http://www.gnu.org/licenses/>.
24
25 ;;; Commentary:
26 ;;
27 ;; This package provides `ivy-read' as an alternative to
28 ;; `completing-read' and similar functions.
29 ;;
30 ;; There's no intricate code to determine the best candidate.
31 ;; Instead, the user can navigate to it with `ivy-next-line' and
32 ;; `ivy-previous-line'.
33 ;;
34 ;; The matching is done by splitting the input text by spaces and
35 ;; re-building it into a regex.
36 ;; So "for example" is transformed into "\\(for\\).*\\(example\\)".
37
38 ;;; Code:
39 (require 'cl-lib)
40 (require 'ffap)
41
42 ;;* Customization
43 (defgroup ivy nil
44 "Incremental vertical completion."
45 :group 'convenience)
46
47 (defface ivy-current-match
48 '((((class color) (background light))
49 :background "#1a4b77" :foreground "white")
50 (((class color) (background dark))
51 :background "#65a7e2" :foreground "black"))
52 "Face used by Ivy for highlighting first match.")
53
54 (defface ivy-confirm-face
55 '((t :foreground "ForestGreen" :inherit minibuffer-prompt))
56 "Face used by Ivy to issue a confirmation prompt.")
57
58 (defface ivy-match-required-face
59 '((t :foreground "red" :inherit minibuffer-prompt))
60 "Face used by Ivy to issue a match required prompt.")
61
62 (defface ivy-subdir
63 '((t (:inherit 'dired-directory)))
64 "Face used by Ivy for highlighting subdirs in the alternatives.")
65
66 (defface ivy-modified-buffer
67 '((t :inherit 'default))
68 "Face used by Ivy for highlighting modified file visiting buffers.")
69
70 (defface ivy-remote
71 '((t (:foreground "#110099")))
72 "Face used by Ivy for highlighting remotes in the alternatives.")
73
74 (defcustom ivy-height 10
75 "Number of lines for the minibuffer window."
76 :type 'integer)
77
78 (defcustom ivy-count-format "%-4d "
79 "The style of showing the current candidate count for `ivy-read'.
80 Set this to \"\" if you don't want the count. You can also set
81 it to e.g. \"(%d/%d) \" if you want to see both the candidate
82 index and the candidate count."
83 :type '(choice
84 (const :tag "Count disabled" "")
85 (const :tag "Count matches" "%-4d ")
86 (const :tag "Count matches and show current match" "(%d/%d) ")
87 string))
88
89 (defcustom ivy-wrap nil
90 "Whether to wrap around after the first and last candidate."
91 :type 'boolean)
92
93 (defcustom ivy-display-style (unless (version< emacs-version "24.5") 'fancy)
94 "The style for formatting the minibuffer.
95
96 By default, the matched strings will be copied as they are.
97
98 With the fancy method, the matching parts of the regexp will be
99 additionally highlighted, just like `swiper' does it.
100
101 This setting depends on `add-face-text-property' - a C function
102 available as of 24.5. It will behave poorly in earlier Emacs
103 versions."
104 :type '(choice
105 (const :tag "Plain" nil)
106 (const :tag "Fancy" fancy)))
107
108 (defcustom ivy-on-del-error-function 'minibuffer-keyboard-quit
109 "The handler for when `ivy-backward-delete-char' throws.
110 This is usually meant as a quick exit out of the minibuffer."
111 :type 'function)
112
113 (defcustom ivy-extra-directories '("../" "./")
114 "Add this to the front of the list when completing file names.
115 Only \"./\" and \"../\" apply here. They appear in reverse order."
116 :type '(repeat :tag "Dirs"
117 (choice
118 (const :tag "Parent Directory" "../")
119 (const :tag "Current Directory" "./"))))
120
121 (defcustom ivy-use-virtual-buffers nil
122 "When non-nil, add `recentf-mode' and bookmarks to `ivy-switch-buffer'."
123 :type 'boolean)
124
125 (defvar ivy--actions-list nil
126 "A list of extra actions per command.")
127
128 (defun ivy-set-actions (cmd actions)
129 "Set CMD extra exit points to ACTIONS."
130 (setq ivy--actions-list
131 (plist-put ivy--actions-list cmd actions)))
132
133 ;;* Keymap
134 (require 'delsel)
135 (defvar ivy-minibuffer-map
136 (let ((map (make-sparse-keymap)))
137 (define-key map (kbd "C-m") 'ivy-done)
138 (define-key map (kbd "C-M-m") 'ivy-call)
139 (define-key map (kbd "C-j") 'ivy-alt-done)
140 (define-key map (kbd "C-M-j") 'ivy-immediate-done)
141 (define-key map (kbd "TAB") 'ivy-partial-or-done)
142 (define-key map (kbd "C-n") 'ivy-next-line)
143 (define-key map (kbd "C-p") 'ivy-previous-line)
144 (define-key map (kbd "<down>") 'ivy-next-line)
145 (define-key map (kbd "<up>") 'ivy-previous-line)
146 (define-key map (kbd "C-s") 'ivy-next-line-or-history)
147 (define-key map (kbd "C-r") 'ivy-reverse-i-search)
148 (define-key map (kbd "SPC") 'self-insert-command)
149 (define-key map (kbd "DEL") 'ivy-backward-delete-char)
150 (define-key map (kbd "M-DEL") 'ivy-backward-kill-word)
151 (define-key map (kbd "C-d") 'ivy-delete-char)
152 (define-key map (kbd "C-f") 'ivy-forward-char)
153 (define-key map (kbd "M-d") 'ivy-kill-word)
154 (define-key map (kbd "M-<") 'ivy-beginning-of-buffer)
155 (define-key map (kbd "M->") 'ivy-end-of-buffer)
156 (define-key map (kbd "M-n") 'ivy-next-history-element)
157 (define-key map (kbd "M-p") 'ivy-previous-history-element)
158 (define-key map (kbd "C-g") 'minibuffer-keyboard-quit)
159 (define-key map (kbd "C-v") 'ivy-scroll-up-command)
160 (define-key map (kbd "M-v") 'ivy-scroll-down-command)
161 (define-key map (kbd "C-M-n") 'ivy-next-line-and-call)
162 (define-key map (kbd "C-M-p") 'ivy-previous-line-and-call)
163 (define-key map (kbd "M-q") 'ivy-toggle-regexp-quote)
164 (define-key map (kbd "M-j") 'ivy-yank-word)
165 (define-key map (kbd "M-i") 'ivy-insert-current)
166 (define-key map (kbd "C-o") 'hydra-ivy/body)
167 (define-key map (kbd "M-o") 'ivy-dispatching-done)
168 (define-key map (kbd "C-M-o") 'ivy-dispatching-call)
169 (define-key map (kbd "C-k") 'ivy-kill-line)
170 (define-key map (kbd "S-SPC") 'ivy-restrict-to-matches)
171 (define-key map (kbd "M-w") 'ivy-kill-ring-save)
172 (define-key map (kbd "C-'") 'ivy-avy)
173 (define-key map (kbd "C-M-a") 'ivy-read-action)
174 (define-key map (kbd "C-c C-o") 'ivy-occur)
175 map)
176 "Keymap used in the minibuffer.")
177 (autoload 'hydra-ivy/body "ivy-hydra" "" t)
178
179 (defvar ivy-mode-map
180 (let ((map (make-sparse-keymap)))
181 (define-key map [remap switch-to-buffer] 'ivy-switch-buffer)
182 map)
183 "Keymap for `ivy-mode'.")
184
185 ;;* Globals
186 (cl-defstruct ivy-state
187 prompt collection
188 predicate require-match initial-input
189 history preselect keymap update-fn sort
190 ;; The window in which `ivy-read' was called
191 window
192 ;; The buffer in which `ivy-read' was called
193 buffer
194 ;; The value of `ivy-text' to be used by `ivy-occur'
195 text
196 action
197 unwind
198 re-builder
199 matcher
200 ;; When this is non-nil, call it for each input change to get new candidates
201 dynamic-collection
202 caller)
203
204 (defvar ivy-last nil
205 "The last parameters passed to `ivy-read'.
206
207 This should eventually become a stack so that you could use
208 `ivy-read' recursively.")
209
210 (defsubst ivy-set-action (action)
211 (setf (ivy-state-action ivy-last) action))
212
213 (defvar ivy-history nil
214 "History list of candidates entered in the minibuffer.
215
216 Maximum length of the history list is determined by the value
217 of `history-length', which see.")
218
219 (defvar ivy--directory nil
220 "Current directory when completing file names.")
221
222 (defvar ivy--length 0
223 "Store the amount of viable candidates.")
224
225 (defvar ivy-text ""
226 "Store the user's string as it is typed in.")
227
228 (defvar ivy--current ""
229 "Current candidate.")
230
231 (defvar ivy--index 0
232 "Store the index of the current candidate.")
233
234 (defvar ivy-exit nil
235 "Store 'done if the completion was successfully selected.
236 Otherwise, store nil.")
237
238 (defvar ivy--all-candidates nil
239 "Store the candidates passed to `ivy-read'.")
240
241 (defvar ivy--default nil
242 "Default initial input.")
243
244 (defvar ivy--prompt nil
245 "Store the format-style prompt.
246 When non-nil, it should contain one %d.")
247
248 (defvar ivy--prompt-extra ""
249 "Temporary modifications to the prompt.")
250
251 (defvar ivy--old-re nil
252 "Store the old regexp.")
253
254 (defvar ivy--old-cands nil
255 "Store the candidates matched by `ivy--old-re'.")
256
257 (defvar ivy--regex-function 'ivy--regex
258 "Current function for building a regex.")
259
260 (defvar ivy--subexps 0
261 "Number of groups in the current `ivy--regex'.")
262
263 (defvar ivy--full-length nil
264 "When :dynamic-collection is non-nil, this can be the total amount of candidates.")
265
266 (defvar ivy--old-text ""
267 "Store old `ivy-text' for dynamic completion.")
268
269 (defvar ivy-case-fold-search 'auto
270 "Store the current overriding `case-fold-search'.")
271
272 (defvar Info-current-file)
273
274 (defmacro ivy-quit-and-run (&rest body)
275 "Quit the minibuffer and run BODY afterwards."
276 `(progn
277 (put 'quit 'error-message "")
278 (run-at-time nil nil
279 (lambda ()
280 (put 'quit 'error-message "Quit")
281 ,@body))
282 (minibuffer-keyboard-quit)))
283
284 (defun ivy-exit-with-action (action)
285 "Quit the minibuffer and call ACTION afterwards."
286 (ivy-set-action
287 `(lambda (x)
288 (funcall ',action x)
289 (ivy-set-action ',(ivy-state-action ivy-last))))
290 (setq ivy-exit 'done)
291 (exit-minibuffer))
292
293 (defmacro with-ivy-window (&rest body)
294 "Execute BODY in the window from which `ivy-read' was called."
295 (declare (indent 0)
296 (debug t))
297 `(with-selected-window (ivy--get-window ivy-last)
298 ,@body))
299
300 (defun ivy--done (text)
301 "Insert TEXT and exit minibuffer."
302 (if (and ivy--directory
303 (not (eq (ivy-state-history ivy-last) 'grep-files-history)))
304 (insert (setq ivy--current (expand-file-name
305 text ivy--directory)))
306 (insert (setq ivy--current text)))
307 (setq ivy-exit 'done)
308 (exit-minibuffer))
309
310 ;;* Commands
311 (defun ivy-done ()
312 "Exit the minibuffer with the selected candidate."
313 (interactive)
314 (delete-minibuffer-contents)
315 (cond ((> ivy--length 0)
316 (ivy--done ivy--current))
317 ((memq (ivy-state-collection ivy-last)
318 '(read-file-name-internal internal-complete-buffer))
319 (if (or (not (eq confirm-nonexistent-file-or-buffer t))
320 (equal " (confirm)" ivy--prompt-extra))
321 (ivy--done ivy-text)
322 (setq ivy--prompt-extra " (confirm)")
323 (insert ivy-text)
324 (ivy--exhibit)))
325 ((memq (ivy-state-require-match ivy-last)
326 '(nil confirm confirm-after-completion))
327 (ivy--done ivy-text))
328 (t
329 (setq ivy--prompt-extra " (match required)")
330 (insert ivy-text)
331 (ivy--exhibit))))
332
333 (defun ivy-read-action ()
334 "Change the action to one of the available ones."
335 (interactive)
336 (let ((actions (ivy-state-action ivy-last)))
337 (unless (null (ivy--actionp actions))
338 (let* ((hint (concat ivy--current
339 "\n"
340 (mapconcat
341 (lambda (x)
342 (format "%s: %s"
343 (propertize
344 (car x)
345 'face 'font-lock-builtin-face)
346 (nth 2 x)))
347 (cdr actions)
348 "\n")
349 "\n"))
350 (key (string (read-key hint)))
351 (action-idx (cl-position-if
352 (lambda (x) (equal (car x) key))
353 (cdr actions))))
354 (cond ((string= key "\a"))
355 ((null action-idx)
356 (error "%s is not bound" key))
357 (t
358 (message "")
359 (setcar actions (1+ action-idx))
360 (ivy-set-action actions)))))))
361
362 (defun ivy-dispatching-done ()
363 "Select one of the available actions and call `ivy-done'."
364 (interactive)
365 (ivy-read-action)
366 (ivy-done))
367
368 (defun ivy-dispatching-call ()
369 "Select one of the available actions and call `ivy-call'."
370 (interactive)
371 (let ((actions (copy-sequence (ivy-state-action ivy-last))))
372 (unwind-protect
373 (when (ivy-read-action)
374 (ivy-call))
375 (ivy-set-action actions))))
376
377 (defun ivy-build-tramp-name (x)
378 "Reconstruct X into a path.
379 Is is a cons cell, related to `tramp-get-completion-function'."
380 (let ((user (car x))
381 (domain (cadr x)))
382 (if user
383 (concat user "@" domain)
384 domain)))
385
386 (declare-function tramp-get-completion-function "tramp")
387 (declare-function Info-find-node "info")
388
389 (defun ivy-alt-done (&optional arg)
390 "Exit the minibuffer with the selected candidate.
391 When ARG is t, exit with current text, ignoring the candidates."
392 (interactive "P")
393 (cond (arg
394 (ivy-immediate-done))
395 (ivy--directory
396 (ivy--directory-done))
397 ((eq (ivy-state-collection ivy-last) 'Info-read-node-name-1)
398 (if (or (equal ivy--current "(./)")
399 (equal ivy--current "(../)"))
400 (ivy-quit-and-run
401 (ivy-read "Go to file: " 'read-file-name-internal
402 :action (lambda (x)
403 (Info-find-node
404 (expand-file-name x ivy--directory)
405 "Top"))))
406 (ivy-done)))
407 (t
408 (ivy-done))))
409
410 (defun ivy--directory-done ()
411 "Handle exit from the minibuffer when completing file names."
412 (let (dir)
413 (cond
414 ((equal ivy-text "/sudo::")
415 (setq dir (concat ivy-text ivy--directory))
416 (ivy--cd dir)
417 (ivy--exhibit))
418 ((or
419 (and
420 (not (equal ivy-text ""))
421 (ignore-errors
422 (file-directory-p
423 (setq dir
424 (file-name-as-directory
425 (expand-file-name
426 ivy-text ivy--directory))))))
427 (and
428 (not (string= ivy--current "./"))
429 (cl-plusp ivy--length)
430 (ignore-errors
431 (file-directory-p
432 (setq dir (file-name-as-directory
433 (expand-file-name
434 ivy--current ivy--directory)))))))
435 (ivy--cd dir)
436 (ivy--exhibit))
437 ((or (and (equal ivy--directory "/")
438 (string-match "\\`[^/]+:.*:.*\\'" ivy-text))
439 (string-match "\\`/[^/]+:.*:.*\\'" ivy-text))
440 (ivy-done))
441 ((or (and (equal ivy--directory "/")
442 (cond ((string-match
443 "\\`\\([^/]+?\\):\\(?:\\(.*\\)@\\)?\\(.*\\)\\'"
444 ivy-text))
445 ((string-match
446 "\\`\\([^/]+?\\):\\(?:\\(.*\\)@\\)?\\(.*\\)\\'"
447 ivy--current)
448 (setq ivy-text ivy--current))))
449 (string-match
450 "\\`/\\([^/]+?\\):\\(?:\\(.*\\)@\\)?\\(.*\\)\\'"
451 ivy-text))
452 (let ((method (match-string 1 ivy-text))
453 (user (match-string 2 ivy-text))
454 (rest (match-string 3 ivy-text))
455 res)
456 (require 'tramp)
457 (dolist (x (tramp-get-completion-function method))
458 (setq res (append res (funcall (car x) (cadr x)))))
459 (setq res (delq nil res))
460 (when user
461 (dolist (x res)
462 (setcar x user)))
463 (setq res (cl-delete-duplicates res :test #'equal))
464 (let* ((old-ivy-last ivy-last)
465 (enable-recursive-minibuffers t)
466 (host (ivy-read "Find File: "
467 (mapcar #'ivy-build-tramp-name res)
468 :initial-input rest)))
469 (setq ivy-last old-ivy-last)
470 (when host
471 (setq ivy--directory "/")
472 (ivy--cd (concat "/" method ":" host ":"))))))
473 (t
474 (ivy-done)))))
475
476 (defcustom ivy-tab-space nil
477 "When non-nil, `ivy-partial-or-done' should insert a space."
478 :type 'boolean)
479
480 (defun ivy-partial-or-done ()
481 "Complete the minibuffer text as much as possible.
482 If the text hasn't changed as a result, forward to `ivy-alt-done'."
483 (interactive)
484 (if (and (eq (ivy-state-collection ivy-last) #'read-file-name-internal)
485 (or (and (equal ivy--directory "/")
486 (string-match "\\`[^/]+:.*\\'" ivy-text))
487 (string-match "\\`/" ivy-text)))
488 (let ((default-directory ivy--directory))
489 (minibuffer-complete)
490 (setq ivy-text (ivy--input))
491 (when (file-directory-p
492 (expand-file-name ivy-text ivy--directory))
493 (ivy--cd (file-name-as-directory
494 (expand-file-name ivy-text ivy--directory)))))
495 (or (ivy-partial)
496 (when (or (eq this-command last-command)
497 (eq ivy--length 1))
498 (ivy-alt-done)))))
499
500 (defun ivy-partial ()
501 "Complete the minibuffer text as much as possible."
502 (interactive)
503 (let* ((parts (or (split-string ivy-text " " t) (list "")))
504 (postfix (car (last parts)))
505 (completion-ignore-case t)
506 (startp (string-match "^\\^" postfix))
507 (new (try-completion (if startp
508 (substring postfix 1)
509 postfix)
510 (mapcar (lambda (str)
511 (let ((i (string-match postfix str)))
512 (when i
513 (substring str i))))
514 ivy--old-cands))))
515 (cond ((eq new t) nil)
516 ((string= new ivy-text) nil)
517 (new
518 (delete-region (minibuffer-prompt-end) (point-max))
519 (setcar (last parts)
520 (if startp
521 (concat "^" new)
522 new))
523 (insert (mapconcat #'identity parts " ")
524 (if ivy-tab-space " " ""))
525 t))))
526
527 (defun ivy-immediate-done ()
528 "Exit the minibuffer with the current input."
529 (interactive)
530 (delete-minibuffer-contents)
531 (insert (setq ivy--current
532 (if ivy--directory
533 (expand-file-name ivy-text ivy--directory)
534 ivy-text)))
535 (setq ivy-exit 'done)
536 (exit-minibuffer))
537
538 ;;;###autoload
539 (defun ivy-resume ()
540 "Resume the last completion session."
541 (interactive)
542 (with-current-buffer (ivy-state-buffer ivy-last)
543 (ivy-read
544 (ivy-state-prompt ivy-last)
545 (ivy-state-collection ivy-last)
546 :predicate (ivy-state-predicate ivy-last)
547 :require-match (ivy-state-require-match ivy-last)
548 :initial-input ivy-text
549 :history (ivy-state-history ivy-last)
550 :preselect (unless (eq (ivy-state-collection ivy-last)
551 'read-file-name-internal)
552 ivy--current)
553 :keymap (ivy-state-keymap ivy-last)
554 :update-fn (ivy-state-update-fn ivy-last)
555 :sort (ivy-state-sort ivy-last)
556 :action (ivy-state-action ivy-last)
557 :unwind (ivy-state-unwind ivy-last)
558 :re-builder (ivy-state-re-builder ivy-last)
559 :matcher (ivy-state-matcher ivy-last)
560 :dynamic-collection (ivy-state-dynamic-collection ivy-last)
561 :caller (ivy-state-caller ivy-last))))
562
563 (defvar ivy-calling nil
564 "When non-nil, call the current action when `ivy--index' changes.")
565
566 (defun ivy-set-index (index)
567 "Set `ivy--index' to INDEX."
568 (setq ivy--index index)
569 (when ivy-calling
570 (ivy--exhibit)
571 (ivy-call)))
572
573 (defun ivy-beginning-of-buffer ()
574 "Select the first completion candidate."
575 (interactive)
576 (ivy-set-index 0))
577
578 (defun ivy-end-of-buffer ()
579 "Select the last completion candidate."
580 (interactive)
581 (ivy-set-index (1- ivy--length)))
582
583 (defun ivy-scroll-up-command ()
584 "Scroll the candidates upward by the minibuffer height."
585 (interactive)
586 (ivy-set-index (min (1- (+ ivy--index ivy-height))
587 (1- ivy--length))))
588
589 (defun ivy-scroll-down-command ()
590 "Scroll the candidates downward by the minibuffer height."
591 (interactive)
592 (ivy-set-index (max (1+ (- ivy--index ivy-height))
593 0)))
594
595 (defun ivy-minibuffer-grow ()
596 "Grow the minibuffer window by 1 line."
597 (interactive)
598 (setq-local max-mini-window-height
599 (cl-incf ivy-height)))
600
601 (defun ivy-minibuffer-shrink ()
602 "Shrink the minibuffer window by 1 line."
603 (interactive)
604 (unless (<= ivy-height 2)
605 (setq-local max-mini-window-height
606 (cl-decf ivy-height))
607 (window-resize (selected-window) -1)))
608
609 (defun ivy-next-line (&optional arg)
610 "Move cursor vertically down ARG candidates."
611 (interactive "p")
612 (setq arg (or arg 1))
613 (let ((index (+ ivy--index arg)))
614 (if (> index (1- ivy--length))
615 (if ivy-wrap
616 (ivy-beginning-of-buffer)
617 (ivy-set-index (1- ivy--length)))
618 (ivy-set-index index))))
619
620 (defun ivy-next-line-or-history (&optional arg)
621 "Move cursor vertically down ARG candidates.
622 If the input is empty, select the previous history element instead."
623 (interactive "p")
624 (when (string= ivy-text "")
625 (ivy-previous-history-element 1))
626 (ivy-next-line arg))
627
628 (defun ivy-previous-line (&optional arg)
629 "Move cursor vertically up ARG candidates."
630 (interactive "p")
631 (setq arg (or arg 1))
632 (let ((index (- ivy--index arg)))
633 (if (< index 0)
634 (if ivy-wrap
635 (ivy-end-of-buffer)
636 (ivy-set-index 0))
637 (ivy-set-index index))))
638
639 (defun ivy-previous-line-or-history (arg)
640 "Move cursor vertically up ARG candidates.
641 If the input is empty, select the previous history element instead."
642 (interactive "p")
643 (when (string= ivy-text "")
644 (ivy-previous-history-element 1))
645 (ivy-previous-line arg))
646
647 (defun ivy-toggle-calling ()
648 "Flip `ivy-calling'."
649 (interactive)
650 (when (setq ivy-calling (not ivy-calling))
651 (ivy-call)))
652
653 (defun ivy--get-action (state)
654 "Get the action function from STATE."
655 (let ((action (ivy-state-action state)))
656 (when action
657 (if (functionp action)
658 action
659 (cadr (nth (car action) action))))))
660
661 (defun ivy--get-window (state)
662 "Get the window from STATE."
663 (let ((window (ivy-state-window state)))
664 (if (window-live-p window)
665 window
666 (if (= (length (window-list)) 1)
667 (selected-window)
668 (next-window)))))
669
670 (defun ivy--actionp (x)
671 "Return non-nil when X is a list of actions."
672 (and x (listp x) (not (eq (car x) 'closure))))
673
674 (defun ivy-next-action ()
675 "When the current action is a list, scroll it forwards."
676 (interactive)
677 (let ((action (ivy-state-action ivy-last)))
678 (when (ivy--actionp action)
679 (unless (>= (car action) (1- (length action)))
680 (cl-incf (car action))))))
681
682 (defun ivy-prev-action ()
683 "When the current action is a list, scroll it backwards."
684 (interactive)
685 (let ((action (ivy-state-action ivy-last)))
686 (when (ivy--actionp action)
687 (unless (<= (car action) 1)
688 (cl-decf (car action))))))
689
690 (defun ivy-action-name ()
691 "Return the name associated with the current action."
692 (let ((action (ivy-state-action ivy-last)))
693 (if (ivy--actionp action)
694 (format "[%d/%d] %s"
695 (car action)
696 (1- (length action))
697 (nth 2 (nth (car action) action)))
698 "[1/1] default")))
699
700 (defun ivy-call ()
701 "Call the current action without exiting completion."
702 (interactive)
703 (let ((action (ivy--get-action ivy-last)))
704 (when action
705 (let* ((collection (ivy-state-collection ivy-last))
706 (x (if (and (consp collection)
707 (consp (car collection)))
708 (cdr (assoc ivy--current collection))
709 (if (equal ivy--current "")
710 ivy-text
711 ivy--current))))
712 (prog1 (funcall action x)
713 (unless (or (eq ivy-exit 'done)
714 (equal (selected-window)
715 (active-minibuffer-window))
716 (null (active-minibuffer-window)))
717 (select-window (active-minibuffer-window))))))))
718
719 (defun ivy-next-line-and-call (&optional arg)
720 "Move cursor vertically down ARG candidates.
721 Call the permanent action if possible."
722 (interactive "p")
723 (ivy-next-line arg)
724 (ivy--exhibit)
725 (ivy-call))
726
727 (defun ivy-previous-line-and-call (&optional arg)
728 "Move cursor vertically down ARG candidates.
729 Call the permanent action if possible."
730 (interactive "p")
731 (ivy-previous-line arg)
732 (ivy--exhibit)
733 (ivy-call))
734
735 (defun ivy-previous-history-element (arg)
736 "Forward to `previous-history-element' with ARG."
737 (interactive "p")
738 (previous-history-element arg)
739 (ivy--cd-maybe)
740 (move-end-of-line 1)
741 (ivy--maybe-scroll-history))
742
743 (defun ivy-next-history-element (arg)
744 "Forward to `next-history-element' with ARG."
745 (interactive "p")
746 (next-history-element arg)
747 (ivy--cd-maybe)
748 (move-end-of-line 1)
749 (ivy--maybe-scroll-history))
750
751 (defun ivy--cd-maybe ()
752 "Check if the current input points to a different directory.
753 If so, move to that directory, while keeping only the file name."
754 (when ivy--directory
755 (let ((input (ivy--input))
756 url)
757 (if (setq url (ffap-url-p input))
758 (ivy-exit-with-action
759 (lambda (_)
760 (funcall ffap-url-fetcher url)))
761 (setq input (expand-file-name input))
762 (let ((file (file-name-nondirectory input))
763 (dir (expand-file-name (file-name-directory input))))
764 (if (string= dir ivy--directory)
765 (progn
766 (delete-minibuffer-contents)
767 (insert file))
768 (ivy--cd dir)
769 (insert file)))))))
770
771 (defun ivy--maybe-scroll-history ()
772 "If the selected history element has an index, scroll there."
773 (let ((idx (ignore-errors
774 (get-text-property
775 (minibuffer-prompt-end)
776 'ivy-index))))
777 (when idx
778 (ivy--exhibit)
779 (setq ivy--index idx))))
780
781 (defun ivy--cd (dir)
782 "When completing file names, move to directory DIR."
783 (if (null ivy--directory)
784 (error "Unexpected")
785 (setq ivy--old-cands nil)
786 (setq ivy--old-re nil)
787 (setq ivy--index 0)
788 (setq ivy--all-candidates
789 (ivy--sorted-files (setq ivy--directory dir)))
790 (setq ivy-text "")
791 (delete-minibuffer-contents)))
792
793 (defun ivy-backward-delete-char ()
794 "Forward to `backward-delete-char'.
795 On error (read-only), call `ivy-on-del-error-function'."
796 (interactive)
797 (if (and ivy--directory (= (minibuffer-prompt-end) (point)))
798 (progn
799 (ivy--cd (file-name-directory
800 (directory-file-name
801 (expand-file-name
802 ivy--directory))))
803 (ivy--exhibit))
804 (condition-case nil
805 (backward-delete-char 1)
806 (error
807 (when ivy-on-del-error-function
808 (funcall ivy-on-del-error-function))))))
809
810 (defun ivy-delete-char (arg)
811 "Forward to `delete-char' ARG."
812 (interactive "p")
813 (unless (= (point) (line-end-position))
814 (delete-char arg)))
815
816 (defun ivy-forward-char (arg)
817 "Forward to `forward-char' ARG."
818 (interactive "p")
819 (unless (= (point) (line-end-position))
820 (forward-char arg)))
821
822 (defun ivy-kill-word (arg)
823 "Forward to `kill-word' ARG."
824 (interactive "p")
825 (unless (= (point) (line-end-position))
826 (kill-word arg)))
827
828 (defun ivy-kill-line ()
829 "Forward to `kill-line'."
830 (interactive)
831 (if (eolp)
832 (kill-region (minibuffer-prompt-end) (point))
833 (kill-line)))
834
835 (defun ivy-backward-kill-word ()
836 "Forward to `backward-kill-word'."
837 (interactive)
838 (if (and ivy--directory (= (minibuffer-prompt-end) (point)))
839 (progn
840 (ivy--cd (file-name-directory
841 (directory-file-name
842 (expand-file-name
843 ivy--directory))))
844 (ivy--exhibit))
845 (ignore-errors
846 (let ((pt (point)))
847 (forward-word -1)
848 (delete-region (point) pt)))))
849
850 (defvar ivy--regexp-quote 'regexp-quote
851 "Store the regexp quoting state.")
852
853 (defun ivy-toggle-regexp-quote ()
854 "Toggle the regexp quoting."
855 (interactive)
856 (setq ivy--old-re nil)
857 (cl-rotatef ivy--regex-function ivy--regexp-quote))
858
859 (defvar avy-all-windows)
860 (defvar avy-action)
861 (defvar avy-keys)
862 (defvar avy-keys-alist)
863 (defvar avy-style)
864 (defvar avy-styles-alist)
865 (declare-function avy--process "ext:avy")
866 (declare-function avy--style-fn "ext:avy")
867
868 (eval-after-load 'avy
869 '(add-to-list 'avy-styles-alist '(ivy-avy . pre)))
870
871 (defun ivy-avy ()
872 "Jump to one of the current ivy candidates."
873 (interactive)
874 (unless (require 'avy nil 'noerror)
875 (error "Package avy isn't installed"))
876 (let* ((avy-all-windows nil)
877 (avy-keys (or (cdr (assq 'ivy-avy avy-keys-alist))
878 avy-keys))
879 (avy-style (or (cdr (assq 'ivy-avy
880 avy-styles-alist))
881 avy-style))
882 (candidate
883 (let ((candidates))
884 (save-excursion
885 (save-restriction
886 (narrow-to-region
887 (window-start)
888 (window-end))
889 (goto-char (point-min))
890 (forward-line)
891 (while (< (point) (point-max))
892 (push
893 (cons (point)
894 (selected-window))
895 candidates)
896 (forward-line))))
897 (setq avy-action #'identity)
898 (avy--process
899 (nreverse candidates)
900 (avy--style-fn avy-style)))))
901 (ivy-set-index (- (line-number-at-pos candidate) 2))
902 (ivy--exhibit)
903 (ivy-done)))
904
905 (defun ivy-sort-file-function-default (x y)
906 "Compare two files X and Y.
907 Prioritize directories."
908 (if (get-text-property 0 'dirp x)
909 (if (get-text-property 0 'dirp y)
910 (string< x y)
911 t)
912 (if (get-text-property 0 'dirp y)
913 nil
914 (string< x y))))
915
916 (defcustom ivy-sort-functions-alist
917 '((read-file-name-internal . ivy-sort-file-function-default)
918 (internal-complete-buffer . nil)
919 (counsel-git-grep-function . nil)
920 (Man-goto-section . nil)
921 (org-refile . nil)
922 (t . string-lessp))
923 "An alist of sorting functions for each collection function.
924 Interactive functions that call completion fit in here as well.
925
926 For each entry, nil means no sorting. It's very useful to turn
927 off the sorting for functions that have candidates in the natural
928 buffer order, like `org-refile' or `Man-goto-section'.
929
930 The entry associated to t is used for all fall-through cases.
931
932 See also `ivy-sort-max-size'."
933 :type
934 '(alist
935 :key-type (choice
936 (const :tag "All other functions" t)
937 (symbol :tag "Function"))
938 :value-type (choice
939 (const :tag "plain sort" string-lessp)
940 (const :tag "file sort" ivy-sort-file-function-default)
941 (const :tag "no sort" nil)))
942 :group 'ivy)
943
944 (defvar ivy-index-functions-alist
945 '((swiper . ivy-recompute-index-swiper)
946 (swiper-multi . ivy-recompute-index-swiper)
947 (counsel-git-grep . ivy-recompute-index-swiper)
948 (t . ivy-recompute-index-zero))
949 "An alist of index recomputing functions for each collection function.
950 When the input changes, calling the appropriate function will
951 return an integer - the index of the matched candidate that
952 should be selected.")
953
954 (defvar ivy-re-builders-alist
955 '((t . ivy--regex-plus))
956 "An alist of regex building functions for each collection function.
957 Each function should take a string and return a valid regex or a
958 regex sequence (see below).
959
960 The entry associated to t is used for all fall-through cases.
961 Possible choices: `ivy--regex', `regexp-quote', `ivy--regex-plus'.
962
963 In case a function returns a list, it should look like this:
964 '((\"matching-regexp\" . t) (\"non-matching-regexp\") ...).
965
966 The matches will be filtered in a sequence, you can mix the
967 regexps that should match and that should not match as you
968 like.")
969
970 (defvar ivy-initial-inputs-alist
971 '((org-refile . "^")
972 (org-agenda-refile . "^")
973 (org-capture-refile . "^")
974 (counsel-M-x . "^")
975 (counsel-describe-function . "^")
976 (counsel-describe-variable . "^")
977 (man . "^")
978 (woman . "^"))
979 "Command to initial input table.")
980
981 (defcustom ivy-sort-max-size 30000
982 "Sorting won't be done for collections larger than this."
983 :type 'integer)
984
985 (defun ivy--sorted-files (dir)
986 "Return the list of files in DIR.
987 Directories come first."
988 (let* ((default-directory dir)
989 (seq (all-completions "" 'read-file-name-internal))
990 sort-fn)
991 (if (equal dir "/")
992 seq
993 (setq seq (delete "./" (delete "../" seq)))
994 (when (eq (setq sort-fn (cdr (assoc 'read-file-name-internal
995 ivy-sort-functions-alist)))
996 #'ivy-sort-file-function-default)
997 (setq seq (mapcar (lambda (x)
998 (propertize x 'dirp (string-match-p "/\\'" x)))
999 seq)))
1000 (when sort-fn
1001 (setq seq (cl-sort seq sort-fn)))
1002 (dolist (dir ivy-extra-directories)
1003 (push dir seq))
1004 seq)))
1005
1006 ;;** Entry Point
1007 (cl-defun ivy-read (prompt collection
1008 &key predicate require-match initial-input
1009 history preselect keymap update-fn sort
1010 action unwind re-builder matcher dynamic-collection caller)
1011 "Read a string in the minibuffer, with completion.
1012
1013 PROMPT is a string to prompt with; normally it ends in a colon
1014 and a space. When PROMPT contains %d, it will be updated with
1015 the current number of matching candidates. If % appears elsewhere
1016 in the PROMPT it should be quoted as %%.
1017 See also `ivy-count-format'.
1018
1019 COLLECTION is a list of strings, or a function, or an alist, or a
1020 hash table.
1021
1022 If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.
1023
1024 KEYMAP is composed together with `ivy-minibuffer-map'.
1025
1026 If PRESELECT is non-nil select the corresponding candidate out of
1027 the ones that match INITIAL-INPUT.
1028
1029 UPDATE-FN is called each time the current candidate(s) is changed.
1030
1031 When SORT is t, refer to `ivy-sort-functions-alist' for sorting.
1032
1033 ACTION is a lambda to call after a result was selected. It should
1034 take a single argument, usually a string.
1035
1036 UNWIND is a lambda to call before exiting.
1037
1038 RE-BUILDER is a lambda that transforms text into a regex.
1039
1040 MATCHER can completely override matching.
1041
1042 DYNAMIC-COLLECTION is a boolean that determines whether to update
1043 the list of candidates with each input by calling COLLECTION for
1044 the current input.
1045
1046 CALLER is a symbol to uniquely identify the caller to `ivy-read'.
1047 It's used in conjunction with COLLECTION to indentify which
1048 customizations should apply to the current completion session."
1049 (let ((extra-actions (plist-get ivy--actions-list this-command)))
1050 (when extra-actions
1051 (setq action
1052 (if (functionp action)
1053 `(1
1054 ("o" ,action "default")
1055 ,@extra-actions)
1056 (delete-dups (append action extra-actions))))))
1057 (let ((recursive-ivy-last (and (window-minibuffer-p) ivy-last)))
1058 (setq ivy-last
1059 (make-ivy-state
1060 :prompt prompt
1061 :collection collection
1062 :predicate predicate
1063 :require-match require-match
1064 :initial-input initial-input
1065 :history history
1066 :preselect preselect
1067 :keymap keymap
1068 :update-fn update-fn
1069 :sort sort
1070 :action action
1071 :window (selected-window)
1072 :buffer (current-buffer)
1073 :unwind unwind
1074 :re-builder re-builder
1075 :matcher matcher
1076 :dynamic-collection dynamic-collection
1077 :caller caller))
1078 (ivy--reset-state ivy-last)
1079 (prog1
1080 (unwind-protect
1081 (minibuffer-with-setup-hook
1082 #'ivy--minibuffer-setup
1083 (let* ((hist (or history 'ivy-history))
1084 (minibuffer-completion-table collection)
1085 (minibuffer-completion-predicate predicate)
1086 (resize-mini-windows (cond
1087 ((display-graphic-p) nil)
1088 ((null resize-mini-windows) 'grow-only)
1089 (t resize-mini-windows)))
1090 (res (read-from-minibuffer
1091 prompt
1092 (ivy-state-initial-input ivy-last)
1093 (make-composed-keymap keymap ivy-minibuffer-map)
1094 nil
1095 hist)))
1096 (when (eq ivy-exit 'done)
1097 (let ((item (if ivy--directory
1098 ivy--current
1099 ivy-text)))
1100 (unless (equal item "")
1101 (set hist (cons (propertize item 'ivy-index ivy--index)
1102 (delete item
1103 (cdr (symbol-value hist)))))))
1104 res)))
1105 (remove-hook 'post-command-hook #'ivy--exhibit)
1106 (when (setq unwind (ivy-state-unwind ivy-last))
1107 (funcall unwind)))
1108 (ivy-call)
1109 (when recursive-ivy-last
1110 (ivy--reset-state (setq ivy-last recursive-ivy-last))))))
1111
1112 (defun ivy--reset-state (state)
1113 "Reset the ivy to STATE.
1114 This is useful for recursive `ivy-read'."
1115 (let ((prompt (ivy-state-prompt state))
1116 (collection (ivy-state-collection state))
1117 (predicate (ivy-state-predicate state))
1118 (history (ivy-state-history state))
1119 (preselect (ivy-state-preselect state))
1120 (sort (ivy-state-sort state))
1121 (re-builder (ivy-state-re-builder state))
1122 (dynamic-collection (ivy-state-dynamic-collection state))
1123 (initial-input (ivy-state-initial-input state))
1124 (require-match (ivy-state-require-match state)))
1125 (unless initial-input
1126 (setq initial-input (cdr (assoc this-command
1127 ivy-initial-inputs-alist))))
1128 (setq ivy--directory nil)
1129 (setq ivy-case-fold-search 'auto)
1130 (setq ivy--regex-function
1131 (or re-builder
1132 (and (functionp collection)
1133 (cdr (assoc collection ivy-re-builders-alist)))
1134 (cdr (assoc t ivy-re-builders-alist))
1135 'ivy--regex))
1136 (setq ivy--subexps 0)
1137 (setq ivy--regexp-quote 'regexp-quote)
1138 (setq ivy--old-text "")
1139 (setq ivy--full-length nil)
1140 (setq ivy-text "")
1141 (setq ivy-calling nil)
1142 (let (coll sort-fn)
1143 (cond ((eq collection 'Info-read-node-name-1)
1144 (if (equal Info-current-file "dir")
1145 (setq coll
1146 (mapcar (lambda (x) (format "(%s)" x))
1147 (cl-delete-duplicates
1148 (all-completions "(" collection predicate)
1149 :test #'equal)))
1150 (setq coll (all-completions "" collection predicate))))
1151 ((eq collection 'read-file-name-internal)
1152 (setq ivy--directory default-directory)
1153 (require 'dired)
1154 (when preselect
1155 (let ((preselect-directory (file-name-directory preselect)))
1156 (unless (or (null preselect-directory)
1157 (string= preselect-directory
1158 default-directory))
1159 (setq ivy--directory preselect-directory))
1160 (setf
1161 (ivy-state-preselect state)
1162 (setq preselect (file-name-nondirectory preselect)))))
1163 (setq coll (ivy--sorted-files ivy--directory))
1164 (when initial-input
1165 (unless (or require-match
1166 (equal initial-input default-directory)
1167 (equal initial-input ""))
1168 (setq coll (cons initial-input coll)))
1169 (setq initial-input nil)))
1170 ((eq collection 'internal-complete-buffer)
1171 (setq coll (ivy--buffer-list "" ivy-use-virtual-buffers)))
1172 ((or (functionp collection)
1173 (byte-code-function-p collection)
1174 (vectorp collection)
1175 (and (consp collection) (listp (car collection)))
1176 (hash-table-p collection))
1177 (setq coll (all-completions "" collection predicate)))
1178 (t
1179 (setq coll collection)))
1180 (when sort
1181 (if (and (functionp collection)
1182 (setq sort-fn (assoc collection ivy-sort-functions-alist)))
1183 (when (and (setq sort-fn (cdr sort-fn))
1184 (not (eq collection 'read-file-name-internal)))
1185 (setq coll (cl-sort coll sort-fn)))
1186 (unless (eq history 'org-refile-history)
1187 (if (and (setq sort-fn (cdr (assoc t ivy-sort-functions-alist)))
1188 (<= (length coll) ivy-sort-max-size))
1189 (setq coll (cl-sort (copy-sequence coll) sort-fn))))))
1190 (when preselect
1191 (unless (or (and require-match
1192 (not (eq collection 'internal-complete-buffer)))
1193 (let ((re (regexp-quote preselect)))
1194 (cl-find-if (lambda (x) (string-match re x))
1195 coll)))
1196 (setq coll (cons preselect coll))))
1197 (setq ivy--index (or
1198 (and dynamic-collection
1199 ivy--index)
1200 (and preselect
1201 (ivy--preselect-index preselect coll))
1202 0))
1203 (setq ivy--old-re nil)
1204 (setq ivy--old-cands nil)
1205 (when initial-input
1206 ;; Needed for anchor to work
1207 (setq ivy--old-cands coll)
1208 (setq ivy--old-cands (ivy--filter initial-input coll)))
1209 (setq ivy--all-candidates coll))
1210 (setq ivy-exit nil)
1211 (setq ivy--default (or
1212 (thing-at-point 'url)
1213 (thing-at-point 'symbol)
1214 ""))
1215 (setq ivy--prompt
1216 (cond ((string-match "%.*d" prompt)
1217 prompt)
1218 ((null ivy-count-format)
1219 (error
1220 "`ivy-count-format' can't be nil. Set it to an empty string instead"))
1221 ((string-match "%d.*%d" ivy-count-format)
1222 (let ((w (length (number-to-string
1223 (length ivy--all-candidates))))
1224 (s (copy-sequence ivy-count-format)))
1225 (string-match "%d" s)
1226 (match-end 0)
1227 (string-match "%d" s (match-end 0))
1228 (setq s (replace-match (format "%%-%dd" w) nil nil s))
1229 (string-match "%d" s)
1230 (concat (replace-match (format "%%%dd" w) nil nil s)
1231 prompt)))
1232 ((string-match "%.*d" ivy-count-format)
1233 (concat ivy-count-format prompt))
1234 (ivy--directory
1235 prompt)
1236 (t
1237 nil)))
1238 (setf (ivy-state-initial-input ivy-last) initial-input)))
1239
1240 ;;;###autoload
1241 (defun ivy-completing-read (prompt collection
1242 &optional predicate require-match initial-input
1243 history def _inherit-input-method)
1244 "Read a string in the minibuffer, with completion.
1245
1246 This is an interface that conforms to `completing-read', so that
1247 it can be used for `completing-read-function'.
1248
1249 PROMPT is a string to prompt with; normally it ends in a colon and a space.
1250 COLLECTION can be a list of strings, an alist, an obarray or a hash table.
1251 PREDICATE limits completion to a subset of COLLECTION.
1252 REQUIRE-MATCH is considered boolean. See `completing-read'.
1253 INITIAL-INPUT is a string that can be inserted into the minibuffer initially.
1254 _HISTORY is ignored for now.
1255 DEF is the default value.
1256 _INHERIT-INPUT-METHOD is ignored for now.
1257
1258 The history, defaults and input-method arguments are ignored for now."
1259 ;; See the doc of `completing-read'.
1260 (when (consp history)
1261 (when (numberp (cdr history))
1262 (setq initial-input (nth (1- (cdr history))
1263 (symbol-value (car history)))))
1264 (setq history (car history)))
1265 (ivy-read (replace-regexp-in-string "%" "%%" prompt)
1266 collection
1267 :predicate predicate
1268 :require-match require-match
1269 :initial-input (if (consp initial-input)
1270 (car initial-input)
1271 (if (and (stringp initial-input)
1272 (string-match "\\+" initial-input))
1273 (replace-regexp-in-string
1274 "\\+" "\\\\+" initial-input)
1275 initial-input))
1276 :preselect (if (listp def) (car def) def)
1277 :history history
1278 :keymap nil
1279 :sort
1280 (let ((sort (assoc this-command ivy-sort-functions-alist)))
1281 (if sort
1282 (cdr sort)
1283 t))))
1284
1285 ;;;###autoload
1286 (define-minor-mode ivy-mode
1287 "Toggle Ivy mode on or off.
1288 With ARG, turn Ivy mode on if arg is positive, off otherwise.
1289 Turning on Ivy mode will set `completing-read-function' to
1290 `ivy-completing-read'.
1291
1292 Global bindings:
1293 \\{ivy-mode-map}
1294
1295 Minibuffer bindings:
1296 \\{ivy-minibuffer-map}"
1297 :group 'ivy
1298 :global t
1299 :keymap ivy-mode-map
1300 :lighter " ivy"
1301 (if ivy-mode
1302 (setq completing-read-function 'ivy-completing-read)
1303 (setq completing-read-function 'completing-read-default)))
1304
1305 (defun ivy--preselect-index (preselect candidates)
1306 "Return the index of PRESELECT in CANDIDATES."
1307 (cond ((integerp preselect)
1308 preselect)
1309 ((cl-position preselect candidates :test #'equal))
1310 ((stringp preselect)
1311 (let ((re (regexp-quote preselect)))
1312 (cl-position-if
1313 (lambda (x)
1314 (string-match re x))
1315 candidates)))))
1316
1317 ;;* Implementation
1318 ;;** Regex
1319 (defvar ivy--regex-hash
1320 (make-hash-table :test #'equal)
1321 "Store pre-computed regex.")
1322
1323 (defun ivy--split (str)
1324 "Split STR into a list by single spaces.
1325 The remaining spaces stick to their left.
1326 This allows to \"quote\" N spaces by inputting N+1 spaces."
1327 (let ((len (length str))
1328 start0
1329 (start1 0)
1330 res s
1331 match-len)
1332 (while (and (string-match " +" str start1)
1333 (< start1 len))
1334 (setq match-len (- (match-end 0) (match-beginning 0)))
1335 (if (= match-len 1)
1336 (progn
1337 (when start0
1338 (setq start1 start0)
1339 (setq start0 nil))
1340 (push (substring str start1 (match-beginning 0)) res)
1341 (setq start1 (match-end 0)))
1342 (setq str (replace-match
1343 (make-string (1- match-len) ?\ )
1344 nil nil str))
1345 (setq start0 (or start0 start1))
1346 (setq start1 (1- (match-end 0)))))
1347 (if start0
1348 (push (substring str start0) res)
1349 (setq s (substring str start1))
1350 (unless (= (length s) 0)
1351 (push s res)))
1352 (nreverse res)))
1353
1354 (defun ivy--regex (str &optional greedy)
1355 "Re-build regex from STR in case it has a space.
1356 When GREEDY is non-nil, join words in a greedy way."
1357 (let ((hashed (unless greedy
1358 (gethash str ivy--regex-hash))))
1359 (if hashed
1360 (prog1 (cdr hashed)
1361 (setq ivy--subexps (car hashed)))
1362 (when (string-match "\\([^\\]\\|^\\)\\\\$" str)
1363 (setq str (substring str 0 -1)))
1364 (cdr (puthash str
1365 (let ((subs (ivy--split str)))
1366 (if (= (length subs) 1)
1367 (cons
1368 (setq ivy--subexps 0)
1369 (car subs))
1370 (cons
1371 (setq ivy--subexps (length subs))
1372 (mapconcat
1373 (lambda (x)
1374 (if (string-match "\\`\\\\(.*\\\\)\\'" x)
1375 x
1376 (format "\\(%s\\)" x)))
1377 subs
1378 (if greedy
1379 ".*"
1380 ".*?")))))
1381 ivy--regex-hash)))))
1382
1383 (defun ivy--regex-ignore-order (str)
1384 "Re-build regex from STR by splitting it on spaces.
1385 Ignore the order of each group."
1386 (let* ((subs (split-string str " +" t))
1387 (len (length subs)))
1388 (cl-case len
1389 (1
1390 (setq ivy--subexps 0)
1391 (car subs))
1392 (t
1393 (setq ivy--subexps len)
1394 (let ((all (mapconcat #'identity subs "\\|")))
1395 (mapconcat
1396 (lambda (x)
1397 (if (string-match "\\`\\\\(.*\\\\)\\'" x)
1398 x
1399 (format "\\(%s\\)" x)))
1400 (make-list len all)
1401 ".*?"))))))
1402
1403 (defun ivy--regex-plus (str)
1404 "Build a regex sequence from STR.
1405 Spaces are wild, everything before \"!\" should match.
1406 Everything after \"!\" should not match."
1407 (let ((parts (split-string str "!" t)))
1408 (cl-case (length parts)
1409 (0
1410 "")
1411 (1
1412 (ivy--regex (car parts)))
1413 (2
1414 (let ((res
1415 (mapcar #'list
1416 (split-string (cadr parts) " " t))))
1417 (cons (cons (ivy--regex (car parts)) t)
1418 res)))
1419 (t (error "Unexpected: use only one !")))))
1420
1421 (defun ivy--regex-fuzzy (str)
1422 "Build a regex sequence from STR.
1423 Insert .* between each char."
1424 (if (string-match "\\`\\(\\^?\\)\\(.*?\\)\\(\\$?\\)\\'" str)
1425 (prog1
1426 (concat (match-string 1 str)
1427 (mapconcat
1428 (lambda (x)
1429 (format "\\(%c\\)" x))
1430 (string-to-list (match-string 2 str)) ".*")
1431 (match-string 3 str))
1432 (setq ivy--subexps (length (match-string 2 str))))
1433 str))
1434
1435 ;;** Rest
1436 (defun ivy--minibuffer-setup ()
1437 "Setup ivy completion in the minibuffer."
1438 (set (make-local-variable 'completion-show-inline-help) nil)
1439 (set (make-local-variable 'minibuffer-default-add-function)
1440 (lambda ()
1441 (list ivy--default)))
1442 (when (display-graphic-p)
1443 (setq truncate-lines t))
1444 (setq-local max-mini-window-height ivy-height)
1445 (add-hook 'post-command-hook #'ivy--exhibit nil t)
1446 ;; show completions with empty input
1447 (ivy--exhibit))
1448
1449 (defun ivy--input ()
1450 "Return the current minibuffer input."
1451 ;; assume one-line minibuffer input
1452 (buffer-substring-no-properties
1453 (minibuffer-prompt-end)
1454 (line-end-position)))
1455
1456 (defun ivy--cleanup ()
1457 "Delete the displayed completion candidates."
1458 (save-excursion
1459 (goto-char (minibuffer-prompt-end))
1460 (delete-region (line-end-position) (point-max))))
1461
1462 (defun ivy--insert-prompt ()
1463 "Update the prompt according to `ivy--prompt'."
1464 (when ivy--prompt
1465 (unless (memq this-command '(ivy-done ivy-alt-done ivy-partial-or-done
1466 counsel-find-symbol))
1467 (setq ivy--prompt-extra ""))
1468 (let (head tail)
1469 (if (string-match "\\(.*\\): \\'" ivy--prompt)
1470 (progn
1471 (setq head (match-string 1 ivy--prompt))
1472 (setq tail ": "))
1473 (setq head (substring ivy--prompt 0 -1))
1474 (setq tail " "))
1475 (let ((inhibit-read-only t)
1476 (std-props '(front-sticky t rear-nonsticky t field t read-only t))
1477 (n-str
1478 (concat
1479 (if (and (bound-and-true-p minibuffer-depth-indicate-mode)
1480 (> (minibuffer-depth) 1))
1481 (format "[%d] " (minibuffer-depth))
1482 "")
1483 (concat
1484 (if (string-match "%d.*%d" ivy-count-format)
1485 (format head
1486 (1+ ivy--index)
1487 (or (and (ivy-state-dynamic-collection ivy-last)
1488 ivy--full-length)
1489 ivy--length))
1490 (format head
1491 (or (and (ivy-state-dynamic-collection ivy-last)
1492 ivy--full-length)
1493 ivy--length)))
1494 ivy--prompt-extra
1495 tail)))
1496 (d-str (if ivy--directory
1497 (abbreviate-file-name ivy--directory)
1498 "")))
1499 (save-excursion
1500 (goto-char (point-min))
1501 (delete-region (point-min) (minibuffer-prompt-end))
1502 (if (> (+ (mod (+ (length n-str) (length d-str)) (window-width))
1503 (length ivy-text))
1504 (window-width))
1505 (setq n-str (concat n-str "\n" d-str))
1506 (setq n-str (concat n-str d-str)))
1507 (let ((regex (format "\\([^\n]\\{%d\\}\\)[^\n]" (window-width))))
1508 (while (string-match regex n-str)
1509 (setq n-str (replace-match (concat (match-string 1 n-str) "\n") nil t n-str 1))))
1510 (set-text-properties 0 (length n-str)
1511 `(face minibuffer-prompt ,@std-props)
1512 n-str)
1513 (ivy--set-match-props n-str "confirm"
1514 `(face ivy-confirm-face ,@std-props))
1515 (ivy--set-match-props n-str "match required"
1516 `(face ivy-match-required-face ,@std-props))
1517 (insert n-str))
1518 ;; get out of the prompt area
1519 (constrain-to-field nil (point-max))))))
1520
1521 (defun ivy--set-match-props (str match props)
1522 "Set STR text proprties that match MATCH to PROPS."
1523 (when (string-match match str)
1524 (set-text-properties
1525 (match-beginning 0)
1526 (match-end 0)
1527 props
1528 str)))
1529
1530 (defvar inhibit-message)
1531
1532 (defun ivy--sort-maybe (collection)
1533 "Sort COLLECTION if needed."
1534 (let ((sort (ivy-state-sort ivy-last))
1535 entry)
1536 (if (null sort)
1537 collection
1538 (let ((sort-fn (cond ((functionp sort)
1539 sort)
1540 ((setq entry (assoc (ivy-state-collection ivy-last)
1541 ivy-sort-functions-alist))
1542 (cdr entry))
1543 (t
1544 (cdr (assoc t ivy-sort-functions-alist))))))
1545 (if (functionp sort-fn)
1546 (cl-sort (copy-sequence collection) sort-fn)
1547 collection)))))
1548
1549 (defun ivy--exhibit ()
1550 "Insert Ivy completions display.
1551 Should be run via minibuffer `post-command-hook'."
1552 (when (memq 'ivy--exhibit post-command-hook)
1553 (let ((inhibit-field-text-motion nil))
1554 (constrain-to-field nil (point-max)))
1555 (setq ivy-text (ivy--input))
1556 (if (ivy-state-dynamic-collection ivy-last)
1557 ;; while-no-input would cause annoying
1558 ;; "Waiting for process to die...done" message interruptions
1559 (let ((inhibit-message t))
1560 (unless (equal ivy--old-text ivy-text)
1561 (while-no-input
1562 (setq ivy--all-candidates
1563 (ivy--sort-maybe
1564 (funcall (ivy-state-collection ivy-last) ivy-text)))
1565 (setq ivy--old-text ivy-text)))
1566 (when ivy--all-candidates
1567 (ivy--insert-minibuffer
1568 (ivy--format ivy--all-candidates))))
1569 (cond (ivy--directory
1570 (if (string-match "/\\'" ivy-text)
1571 (if (member ivy-text ivy--all-candidates)
1572 (ivy--cd (expand-file-name ivy-text ivy--directory))
1573 (when (string-match "//\\'" ivy-text)
1574 (if (and default-directory
1575 (string-match "\\`[[:alpha:]]:/" default-directory))
1576 (ivy--cd (match-string 0 default-directory))
1577 (ivy--cd "/")))
1578 (when (string-match "[[:alpha:]]:/$" ivy-text)
1579 (let ((drive-root (match-string 0 ivy-text)))
1580 (when (file-exists-p drive-root)
1581 (ivy--cd drive-root)))))
1582 (if (string-match "\\`~\\'" ivy-text)
1583 (ivy--cd (expand-file-name "~/")))))
1584 ((eq (ivy-state-collection ivy-last) 'internal-complete-buffer)
1585 (when (or (and (string-match "\\` " ivy-text)
1586 (not (string-match "\\` " ivy--old-text)))
1587 (and (string-match "\\` " ivy--old-text)
1588 (not (string-match "\\` " ivy-text))))
1589 (setq ivy--all-candidates
1590 (if (and (> (length ivy-text) 0)
1591 (eq (aref ivy-text 0)
1592 ?\ ))
1593 (ivy--buffer-list " ")
1594 (ivy--buffer-list "" ivy-use-virtual-buffers)))
1595 (setq ivy--old-re nil))))
1596 (ivy--insert-minibuffer
1597 (with-current-buffer (ivy-state-buffer ivy-last)
1598 (ivy--format
1599 (ivy--filter ivy-text ivy--all-candidates))))
1600 (setq ivy--old-text ivy-text))))
1601
1602 (defun ivy--insert-minibuffer (text)
1603 "Insert TEXT into minibuffer with appropriate cleanup."
1604 (let ((resize-mini-windows nil)
1605 (update-fn (ivy-state-update-fn ivy-last))
1606 deactivate-mark)
1607 (ivy--cleanup)
1608 (when update-fn
1609 (funcall update-fn))
1610 (ivy--insert-prompt)
1611 ;; Do nothing if while-no-input was aborted.
1612 (when (stringp text)
1613 (let ((buffer-undo-list t))
1614 (save-excursion
1615 (forward-line 1)
1616 (insert text))))
1617 (when (display-graphic-p)
1618 (ivy--resize-minibuffer-to-fit))))
1619
1620 (defun ivy--resize-minibuffer-to-fit ()
1621 "Resize the minibuffer window so it has enough space to display
1622 all of the text contained in the minibuffer."
1623 (with-selected-window (minibuffer-window)
1624 (if (fboundp 'window-text-pixel-size)
1625 (let ((text-height (cdr (window-text-pixel-size)))
1626 (body-height (window-body-height nil t)))
1627 (when (> text-height body-height)
1628 (window-resize nil (- text-height body-height) nil t t)))
1629 (let ((text-height (count-screen-lines))
1630 (body-height (window-body-height)))
1631 (when (> text-height body-height)
1632 (window-resize nil (- text-height body-height) nil t))))))
1633
1634 (declare-function colir-blend-face-background "ext:colir")
1635
1636 (defun ivy--add-face (str face)
1637 "Propertize STR with FACE.
1638 `font-lock-append-text-property' is used, since it's better than
1639 `propertize' or `add-face-text-property' in this case."
1640 (require 'colir)
1641 (condition-case nil
1642 (progn
1643 (colir-blend-face-background 0 (length str) face str)
1644 (let ((foreground (face-foreground face)))
1645 (when foreground
1646 (add-face-text-property
1647 0 (length str)
1648 `(:foreground ,foreground)
1649 nil
1650 str))))
1651 (error
1652 (ignore-errors
1653 (font-lock-append-text-property 0 (length str) 'face face str))))
1654 str)
1655
1656 (declare-function flx-make-string-cache "ext:flx")
1657 (declare-function flx-score "ext:flx")
1658
1659 (defvar ivy--flx-cache nil)
1660
1661 (eval-after-load 'flx
1662 '(setq ivy--flx-cache (flx-make-string-cache)))
1663
1664 (defun ivy-toggle-case-fold ()
1665 "Toggle the case folding between nil and auto.
1666 In any completion session, the case folding starts in auto:
1667
1668 - when the input is all lower case, `case-fold-search' is t
1669 - otherwise it's nil.
1670
1671 You can toggle this to make `case-fold-search' nil regardless of input."
1672 (interactive)
1673 (setq ivy-case-fold-search
1674 (if ivy-case-fold-search
1675 nil
1676 'auto))
1677 ;; reset cache so that the candidate list updates
1678 (setq ivy--old-re nil))
1679
1680 (defun ivy--filter (name candidates)
1681 "Return all items that match NAME in CANDIDATES.
1682 CANDIDATES are assumed to be static."
1683 (let ((re (funcall ivy--regex-function name)))
1684 (if (and (equal re ivy--old-re)
1685 ivy--old-cands)
1686 ;; quick caching for "C-n", "C-p" etc.
1687 ivy--old-cands
1688 (let* ((re-str (if (listp re) (caar re) re))
1689 (matcher (ivy-state-matcher ivy-last))
1690 (case-fold-search
1691 (and ivy-case-fold-search
1692 (string= name (downcase name))))
1693 (cands (cond
1694 (matcher
1695 (funcall matcher re candidates))
1696 ((and ivy--old-re
1697 (stringp re)
1698 (stringp ivy--old-re)
1699 (not (string-match "\\\\" ivy--old-re))
1700 (not (equal ivy--old-re ""))
1701 (memq (cl-search
1702 (if (string-match "\\\\)\\'" ivy--old-re)
1703 (substring ivy--old-re 0 -2)
1704 ivy--old-re)
1705 re)
1706 '(0 2)))
1707 (ignore-errors
1708 (cl-remove-if-not
1709 (lambda (x) (string-match re x))
1710 ivy--old-cands)))
1711 (t
1712 (let ((re-list (if (stringp re) (list (cons re t)) re))
1713 (res candidates))
1714 (dolist (re re-list)
1715 (setq res
1716 (ignore-errors
1717 (funcall
1718 (if (cdr re)
1719 #'cl-remove-if-not
1720 #'cl-remove-if)
1721 (let ((re-str (car re)))
1722 (lambda (x) (string-match re-str x)))
1723 res))))
1724 res)))))
1725 (ivy--recompute-index name re-str cands)
1726 (setq ivy--old-re (if cands re-str ""))
1727 (setq ivy--old-cands (ivy--sort name cands))))))
1728
1729 (defcustom ivy-sort-matches-functions-alist '((t . nil))
1730 "An alist of functions used to sort the matching candidates.
1731
1732 This is different from `ivy-sort-functions-alist', which is used
1733 to sort the whole collection only once. The functions taken from
1734 here are instead used on each input change, but they are used
1735 only on already matching candidates, not on all of them.
1736
1737 The alist KEY is a collection function or t to match previously
1738 not matched collection functions.
1739
1740 The alist VAL is a sorting function with the signature of
1741 `ivy--prefix-sort'.")
1742
1743 (defun ivy--sort-files-by-date (_name candidates)
1744 "Re-soft CANDIDATES according to file modification date."
1745 (let ((default-directory ivy--directory))
1746 (cl-sort (copy-sequence candidates)
1747 (lambda (f1 f2)
1748 (time-less-p
1749 (nth 5 (file-attributes f2))
1750 (nth 5 (file-attributes f1)))))))
1751
1752 (defun ivy--sort (name candidates)
1753 "Re-sort CANDIDATES according to NAME.
1754 All CANDIDATES are assumed to match NAME."
1755 (let ((key (or (ivy-state-caller ivy-last)
1756 (when (functionp (ivy-state-collection ivy-last))
1757 (ivy-state-collection ivy-last))))
1758 fun)
1759 (cond ((and (require 'flx nil 'noerror)
1760 (eq ivy--regex-function 'ivy--regex-fuzzy))
1761 (ivy--flx-sort name candidates))
1762 ((setq fun (cdr (or (assoc key ivy-sort-matches-functions-alist)
1763 (assoc t ivy-sort-matches-functions-alist))))
1764 (funcall fun name candidates))
1765 (t
1766 candidates))))
1767
1768 (defun ivy--prefix-sort (name candidates)
1769 "Re-sort CANDIDATES.
1770 Prefix matches to NAME are put ahead of the list."
1771 (if (or (string-match "^\\^" name) (string= name ""))
1772 candidates
1773 (let ((re-prefix (concat "^" (funcall ivy--regex-function name)))
1774 res-prefix
1775 res-noprefix)
1776 (dolist (s candidates)
1777 (if (string-match re-prefix s)
1778 (push s res-prefix)
1779 (push s res-noprefix)))
1780 (nconc
1781 (nreverse res-prefix)
1782 (nreverse res-noprefix)))))
1783
1784 (defun ivy--recompute-index (name re-str cands)
1785 (let* ((caller (ivy-state-caller ivy-last))
1786 (func (or (and caller (cdr (assoc caller ivy-index-functions-alist)))
1787 (cdr (assoc t ivy-index-functions-alist))
1788 #'ivy-recompute-index-zero)))
1789 (unless (eq this-command 'ivy-resume)
1790 (setq ivy--index
1791 (or
1792 (cl-position (if (and (> (length re-str) 0)
1793 (eq ?^ (aref re-str 0)))
1794 (substring re-str 1)
1795 re-str) cands
1796 :test #'equal)
1797 (and ivy--directory
1798 (cl-position
1799 (concat re-str "/") cands
1800 :test #'equal))
1801 (and (not (string= name ""))
1802 (not (and (require 'flx nil 'noerror)
1803 (eq ivy--regex-function 'ivy--regex-fuzzy)
1804 (< (length cands) 200)))
1805
1806 (cl-position (nth ivy--index ivy--old-cands)
1807 cands))
1808 (funcall func re-str cands))))
1809 (when (and (or (string= name "")
1810 (string= name "^"))
1811 (not (equal ivy--old-re "")))
1812 (setq ivy--index
1813 (or (ivy--preselect-index
1814 (ivy-state-preselect ivy-last)
1815 cands)
1816 ivy--index)))))
1817
1818 (defun ivy-recompute-index-swiper (_re-str cands)
1819 (let ((tail (nthcdr ivy--index ivy--old-cands))
1820 idx)
1821 (if (and tail ivy--old-cands (not (equal "^" ivy--old-re)))
1822 (progn
1823 (while (and tail (null idx))
1824 ;; Compare with eq to handle equal duplicates in cands
1825 (setq idx (cl-position (pop tail) cands)))
1826 (or idx 0))
1827 (if ivy--old-cands
1828 ivy--index
1829 ;; already in ivy-state-buffer
1830 (let ((n (line-number-at-pos))
1831 (res 0)
1832 (i 0))
1833 (dolist (c cands)
1834 (when (eq n (read (get-text-property 0 'display c)))
1835 (setq res i))
1836 (cl-incf i))
1837 res)))))
1838
1839 (defun ivy-recompute-index-zero (_re-str _cands)
1840 0)
1841
1842 (defun ivy--flx-sort (name cands)
1843 "Sort according to closeness to string NAME the string list CANDS."
1844 (condition-case nil
1845 (if (and cands
1846 (< (length cands) 200))
1847 (let* ((flx-name (if (string-match "^\\^" name)
1848 (substring name 1)
1849 name))
1850 (cands-with-score
1851 (delq nil
1852 (mapcar
1853 (lambda (x)
1854 (let ((score (car (flx-score x flx-name ivy--flx-cache))))
1855 (and score
1856 (cons score x))))
1857 cands))))
1858 (if cands-with-score
1859 (mapcar #'cdr
1860 (sort cands-with-score
1861 (lambda (x y)
1862 (> (car x) (car y)))))
1863 cands))
1864 cands)
1865 (error
1866 cands)))
1867
1868 (defvar ivy-format-function 'ivy-format-function-default
1869 "Function to transform the list of candidates into a string.
1870 This string will be inserted into the minibuffer.")
1871
1872 (defun ivy--truncate-string (str width)
1873 "Truncate STR to WIDTH."
1874 (if (> (string-width str) width)
1875 (concat (substring str 0 (min (- width 3)
1876 (- (length str) 3))) "...")
1877 str))
1878
1879 (defun ivy-format-function-default (cands)
1880 "Transform CANDS into a string for minibuffer."
1881 (if (bound-and-true-p truncate-lines)
1882 (mapconcat #'identity cands "\n")
1883 (let ((ww (- (window-width)
1884 (if (and (boundp 'fringe-mode) (eq fringe-mode 0)) 1 0))))
1885 (mapconcat
1886 (if truncate-lines
1887 (lambda (s)
1888 (ivy--truncate-string s ww))
1889 #'identity)
1890 cands "\n"))))
1891
1892 (defun ivy-format-function-arrow (cands)
1893 "Transform CANDS into a string for minibuffer."
1894 (let ((i -1))
1895 (mapconcat
1896 (lambda (s)
1897 (concat (if (eq (cl-incf i) ivy--index)
1898 "> "
1899 " ")
1900 s))
1901 cands "\n")))
1902
1903 (defface ivy-minibuffer-match-face-1
1904 '((((class color) (background light))
1905 :background "#d3d3d3")
1906 (((class color) (background dark))
1907 :background "#555555"))
1908 "The background face for `ivy' minibuffer matches.")
1909
1910 (defface ivy-minibuffer-match-face-2
1911 '((((class color) (background light))
1912 :background "#e99ce8" :weight bold)
1913 (((class color) (background dark))
1914 :background "#777777" :weight bold))
1915 "Face for `ivy' minibuffer matches modulo 1.")
1916
1917 (defface ivy-minibuffer-match-face-3
1918 '((((class color) (background light))
1919 :background "#bbbbff" :weight bold)
1920 (((class color) (background dark))
1921 :background "#7777ff" :weight bold))
1922 "Face for `ivy' minibuffer matches modulo 2.")
1923
1924 (defface ivy-minibuffer-match-face-4
1925 '((((class color) (background light))
1926 :background "#ffbbff" :weight bold)
1927 (((class color) (background dark))
1928 :background "#8a498a" :weight bold))
1929 "Face for `ivy' minibuffer matches modulo 3.")
1930
1931 (defcustom ivy-minibuffer-faces
1932 '(ivy-minibuffer-match-face-1
1933 ivy-minibuffer-match-face-2
1934 ivy-minibuffer-match-face-3
1935 ivy-minibuffer-match-face-4)
1936 "List of `ivy' faces for minibuffer group matches.")
1937
1938 (defun ivy--format-minibuffer-line (str)
1939 (let ((start 0)
1940 (str (copy-sequence str)))
1941 (when (eq ivy-display-style 'fancy)
1942 (unless ivy--old-re
1943 (setq ivy--old-re (funcall ivy--regex-function ivy-text)))
1944 (while (and (string-match ivy--old-re str start)
1945 (> (- (match-end 0) (match-beginning 0)) 0))
1946 (setq start (match-end 0))
1947 (let ((i 0))
1948 (while (<= i ivy--subexps)
1949 (let ((face
1950 (cond ((zerop ivy--subexps)
1951 (cadr ivy-minibuffer-faces))
1952 ((zerop i)
1953 (car ivy-minibuffer-faces))
1954 (t
1955 (nth (1+ (mod (+ i 2) (1- (length ivy-minibuffer-faces))))
1956 ivy-minibuffer-faces)))))
1957 (if (fboundp 'add-face-text-property)
1958 (add-face-text-property
1959 (match-beginning i)
1960 (match-end i)
1961 face
1962 nil
1963 str)
1964 (font-lock-append-text-property
1965 (match-beginning i)
1966 (match-end i)
1967 'face
1968 face
1969 str)))
1970 (cl-incf i)))))
1971 str))
1972
1973 (defun ivy--format (cands)
1974 "Return a string for CANDS suitable for display in the minibuffer.
1975 CANDS is a list of strings."
1976 (setq ivy--length (length cands))
1977 (when (>= ivy--index ivy--length)
1978 (setq ivy--index (max (1- ivy--length) 0)))
1979 (if (null cands)
1980 (setq ivy--current "")
1981 (let* ((half-height (/ ivy-height 2))
1982 (start (max 0 (- ivy--index half-height)))
1983 (end (min (+ start (1- ivy-height)) ivy--length))
1984 (start (max 0 (min start (- end (1- ivy-height)))))
1985 (cands (cl-subseq cands start end))
1986 (index (- ivy--index start)))
1987 (cond (ivy--directory
1988 (setq cands (mapcar (lambda (x)
1989 (if (string-match-p "/\\'" x)
1990 (propertize x 'face 'ivy-subdir)
1991 x))
1992 cands)))
1993 ((eq (ivy-state-collection ivy-last) 'internal-complete-buffer)
1994 (setq cands (mapcar (lambda (x)
1995 (let ((b (get-buffer x)))
1996 (if (and b
1997 (buffer-file-name b)
1998 (buffer-modified-p b))
1999 (propertize x 'face 'ivy-modified-buffer)
2000 x)))
2001 cands))))
2002 (setq ivy--current (copy-sequence (nth index cands)))
2003 (setq cands (mapcar
2004 #'ivy--format-minibuffer-line
2005 cands))
2006 (setf (nth index cands)
2007 (ivy--add-face (nth index cands) 'ivy-current-match))
2008 (let* ((ivy--index index)
2009 (res (concat "\n" (funcall ivy-format-function cands))))
2010 (put-text-property 0 (length res) 'read-only nil res)
2011 res))))
2012
2013 (defvar ivy--virtual-buffers nil
2014 "Store the virtual buffers alist.")
2015
2016 (defvar recentf-list)
2017
2018 (defface ivy-virtual '((t :inherit font-lock-builtin-face))
2019 "Face used by Ivy for matching virtual buffer names.")
2020
2021 (defcustom ivy-virtual-abbreviate 'name
2022 "The mode of abbreviation for virtual buffer names."
2023 :type '(choice
2024 (const :tag "Only name" name)
2025 (const :tag "Full path" full)
2026 ;; eventually, uniquify
2027 ))
2028
2029 (defun ivy--virtual-buffers ()
2030 "Adapted from `ido-add-virtual-buffers-to-list'."
2031 (unless recentf-mode
2032 (recentf-mode 1))
2033 (let ((bookmarks (and (boundp 'bookmark-alist)
2034 bookmark-alist))
2035 virtual-buffers name)
2036 (dolist (head (append
2037 recentf-list
2038 (delete " - no file -"
2039 (delq nil (mapcar (lambda (bookmark)
2040 (cdr (assoc 'filename bookmark)))
2041 bookmarks)))))
2042 (setq name
2043 (if (eq ivy-virtual-abbreviate 'name)
2044 (file-name-nondirectory head)
2045 (expand-file-name head)))
2046 (when (equal name "")
2047 (setq name (file-name-nondirectory (directory-file-name head))))
2048 (when (equal name "")
2049 (setq name head))
2050 (and (not (equal name ""))
2051 (null (get-file-buffer head))
2052 (not (assoc name virtual-buffers))
2053 (push (cons name head) virtual-buffers)))
2054 (when virtual-buffers
2055 (dolist (comp virtual-buffers)
2056 (put-text-property 0 (length (car comp))
2057 'face 'ivy-virtual
2058 (car comp)))
2059 (setq ivy--virtual-buffers (nreverse virtual-buffers))
2060 (mapcar #'car ivy--virtual-buffers))))
2061
2062 (defun ivy--buffer-list (str &optional virtual)
2063 "Return the buffers that match STR.
2064 When VIRTUAL is non-nil, add virtual buffers."
2065 (delete-dups
2066 (append
2067 (mapcar
2068 (lambda (x)
2069 (if (with-current-buffer x
2070 (file-remote-p
2071 (abbreviate-file-name default-directory)))
2072 (propertize x 'face 'ivy-remote)
2073 x))
2074 (all-completions str 'internal-complete-buffer))
2075 (and virtual
2076 (ivy--virtual-buffers)))))
2077
2078 (defun ivy--switch-buffer-action (buffer)
2079 "Switch to BUFFER.
2080 BUFFER may be a string or nil."
2081 (with-ivy-window
2082 (if (zerop (length buffer))
2083 (switch-to-buffer
2084 ivy-text nil 'force-same-window)
2085 (let ((virtual (assoc buffer ivy--virtual-buffers)))
2086 (if (and virtual
2087 (not (get-buffer buffer)))
2088 (find-file (cdr virtual))
2089 (switch-to-buffer
2090 buffer nil 'force-same-window))))))
2091
2092 (defun ivy--switch-buffer-other-window-action (buffer)
2093 "Switch to BUFFER in other window.
2094 BUFFER may be a string or nil."
2095 (if (zerop (length buffer))
2096 (switch-to-buffer-other-window ivy-text)
2097 (let ((virtual (assoc buffer ivy--virtual-buffers)))
2098 (if (and virtual
2099 (not (get-buffer buffer)))
2100 (find-file-other-window (cdr virtual))
2101 (switch-to-buffer-other-window buffer)))))
2102
2103 (defun ivy--rename-buffer-action (buffer)
2104 "Rename BUFFER."
2105 (let ((new-name (read-string "Rename buffer (to new name): ")))
2106 (with-current-buffer buffer
2107 (rename-buffer new-name))))
2108
2109 (defvar ivy-switch-buffer-map (make-sparse-keymap))
2110
2111 (ivy-set-actions
2112 'ivy-switch-buffer
2113 '(("k"
2114 (lambda (x)
2115 (kill-buffer x)
2116 (ivy--reset-state ivy-last))
2117 "kill")
2118 ("j"
2119 ivy--switch-buffer-other-window-action
2120 "other")
2121 ("r"
2122 ivy--rename-buffer-action
2123 "rename")))
2124
2125 ;;;###autoload
2126 (defun ivy-switch-buffer ()
2127 "Switch to another buffer."
2128 (interactive)
2129 (if (not ivy-mode)
2130 (call-interactively 'switch-to-buffer)
2131 (let ((this-command 'ivy-switch-buffer))
2132 (ivy-read "Switch to buffer: " 'internal-complete-buffer
2133 :preselect (buffer-name (other-buffer (current-buffer)))
2134 :action #'ivy--switch-buffer-action
2135 :keymap ivy-switch-buffer-map))))
2136
2137 ;;;###autoload
2138 (defun ivy-recentf ()
2139 "Find a file on `recentf-list'."
2140 (interactive)
2141 (ivy-read "Recentf: " recentf-list
2142 :action
2143 (lambda (f)
2144 (with-ivy-window
2145 (find-file f)))))
2146
2147 (defun ivy-yank-word ()
2148 "Pull next word from buffer into search string."
2149 (interactive)
2150 (let (amend)
2151 (with-ivy-window
2152 (let ((pt (point))
2153 (le (line-end-position)))
2154 (forward-word 1)
2155 (if (> (point) le)
2156 (goto-char pt)
2157 (setq amend (buffer-substring-no-properties pt (point))))))
2158 (when amend
2159 (insert (replace-regexp-in-string " +" " " amend)))))
2160
2161 (defun ivy-kill-ring-save ()
2162 "Store the current candidates into the kill ring.
2163 If the region is active, forward to `kill-ring-save' instead."
2164 (interactive)
2165 (if (region-active-p)
2166 (call-interactively 'kill-ring-save)
2167 (kill-new
2168 (mapconcat
2169 #'identity
2170 ivy--old-cands
2171 "\n"))))
2172
2173 (defun ivy-insert-current ()
2174 "Make the current candidate into current input.
2175 Don't finish completion."
2176 (interactive)
2177 (delete-minibuffer-contents)
2178 (if (and ivy--directory
2179 (string-match "/$" ivy--current))
2180 (insert (substring ivy--current 0 -1))
2181 (insert ivy--current)))
2182
2183 (defun ivy-toggle-fuzzy ()
2184 "Toggle the re builder between `ivy--regex-fuzzy' and `ivy--regex-plus'."
2185 (interactive)
2186 (setq ivy--old-re nil)
2187 (if (eq ivy--regex-function 'ivy--regex-fuzzy)
2188 (setq ivy--regex-function 'ivy--regex-plus)
2189 (setq ivy--regex-function 'ivy--regex-fuzzy)))
2190
2191 (defun ivy-reverse-i-search ()
2192 "Enter a recursive `ivy-read' session using the current history.
2193 The selected history element will be inserted into the minibufer."
2194 (interactive)
2195 (let ((enable-recursive-minibuffers t)
2196 (history (symbol-value (ivy-state-history ivy-last)))
2197 (old-last ivy-last))
2198 (ivy-read "Reverse-i-search: "
2199 history
2200 :action (lambda (x)
2201 (ivy--reset-state
2202 (setq ivy-last old-last))
2203 (delete-minibuffer-contents)
2204 (insert (substring-no-properties x))
2205 (ivy--cd-maybe)))))
2206
2207 (defun ivy-restrict-to-matches ()
2208 "Restrict candidates to current matches and erase input."
2209 (interactive)
2210 (delete-minibuffer-contents)
2211 (setq ivy--all-candidates
2212 (ivy--filter ivy-text ivy--all-candidates)))
2213
2214 ;;* Occur
2215 (defvar-local ivy-occur-last nil
2216 "Buffer-local value of `ivy-last'.
2217 Can't re-use `ivy-last' because using e.g. `swiper' in the same
2218 buffer would modify `ivy-last'.")
2219
2220 (defvar ivy-occur-mode-map
2221 (let ((map (make-sparse-keymap)))
2222 (define-key map [mouse-1] 'ivy-occur-click)
2223 (define-key map (kbd "RET") 'ivy-occur-press)
2224 (define-key map (kbd "j") 'next-line)
2225 (define-key map (kbd "k") 'previous-line)
2226 (define-key map (kbd "h") 'backward-char)
2227 (define-key map (kbd "l") 'forward-char)
2228 (define-key map (kbd "g") 'ivy-occur-press)
2229 (define-key map (kbd "a") 'ivy-occur-read-action)
2230 (define-key map (kbd "o") 'ivy-occur-dispatch)
2231 (define-key map (kbd "q") 'quit-window)
2232 map)
2233 "Keymap for Ivy Occur mode.")
2234
2235 (define-derived-mode ivy-occur-mode fundamental-mode "Ivy-Occur"
2236 "Major mode for output from \\[ivy-occur].
2237
2238 \\{ivy-occur-mode-map}")
2239
2240 (defvar ivy-occur-grep-mode-map
2241 (let ((map (copy-keymap ivy-occur-mode-map)))
2242 (define-key map (kbd "C-x C-q") 'ivy-wgrep-change-to-wgrep-mode)
2243 map)
2244 "Keymap for Ivy Occur Grep mode.")
2245
2246 (define-derived-mode ivy-occur-grep-mode grep-mode "Ivy-Occur"
2247 "Major mode for output from \\[ivy-occur].
2248
2249 \\{ivy-occur-grep-mode-map}")
2250
2251 (defvar counsel-git-grep-cmd)
2252
2253 (defun ivy-occur ()
2254 "Stop completion and put the current matches into a new buffer.
2255
2256 The new buffer will also remember the current action(s).
2257
2258 While in the *ivy-occur* buffer, selecting a cadidate with RET or
2259 a mouse click will call the appropriate action for that candidate.
2260
2261 It's possible to have an unlimited amount of *ivy-occur* buffers."
2262 (interactive)
2263 (let ((buffer
2264 (generate-new-buffer
2265 (format "*ivy-occur%s \"%s\"*"
2266 (let (caller)
2267 (if (setq caller (ivy-state-caller ivy-last))
2268 (concat " " (prin1-to-string caller))
2269 ""))
2270 ivy-text)))
2271 (do-grep (eq (ivy-state-caller ivy-last) 'counsel-git-grep)))
2272 (with-current-buffer buffer
2273 (if do-grep
2274 (progn
2275 (setq ivy--old-cands
2276 (split-string
2277 (shell-command-to-string
2278 (format counsel-git-grep-cmd ivy--old-re))
2279 "\n"
2280 t))
2281 (ivy-occur-grep-mode))
2282 (ivy-occur-mode))
2283 (setf (ivy-state-text ivy-last) ivy-text)
2284 (setq ivy-occur-last ivy-last)
2285 (setq-local ivy--directory ivy--directory)
2286 (let ((inhibit-read-only t))
2287 (erase-buffer)
2288 (when do-grep
2289 ;; Need precise number of header lines for `wgrep' to work.
2290 (insert (format "-*- mode:grep; default-directory: %S -*-\n\n\n"
2291 default-directory)))
2292 (insert (format "%d candidates:\n" (length ivy--old-cands)))
2293 (dolist (cand ivy--old-cands)
2294 (let ((str (if do-grep
2295 (concat "./" cand)
2296 (concat " " cand))))
2297 (add-text-properties
2298 0 (length str)
2299 `(mouse-face
2300 highlight
2301 help-echo "mouse-1: call ivy-action")
2302 str)
2303 (insert str "\n")))))
2304 (ivy-exit-with-action
2305 `(lambda (_) (pop-to-buffer ,buffer)))))
2306
2307 (declare-function wgrep-change-to-wgrep-mode "ext:wgrep")
2308
2309 (defun ivy-wgrep-change-to-wgrep-mode ()
2310 "Forward to `wgrep-change-to-wgrep-mode'."
2311 (interactive)
2312 (if (require 'wgrep nil 'noerror)
2313 (wgrep-change-to-wgrep-mode)
2314 (error "Package wgrep isn't installed")))
2315
2316 (defun ivy-occur-read-action ()
2317 "Select one of the available actions as the current one."
2318 (interactive)
2319 (let ((ivy-last ivy-occur-last))
2320 (ivy-read-action)))
2321
2322 (defun ivy-occur-dispatch ()
2323 "Call one of the available actions on the current item."
2324 (interactive)
2325 (let* ((state-action (ivy-state-action ivy-occur-last))
2326 (actions (if (symbolp state-action)
2327 state-action
2328 (copy-sequence state-action))))
2329 (unwind-protect
2330 (progn
2331 (ivy-occur-read-action)
2332 (ivy-occur-press))
2333 (setf (ivy-state-action ivy-occur-last) actions))))
2334
2335 (defun ivy-occur-click (event)
2336 "Execute action for the current candidate.
2337 EVENT gives the mouse position."
2338 (interactive "e")
2339 (let ((window (posn-window (event-end event)))
2340 (pos (posn-point (event-end event))))
2341 (with-current-buffer (window-buffer window)
2342 (goto-char pos)
2343 (ivy-occur-press))))
2344
2345 (defun ivy-occur-press ()
2346 "Execute action for the current candidate."
2347 (interactive)
2348 (require 'pulse)
2349 (when (save-excursion
2350 (beginning-of-line)
2351 (looking-at "\\(?:./\\| \\)\\(.*\\)$"))
2352 (let* ((ivy-last ivy-occur-last)
2353 (ivy-text (ivy-state-text ivy-last))
2354 (str (buffer-substring
2355 (match-beginning 1)
2356 (match-end 1)))
2357 (coll (ivy-state-collection ivy-last))
2358 (action (ivy--get-action ivy-last))
2359 (ivy-exit 'done))
2360 (with-ivy-window
2361 (funcall action
2362 (if (and (consp coll)
2363 (consp (car coll)))
2364 (cdr (assoc str coll))
2365 str))
2366 (if (memq (ivy-state-caller ivy-last)
2367 '(swiper counsel-git-grep))
2368 (with-current-buffer (window-buffer (selected-window))
2369 (swiper--cleanup)
2370 (swiper--add-overlays
2371 (ivy--regex ivy-text)
2372 (line-beginning-position)
2373 (line-end-position)
2374 (selected-window))
2375 (run-at-time 0.5 nil 'swiper--cleanup))
2376 (pulse-momentary-highlight-one-line (point)))))))
2377
2378 (provide 'ivy)
2379
2380 ;;; ivy.el ends here