code.delx.au - gnu-emacs-elpa/blob - packages/swiper/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
  41 ;;* Customization
  42 (defgroup ivy nil
  43   "Incremental vertical completion."
  44   :group 'convenience)
  45
  46 (defface ivy-current-match
  47   '((((class color) (background light))
  48      :background "#1a4b77" :foreground "white")
  49     (((class color) (background dark))
  50      :background "#65a7e2" :foreground "black"))
  51   "Face used by Ivy for highlighting first match.")
  52
  53 (defface ivy-confirm-face
  54   '((t :foreground "ForestGreen" :inherit minibuffer-prompt))
  55   "Face used by Ivy to issue a confirmation prompt.")
  56
  57 (defface ivy-match-required-face
  58   '((t :foreground "red" :inherit minibuffer-prompt))
  59   "Face used by Ivy to issue a match required prompt.")
  60
  61 (defface ivy-subdir
  62   '((t (:inherit 'dired-directory)))
  63   "Face used by Ivy for highlighting subdirs in the alternatives.")
  64
  65 (defface ivy-remote
  66   '((t (:foreground "#110099")))
  67   "Face used by Ivy for highlighting remotes in the alternatives.")
  68
  69 (defcustom ivy-height 10
  70   "Number of lines for the minibuffer window."
  71   :type 'integer)
  72
  73 (defcustom ivy-count-format "%-4d "
  74   "The style of showing the current candidate count for `ivy-read'.
  75 Set this to nil if you don't want the count.  You can also set it
  76 to e.g. \"(%d/%d) \" if you want to see both the candidate index
  77 and the candidate count."
  78   :type '(choice (const :tag "Count disabled" nil) string))
  79
  80 (defcustom ivy-wrap nil
  81   "Whether to wrap around after the first and last candidate."
  82   :type 'boolean)
  83
  84 (defcustom ivy-display-style nil
  85   "The style for formatting the minibuffer.
  86
  87 By default, the matched strings will be copied as they are.
  88
  89 With the fancy method, the matching parts of the regexp will be
  90 additionally highlighted, just like `swiper' does it."
  91   :type '(choice
  92           (const :tag "Plain" nil)
  93           (const :tag "Fancy" fancy)))
  94
  95 (defcustom ivy-on-del-error-function 'minibuffer-keyboard-quit
  96   "The handler for when `ivy-backward-delete-char' throws.
  97 This is usually meant as a quick exit out of the minibuffer."
  98   :type 'function)
  99
 100 (defcustom ivy-extra-directories '("../" "./")
 101   "Add this to the front of the list when completing file names.
 102 Only \"./\" and \"../\" apply here. They appear in reverse order."
 103   :type 'list)
 104
 105 (defcustom ivy-use-virtual-buffers nil
 106   "When non-nil, add `recentf-mode' and bookmarks to the list of buffers."
 107   :type 'boolean)
 108
 109 (defvar ivy--actions-list nil
 110   "A list of extra actions per command.")
 111
 112 (defun ivy-set-actions (cmd actions)
 113   "Set CMD extra exit points to ACTIONS."
 114   (setq ivy--actions-list
 115         (plist-put ivy--actions-list cmd actions)))
 116
 117 ;;* Keymap
 118 (require 'delsel)
 119 (defvar ivy-minibuffer-map
 120   (let ((map (make-sparse-keymap)))
 121     (define-key map (kbd "C-m") 'ivy-done)
 122     (define-key map (kbd "C-M-m") 'ivy-call)
 123     (define-key map (kbd "C-j") 'ivy-alt-done)
 124     (define-key map (kbd "C-M-j") 'ivy-immediate-done)
 125     (define-key map (kbd "TAB") 'ivy-partial-or-done)
 126     (define-key map (kbd "C-n") 'ivy-next-line)
 127     (define-key map (kbd "C-p") 'ivy-previous-line)
 128     (define-key map (kbd "<down>") 'ivy-next-line)
 129     (define-key map (kbd "<up>") 'ivy-previous-line)
 130     (define-key map (kbd "C-s") 'ivy-next-line-or-history)
 131     (define-key map (kbd "C-r") 'ivy-reverse-i-search)
 132     (define-key map (kbd "SPC") 'self-insert-command)
 133     (define-key map (kbd "DEL") 'ivy-backward-delete-char)
 134     (define-key map (kbd "M-DEL") 'ivy-backward-kill-word)
 135     (define-key map (kbd "C-d") 'ivy-delete-char)
 136     (define-key map (kbd "C-f") 'ivy-forward-char)
 137     (define-key map (kbd "M-d") 'ivy-kill-word)
 138     (define-key map (kbd "M-<") 'ivy-beginning-of-buffer)
 139     (define-key map (kbd "M->") 'ivy-end-of-buffer)
 140     (define-key map (kbd "M-n") 'ivy-next-history-element)
 141     (define-key map (kbd "M-p") 'ivy-previous-history-element)
 142     (define-key map (kbd "C-g") 'minibuffer-keyboard-quit)
 143     (define-key map (kbd "C-v") 'ivy-scroll-up-command)
 144     (define-key map (kbd "M-v") 'ivy-scroll-down-command)
 145     (define-key map (kbd "C-M-n") 'ivy-next-line-and-call)
 146     (define-key map (kbd "C-M-p") 'ivy-previous-line-and-call)
 147     (define-key map (kbd "M-q") 'ivy-toggle-regexp-quote)
 148     (define-key map (kbd "M-j") 'ivy-yank-word)
 149     (define-key map (kbd "M-i") 'ivy-insert-current)
 150     (define-key map (kbd "C-o") 'hydra-ivy/body)
 151     (define-key map (kbd "M-o") 'ivy-dispatching-done)
 152     (define-key map (kbd "C-k") 'ivy-kill-line)
 153     (define-key map (kbd "S-SPC") 'ivy-restrict-to-matches)
 154     (define-key map (kbd "M-w") 'ivy-kill-ring-save)
 155     map)
 156   "Keymap used in the minibuffer.")
 157 (autoload 'hydra-ivy/body "ivy-hydra" "" t)
 158
 159 (defvar ivy-mode-map
 160   (let ((map (make-sparse-keymap)))
 161     (define-key map [remap switch-to-buffer] 'ivy-switch-buffer)
 162     map)
 163   "Keymap for `ivy-mode'.")
 164
 165 ;;* Globals
 166 (cl-defstruct ivy-state
 167   prompt collection
 168   predicate require-match initial-input
 169   history preselect keymap update-fn sort
 170   ;; The window in which `ivy-read' was called
 171   window
 172   action
 173   unwind
 174   re-builder
 175   matcher
 176   ;; When this is non-nil, call it for each input change to get new candidates
 177   dynamic-collection)
 178
 179 (defvar ivy-last nil
 180   "The last parameters passed to `ivy-read'.")
 181
 182 (defsubst ivy-set-action (action)
 183   (setf (ivy-state-action ivy-last) action))
 184
 185 (defvar ivy-history nil
 186   "History list of candidates entered in the minibuffer.
 187
 188 Maximum length of the history list is determined by the value
 189 of `history-length', which see.")
 190
 191 (defvar ivy--directory nil
 192   "Current directory when completing file names.")
 193
 194 (defvar ivy--length 0
 195   "Store the amount of viable candidates.")
 196
 197 (defvar ivy-text ""
 198   "Store the user's string as it is typed in.")
 199
 200 (defvar ivy--current ""
 201   "Current candidate.")
 202
 203 (defvar ivy--index 0
 204   "Store the index of the current candidate.")
 205
 206 (defvar ivy-exit nil
 207   "Store 'done if the completion was successfully selected.
 208 Otherwise, store nil.")
 209
 210 (defvar ivy--all-candidates nil
 211   "Store the candidates passed to `ivy-read'.")
 212
 213 (defvar ivy--default nil
 214   "Default initial input.")
 215
 216 (defvar ivy--prompt nil
 217   "Store the format-style prompt.
 218 When non-nil, it should contain one %d.")
 219
 220 (defvar ivy--prompt-extra ""
 221   "Temporary modifications to the prompt.")
 222
 223 (defvar ivy--old-re nil
 224   "Store the old regexp.")
 225
 226 (defvar ivy--old-cands nil
 227   "Store the candidates matched by `ivy--old-re'.")
 228
 229 (defvar ivy--regex-function 'ivy--regex
 230   "Current function for building a regex.")
 231
 232 (defvar ivy--subexps 0
 233   "Number of groups in the current `ivy--regex'.")
 234
 235 (defvar ivy--full-length nil
 236   "When :dynamic-collection is non-nil, this can be the total amount of candidates.")
 237
 238 (defvar ivy--old-text ""
 239   "Store old `ivy-text' for dynamic completion.")
 240
 241 (defvar Info-current-file)
 242
 243 (defmacro ivy-quit-and-run (&rest body)
 244   "Quit the minibuffer and run BODY afterwards."
 245   `(progn
 246      (put 'quit 'error-message "")
 247      (run-at-time nil nil
 248                   (lambda ()
 249                     (put 'quit 'error-message "Quit")
 250                     ,@body))
 251      (minibuffer-keyboard-quit)))
 252
 253 (defmacro with-ivy-window (&rest body)
 254   "Execute BODY in the window from which `ivy-read' was called."
 255   (declare (indent 0)
 256            (debug t))
 257   `(with-selected-window (ivy-state-window ivy-last)
 258      ,@body))
 259
 260 (defun ivy--done (text)
 261   "Insert TEXT and exit minibuffer."
 262   (if (and ivy--directory
 263            (not (eq (ivy-state-history ivy-last) 'grep-files-history)))
 264       (insert (setq ivy--current (expand-file-name
 265                                   text ivy--directory)))
 266     (insert (setq ivy--current text)))
 267   (setq ivy-exit 'done)
 268   (exit-minibuffer))
 269
 270 ;;* Commands
 271 (defun ivy-done ()
 272   "Exit the minibuffer with the selected candidate."
 273   (interactive)
 274   (delete-minibuffer-contents)
 275   (cond ((> ivy--length 0)
 276          (ivy--done ivy--current))
 277         ((memq (ivy-state-collection ivy-last)
 278                '(read-file-name-internal internal-complete-buffer))
 279          (if (or (not (eq confirm-nonexistent-file-or-buffer t))
 280                  (equal " (confirm)" ivy--prompt-extra))
 281              (ivy--done ivy-text)
 282            (setq ivy--prompt-extra " (confirm)")
 283            (insert ivy-text)
 284            (ivy--exhibit)))
 285         ((memq (ivy-state-require-match ivy-last)
 286                '(nil confirm confirm-after-completion))
 287          (ivy--done ivy-text))
 288         (t
 289          (setq ivy--prompt-extra " (match required)")
 290          (insert ivy-text)
 291          (ivy--exhibit))))
 292
 293 (defun ivy-dispatching-done ()
 294   "Select one of the available actions and call `ivy-done'."
 295   (interactive)
 296   (let ((actions (ivy-state-action ivy-last)))
 297     (if (null (ivy--actionp actions))
 298         (ivy-done)
 299       (let* ((hint (concat ivy--current
 300                            "\n"
 301                            (mapconcat
 302                             (lambda (x)
 303                               (format "%s: %s"
 304                                       (propertize
 305                                        (car x)
 306                                        'face 'font-lock-builtin-face)
 307                                       (nth 2 x)))
 308                             (cdr actions)
 309                             "\n")
 310                            "\n"))
 311              (key (string (read-key hint)))
 312              (action (assoc key (cdr actions))))
 313         (cond ((string= key "\a"))
 314               ((null action)
 315                (error "%s is not bound" key))
 316               (t
 317                (message "")
 318                (ivy-set-action (nth 1 action))
 319                (ivy-done)))))))
 320
 321 (defun ivy-build-tramp-name (x)
 322   "Reconstruct X into a path.
 323 Is is a cons cell, related to `tramp-get-completion-function'."
 324   (let ((user (car x))
 325         (domain (cadr x)))
 326     (if user
 327         (concat user "@" domain)
 328       domain)))
 329
 330 (declare-function tramp-get-completion-function "tramp")
 331 (declare-function Info-find-node "info")
 332
 333 (defun ivy-alt-done (&optional arg)
 334   "Exit the minibuffer with the selected candidate.
 335 When ARG is t, exit with current text, ignoring the candidates."
 336   (interactive "P")
 337   (let (dir)
 338     (cond (arg
 339            (ivy-immediate-done))
 340           ((and ivy--directory
 341                 (or
 342                  (and
 343                   (not (string= ivy--current "./"))
 344                   (cl-plusp ivy--length)
 345                   (file-directory-p
 346                    (setq dir (expand-file-name
 347                               ivy--current ivy--directory))))))
 348            (ivy--cd dir)
 349            (ivy--exhibit))
 350           ((eq (ivy-state-collection ivy-last) 'Info-read-node-name-1)
 351            (if (or (equal ivy--current "(./)")
 352                    (equal ivy--current "(../)"))
 353                (ivy-quit-and-run
 354                 (ivy-read "Go to file: " 'read-file-name-internal
 355                           :action (lambda (x)
 356                                     (Info-find-node
 357                                      (expand-file-name x ivy--directory)
 358                                      "Top"))))
 359              (ivy-done)))
 360           ((and ivy--directory
 361                 (string-match "\\`/[^/]+:.*:.*\\'" ivy-text))
 362            (ivy-done))
 363           ((and ivy--directory
 364                 (string-match
 365                  "\\`/\\([^/]+?\\):\\(?:\\(.*\\)@\\)?\\(.*\\)\\'"
 366                  ivy-text))
 367            (let ((method (match-string 1 ivy-text))
 368                  (user (match-string 2 ivy-text))
 369                  (rest (match-string 3 ivy-text))
 370                  res)
 371              (require 'tramp)
 372              (dolist (x (tramp-get-completion-function method))
 373                (setq res (append res (funcall (car x) (cadr x)))))
 374              (setq res (delq nil res))
 375              (when user
 376                (dolist (x res)
 377                  (setcar x user)))
 378              (setq res (cl-delete-duplicates res :test #'equal))
 379              (let* ((old-ivy-last ivy-last)
 380                     (enable-recursive-minibuffers t)
 381                     (host (ivy-read "Find File: "
 382                                     (mapcar #'ivy-build-tramp-name res)
 383                                     :initial-input rest)))
 384                (setq ivy-last old-ivy-last)
 385                (when host
 386                  (setq ivy--directory "/")
 387                  (ivy--cd (concat "/" method ":" host ":"))))))
 388           (t
 389            (ivy-done)))))
 390
 391 (defcustom ivy-tab-space nil
 392   "When non-nil, `ivy-partial-or-done' should insert a space."
 393   :type 'boolean)
 394
 395 (defun ivy-partial-or-done ()
 396   "Complete the minibuffer text as much as possible.
 397 If the text hasn't changed as a result, forward to `ivy-alt-done'."
 398   (interactive)
 399   (if (and (eq (ivy-state-collection ivy-last) #'read-file-name-internal)
 400            (string-match "\\`/" ivy-text))
 401       (let ((default-directory ivy--directory))
 402         (minibuffer-complete)
 403         (setq ivy-text (ivy--input))
 404         (when (and (file-directory-p ivy-text)
 405                    (= ivy--length 1))
 406           (ivy--cd (expand-file-name ivy-text))))
 407     (or (ivy-partial)
 408         (when (or (eq this-command last-command)
 409                   (eq ivy--length 1))
 410           (ivy-alt-done)))))
 411
 412 (defun ivy-partial ()
 413   "Complete the minibuffer text as much as possible."
 414   (interactive)
 415   (let* ((parts (or (split-string ivy-text " " t) (list "")))
 416          (postfix (car (last parts)))
 417          (completion-ignore-case t)
 418          (startp (string-match "^\\^" postfix))
 419          (new (try-completion (if startp
 420                                   (substring postfix 1)
 421                                 postfix)
 422                               (mapcar (lambda (str) (substring str (string-match postfix str)))
 423                                       ivy--old-cands))))
 424     (cond ((eq new t) nil)
 425           ((string= new ivy-text) nil)
 426           (new
 427            (delete-region (minibuffer-prompt-end) (point-max))
 428            (setcar (last parts)
 429                    (if startp
 430                        (concat "^" new)
 431                      new))
 432            (insert (mapconcat #'identity parts " ")
 433                    (if ivy-tab-space " " ""))
 434            t))))
 435
 436 (defun ivy-immediate-done ()
 437   "Exit the minibuffer with the current input."
 438   (interactive)
 439   (delete-minibuffer-contents)
 440   (insert (setq ivy--current ivy-text))
 441   (setq ivy-exit 'done)
 442   (exit-minibuffer))
 443
 444 ;;;###autoload
 445 (defun ivy-resume ()
 446   "Resume the last completion session."
 447   (interactive)
 448   (ivy-read
 449    (ivy-state-prompt ivy-last)
 450    (ivy-state-collection ivy-last)
 451    :predicate (ivy-state-predicate ivy-last)
 452    :require-match (ivy-state-require-match ivy-last)
 453    :initial-input ivy-text
 454    :history (ivy-state-history ivy-last)
 455    :preselect (unless (eq (ivy-state-collection ivy-last)
 456                           'read-file-name-internal)
 457                 (regexp-quote ivy--current))
 458    :keymap (ivy-state-keymap ivy-last)
 459    :update-fn (ivy-state-update-fn ivy-last)
 460    :sort (ivy-state-sort ivy-last)
 461    :action (ivy-state-action ivy-last)
 462    :unwind (ivy-state-unwind ivy-last)
 463    :re-builder (ivy-state-re-builder ivy-last)
 464    :matcher (ivy-state-matcher ivy-last)
 465    :dynamic-collection (ivy-state-dynamic-collection ivy-last)))
 466
 467 (defvar ivy-calling nil
 468   "When non-nil, call the current action when `ivy--index' changes.")
 469
 470 (defun ivy-set-index (index)
 471   "Set `ivy--index' to INDEX."
 472   (setq ivy--index index)
 473   (when ivy-calling
 474     (ivy--exhibit)
 475     (ivy-call)))
 476
 477 (defun ivy-beginning-of-buffer ()
 478   "Select the first completion candidate."
 479   (interactive)
 480   (ivy-set-index 0))
 481
 482 (defun ivy-end-of-buffer ()
 483   "Select the last completion candidate."
 484   (interactive)
 485   (ivy-set-index (1- ivy--length)))
 486
 487 (defun ivy-scroll-up-command ()
 488   "Scroll the candidates upward by the minibuffer height."
 489   (interactive)
 490   (ivy-set-index (min (+ ivy--index ivy-height)
 491                       (1- ivy--length))))
 492
 493 (defun ivy-scroll-down-command ()
 494   "Scroll the candidates downward by the minibuffer height."
 495   (interactive)
 496   (ivy-set-index (max (- ivy--index ivy-height)
 497                       0)))
 498
 499 (defun ivy-minibuffer-grow ()
 500   "Grow the minibuffer window by 1 line."
 501   (interactive)
 502   (setq-local max-mini-window-height
 503               (cl-incf ivy-height)))
 504
 505 (defun ivy-minibuffer-shrink ()
 506   "Shrink the minibuffer window by 1 line."
 507   (interactive)
 508   (unless (<= ivy-height 2)
 509     (setq-local max-mini-window-height
 510                 (cl-decf ivy-height))
 511     (window-resize (selected-window) -1)))
 512
 513 (defun ivy-next-line (&optional arg)
 514   "Move cursor vertically down ARG candidates."
 515   (interactive "p")
 516   (setq arg (or arg 1))
 517   (let ((index (+ ivy--index arg)))
 518     (if (> index (1- ivy--length))
 519         (if ivy-wrap
 520             (ivy-beginning-of-buffer)
 521           (ivy-set-index (1- ivy--length)))
 522       (ivy-set-index index))))
 523
 524 (defun ivy-next-line-or-history (&optional arg)
 525   "Move cursor vertically down ARG candidates.
 526 If the input is empty, select the previous history element instead."
 527   (interactive "p")
 528   (when (string= ivy-text "")
 529     (ivy-previous-history-element 1))
 530   (ivy-next-line arg))
 531
 532 (defun ivy-previous-line (&optional arg)
 533   "Move cursor vertically up ARG candidates."
 534   (interactive "p")
 535   (setq arg (or arg 1))
 536   (let ((index (- ivy--index arg)))
 537     (if (< index 0)
 538         (if ivy-wrap
 539             (ivy-end-of-buffer)
 540           (ivy-set-index 0))
 541       (ivy-set-index index))))
 542
 543 (defun ivy-previous-line-or-history (arg)
 544   "Move cursor vertically up ARG candidates.
 545 If the input is empty, select the previous history element instead."
 546   (interactive "p")
 547   (when (string= ivy-text "")
 548     (ivy-previous-history-element 1))
 549   (ivy-previous-line arg))
 550
 551 (defun ivy-toggle-calling ()
 552   "Flip `ivy-calling'."
 553   (interactive)
 554   (when (setq ivy-calling (not ivy-calling))
 555     (ivy-call)))
 556
 557 (defun ivy--get-action (state)
 558   "Get the action function from STATE."
 559   (let ((action (ivy-state-action state)))
 560     (when action
 561       (if (functionp action)
 562           action
 563         (cadr (nth (car action) action))))))
 564
 565 (defun ivy--actionp (x)
 566   "Return non-nil when X is a list of actions."
 567   (and x (listp x) (not (eq (car x) 'closure))))
 568
 569 (defun ivy-next-action ()
 570   "When the current action is a list, scroll it forwards."
 571   (interactive)
 572   (let ((action (ivy-state-action ivy-last)))
 573     (when (ivy--actionp action)
 574       (unless (>= (car action) (1- (length action)))
 575         (cl-incf (car action))))))
 576
 577 (defun ivy-prev-action ()
 578   "When the current action is a list, scroll it backwards."
 579   (interactive)
 580   (let ((action (ivy-state-action ivy-last)))
 581     (when (ivy--actionp action)
 582       (unless (<= (car action) 1)
 583         (cl-decf (car action))))))
 584
 585 (defun ivy-action-name ()
 586   "Return the name associated with the current action."
 587   (let ((action (ivy-state-action ivy-last)))
 588     (if (ivy--actionp action)
 589         (format "[%d/%d] %s"
 590                 (car action)
 591                 (1- (length action))
 592                 (nth 2 (nth (car action) action)))
 593       "[1/1] default")))
 594
 595 (defun ivy-call ()
 596   "Call the current action without exiting completion."
 597   (interactive)
 598   (let ((action (ivy--get-action ivy-last)))
 599     (when action
 600       (let* ((collection (ivy-state-collection ivy-last))
 601              (x (if (and (consp collection)
 602                          (consp (car collection)))
 603                     (cdr (assoc ivy--current collection))
 604                   (if (equal ivy--current "")
 605                       ivy-text
 606                     ivy--current))))
 607         (funcall action x)))))
 608
 609 (defun ivy-next-line-and-call (&optional arg)
 610   "Move cursor vertically down ARG candidates.
 611 Call the permanent action if possible."
 612   (interactive "p")
 613   (ivy-next-line arg)
 614   (ivy--exhibit)
 615   (ivy-call))
 616
 617 (defun ivy-previous-line-and-call (&optional arg)
 618   "Move cursor vertically down ARG candidates.
 619 Call the permanent action if possible."
 620   (interactive "p")
 621   (ivy-previous-line arg)
 622   (ivy--exhibit)
 623   (ivy-call))
 624
 625 (defun ivy-previous-history-element (arg)
 626   "Forward to `previous-history-element' with ARG."
 627   (interactive "p")
 628   (previous-history-element arg)
 629   (ivy--cd-maybe)
 630   (move-end-of-line 1)
 631   (ivy--maybe-scroll-history))
 632
 633 (defun ivy-next-history-element (arg)
 634   "Forward to `next-history-element' with ARG."
 635   (interactive "p")
 636   (next-history-element arg)
 637   (ivy--cd-maybe)
 638   (move-end-of-line 1)
 639   (ivy--maybe-scroll-history))
 640
 641 (defun ivy--cd-maybe ()
 642   "Check if the current input points to a different directory.
 643 If so, move to that directory, while keeping only the file name."
 644   (when ivy--directory
 645     (let* ((input (expand-file-name (ivy--input)))
 646            (file (file-name-nondirectory input))
 647            (dir (expand-file-name (file-name-directory input))))
 648       (if (string= dir ivy--directory)
 649           (progn
 650             (delete-minibuffer-contents)
 651             (insert file))
 652         (ivy--cd dir)
 653         (insert file)))))
 654
 655 (defun ivy--maybe-scroll-history ()
 656   "If the selected history element has an index, scroll there."
 657   (let ((idx (ignore-errors
 658                (get-text-property
 659                 (minibuffer-prompt-end)
 660                 'ivy-index))))
 661     (when idx
 662       (ivy--exhibit)
 663       (setq ivy--index idx))))
 664
 665 (defun ivy--cd (dir)
 666   "When completing file names, move to directory DIR."
 667   (if (null ivy--directory)
 668       (error "Unexpected")
 669     (setq ivy--old-cands nil)
 670     (setq ivy--old-re nil)
 671     (setq ivy--index 0)
 672     (setq ivy--all-candidates
 673           (ivy--sorted-files (setq ivy--directory dir)))
 674     (setq ivy-text "")
 675     (delete-minibuffer-contents)))
 676
 677 (defun ivy-backward-delete-char ()
 678   "Forward to `backward-delete-char'.
 679 On error (read-only), call `ivy-on-del-error-function'."
 680   (interactive)
 681   (if (and ivy--directory (= (minibuffer-prompt-end) (point)))
 682       (progn
 683         (ivy--cd (file-name-directory
 684                   (directory-file-name
 685                    (expand-file-name
 686                     ivy--directory))))
 687         (ivy--exhibit))
 688     (condition-case nil
 689         (backward-delete-char 1)
 690       (error
 691        (when ivy-on-del-error-function
 692          (funcall ivy-on-del-error-function))))))
 693
 694 (defun ivy-delete-char (arg)
 695   "Forward to `delete-char' ARG."
 696   (interactive "p")
 697   (unless (= (point) (line-end-position))
 698     (delete-char arg)))
 699
 700 (defun ivy-forward-char (arg)
 701   "Forward to `forward-char' ARG."
 702   (interactive "p")
 703   (unless (= (point) (line-end-position))
 704     (forward-char arg)))
 705
 706 (defun ivy-kill-word (arg)
 707   "Forward to `kill-word' ARG."
 708   (interactive "p")
 709   (unless (= (point) (line-end-position))
 710     (kill-word arg)))
 711
 712 (defun ivy-kill-line ()
 713   "Forward to `kill-line'."
 714   (interactive)
 715   (if (eolp)
 716       (kill-region (minibuffer-prompt-end) (point))
 717     (kill-line)))
 718
 719 (defun ivy-backward-kill-word ()
 720   "Forward to `backward-kill-word'."
 721   (interactive)
 722   (if (and ivy--directory (= (minibuffer-prompt-end) (point)))
 723       (progn
 724         (ivy--cd (file-name-directory
 725                   (directory-file-name
 726                    (expand-file-name
 727                     ivy--directory))))
 728         (ivy--exhibit))
 729     (ignore-errors
 730       (let ((pt (point)))
 731         (forward-word -1)
 732         (delete-region (point) pt)))))
 733
 734 (defvar ivy--regexp-quote 'regexp-quote
 735   "Store the regexp quoting state.")
 736
 737 (defun ivy-toggle-regexp-quote ()
 738   "Toggle the regexp quoting."
 739   (interactive)
 740   (setq ivy--old-re nil)
 741   (cl-rotatef ivy--regex-function ivy--regexp-quote))
 742
 743 (defun ivy-sort-file-function-default (x y)
 744   "Compare two files X and Y.
 745 Prioritize directories."
 746   (if (get-text-property 0 'dirp x)
 747       (if (get-text-property 0 'dirp y)
 748           (string< x y)
 749         t)
 750     (if (get-text-property 0 'dirp y)
 751         nil
 752       (string< x y))))
 753
 754 (defvar ivy-sort-functions-alist
 755   '((read-file-name-internal . ivy-sort-file-function-default)
 756     (internal-complete-buffer . nil)
 757     (counsel-git-grep-function . nil)
 758     (Man-goto-section . nil)
 759     (org-refile . nil)
 760     (t . string-lessp))
 761   "An alist of sorting functions for each collection function.
 762 Interactive functions that call completion fit in here as well.
 763
 764 For each entry, nil means no sorting.  It's very useful to turn
 765 off the sorting for functions that have candidates in the natural
 766 buffer order, like `org-refile' or `Man-goto-section'.
 767
 768 The entry associated to t is used for all fall-through cases.")
 769
 770 (defvar ivy-re-builders-alist
 771   '((t . ivy--regex-plus))
 772   "An alist of regex building functions for each collection function.
 773 Each function should take a string and return a valid regex or a
 774 regex sequence (see below).
 775
 776 The entry associated to t is used for all fall-through cases.
 777 Possible choices: `ivy--regex', `regexp-quote', `ivy--regex-plus'.
 778
 779 In case a function returns a list, it should look like this:
 780 '((\"matching-regexp\" . t) (\"non-matching-regexp\") ...).
 781
 782 The matches will be filtered in a sequence, you can mix the
 783 regexps that should match and that should not match as you
 784 like.")
 785
 786 (defvar ivy-initial-inputs-alist
 787   '((org-refile . "^")
 788     (org-agenda-refile . "^")
 789     (org-capture-refile . "^")
 790     (counsel-M-x . "^")
 791     (counsel-describe-function . "^")
 792     (counsel-describe-variable . "^")
 793     (man . "^")
 794     (woman . "^"))
 795   "Command to initial input table.")
 796
 797 (defcustom ivy-sort-max-size 30000
 798   "Sorting won't be done for collections larger than this."
 799   :type 'integer)
 800
 801 (defun ivy--sorted-files (dir)
 802   "Return the list of files in DIR.
 803 Directories come first."
 804   (let* ((default-directory dir)
 805          (seq (all-completions "" 'read-file-name-internal))
 806          sort-fn)
 807     (if (equal dir "/")
 808         seq
 809       (setq seq (delete "./" (delete "../" seq)))
 810       (when (eq (setq sort-fn (cdr (assoc 'read-file-name-internal
 811                                           ivy-sort-functions-alist)))
 812                 #'ivy-sort-file-function-default)
 813         (setq seq (mapcar (lambda (x)
 814                             (propertize x 'dirp (string-match-p "/\\'" x)))
 815                           seq)))
 816       (when sort-fn
 817         (setq seq (cl-sort seq sort-fn)))
 818       (dolist (dir ivy-extra-directories)
 819         (push dir seq))
 820       seq)))
 821
 822 ;;** Entry Point
 823 (cl-defun ivy-read (prompt collection
 824                     &key predicate require-match initial-input
 825                       history preselect keymap update-fn sort
 826                       action unwind re-builder matcher dynamic-collection)
 827   "Read a string in the minibuffer, with completion.
 828
 829 PROMPT is a string to prompt with; normally it ends in a colon
 830 and a space.  When PROMPT contains %d, it will be updated with
 831 the current number of matching candidates.  If % appears elsewhere
 832 in the PROMPT it should be quoted as %%.
 833 See also `ivy-count-format'.
 834
 835 COLLECTION is a list of strings.
 836
 837 If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.
 838
 839 KEYMAP is composed together with `ivy-minibuffer-map'.
 840
 841 If PRESELECT is non-nil select the corresponding candidate out of
 842 the ones that match INITIAL-INPUT.
 843
 844 UPDATE-FN is called each time the current candidate(s) is changed.
 845
 846 When SORT is t, refer to `ivy-sort-functions-alist' for sorting.
 847
 848 ACTION is a lambda to call after a result was selected. It should
 849 take a single argument, usually a string.
 850
 851 UNWIND is a lambda to call before exiting.
 852
 853 RE-BUILDER is a lambda that transforms text into a regex.
 854
 855 MATCHER can completely override matching.
 856
 857 DYNAMIC-COLLECTION is a function to call to update the list of
 858 candidates with each input."
 859   (let ((extra-actions (plist-get ivy--actions-list this-command)))
 860     (when extra-actions
 861       (setq action
 862             (if (functionp action)
 863                 `(1
 864                   ("o" ,action "default")
 865                   ,@extra-actions)
 866               (delete-dups (append action extra-actions))))))
 867   (setq ivy-last
 868         (make-ivy-state
 869          :prompt prompt
 870          :collection collection
 871          :predicate predicate
 872          :require-match require-match
 873          :initial-input initial-input
 874          :history history
 875          :preselect preselect
 876          :keymap keymap
 877          :update-fn update-fn
 878          :sort sort
 879          :action action
 880          :window (selected-window)
 881          :unwind unwind
 882          :re-builder re-builder
 883          :matcher matcher
 884          :dynamic-collection dynamic-collection))
 885   (ivy--reset-state ivy-last)
 886   (prog1
 887       (unwind-protect
 888            (minibuffer-with-setup-hook
 889                #'ivy--minibuffer-setup
 890              (let* ((hist (or history 'ivy-history))
 891                     (minibuffer-completion-table collection)
 892                     (minibuffer-completion-predicate predicate)
 893                     (resize-mini-windows (cond
 894                                           ((display-graphic-p) nil)
 895                                           ((null resize-mini-windows) 'grow-only)
 896                                           (t resize-mini-windows)))
 897                     (res (read-from-minibuffer
 898                           prompt
 899                           (ivy-state-initial-input ivy-last)
 900                           (make-composed-keymap keymap ivy-minibuffer-map)
 901                           nil
 902                           hist)))
 903                (when (eq ivy-exit 'done)
 904                  (let ((item (if ivy--directory
 905                                  ivy--current
 906                                ivy-text)))
 907                    (unless (equal item "")
 908                      (set hist (cons (propertize item 'ivy-index ivy--index)
 909                                      (delete item
 910                                              (cdr (symbol-value hist)))))))
 911                  res)))
 912         (remove-hook 'post-command-hook #'ivy--exhibit)
 913         (when (setq unwind (ivy-state-unwind ivy-last))
 914           (funcall unwind)))
 915     (ivy-call)))
 916
 917 (defun ivy--reset-state (state)
 918   "Reset the ivy to STATE.
 919 This is useful for recursive `ivy-read'."
 920   (let ((prompt (ivy-state-prompt state))
 921         (collection (ivy-state-collection state))
 922         (predicate (ivy-state-predicate state))
 923         (history (ivy-state-history state))
 924         (preselect (ivy-state-preselect state))
 925         (sort (ivy-state-sort state))
 926         (re-builder (ivy-state-re-builder state))
 927         (dynamic-collection (ivy-state-dynamic-collection state))
 928         (initial-input (ivy-state-initial-input state))
 929         (require-match (ivy-state-require-match state))
 930         (matcher (ivy-state-matcher state)))
 931     (unless initial-input
 932       (setq initial-input (cdr (assoc this-command
 933                                       ivy-initial-inputs-alist))))
 934     (setq ivy--directory nil)
 935     (setq ivy--regex-function
 936           (or re-builder
 937               (and (functionp collection)
 938                    (cdr (assoc collection ivy-re-builders-alist)))
 939               (cdr (assoc t ivy-re-builders-alist))
 940               'ivy--regex))
 941     (setq ivy--subexps 0)
 942     (setq ivy--regexp-quote 'regexp-quote)
 943     (setq ivy--old-text "")
 944     (setq ivy--full-length nil)
 945     (setq ivy-text "")
 946     (setq ivy-calling nil)
 947     (let (coll sort-fn)
 948       (cond ((eq collection 'Info-read-node-name-1)
 949              (if (equal Info-current-file "dir")
 950                  (setq coll
 951                        (mapcar (lambda (x) (format "(%s)" x))
 952                                (cl-delete-duplicates
 953                                 (all-completions "(" collection predicate)
 954                                 :test #'equal)))
 955                (setq coll (all-completions "" collection predicate))))
 956             ((eq collection 'read-file-name-internal)
 957              (setq ivy--directory default-directory)
 958              (require 'dired)
 959              (when preselect
 960                (let ((preselect-directory (file-name-directory preselect)))
 961                  (unless (or (null preselect-directory)
 962                              (string= preselect-directory
 963                                       default-directory))
 964                    (setq ivy--directory preselect-directory))
 965                  (setq preselect (file-name-nondirectory preselect))))
 966              (setq coll (ivy--sorted-files ivy--directory))
 967              (when initial-input
 968                (unless (or require-match
 969                            (equal initial-input default-directory)
 970                            (equal initial-input ""))
 971                  (setq coll (cons initial-input coll)))
 972                (setq initial-input nil)))
 973             ((eq collection 'internal-complete-buffer)
 974              (setq coll (ivy--buffer-list "" ivy-use-virtual-buffers)))
 975             ((or (functionp collection)
 976                  (byte-code-function-p collection)
 977                  (vectorp collection)
 978                  (listp (car collection)))
 979              (setq coll (all-completions "" collection predicate)))
 980             ((hash-table-p collection)
 981              (error "Hash table as a collection unsupported"))
 982             (t
 983              (setq coll collection)))
 984       (when sort
 985         (if (and (functionp collection)
 986                  (setq sort-fn (assoc collection ivy-sort-functions-alist)))
 987             (when (and (setq sort-fn (cdr sort-fn))
 988                        (not (eq collection 'read-file-name-internal)))
 989               (setq coll (cl-sort coll sort-fn)))
 990           (unless (eq history 'org-refile-history)
 991             (if (and (setq sort-fn (cdr (assoc t ivy-sort-functions-alist)))
 992                      (<= (length coll) ivy-sort-max-size))
 993                 (setq coll (cl-sort (copy-sequence coll) sort-fn))))))
 994       (when preselect
 995         (unless (or (and require-match
 996                          (not (eq collection 'internal-complete-buffer)))
 997                     (let ((re (format "\\`%s" (regexp-quote preselect))))
 998                       (cl-find-if (lambda (x) (string-match re x))
 999                                   coll)))
1000           (setq coll (cons preselect coll))))
1001       (setq ivy--index (or
1002                         (and dynamic-collection
1003                              ivy--index)
1004                         (and preselect
1005                              (ivy--preselect-index
1006                               coll initial-input preselect matcher))
1007                         0))
1008       (setq ivy--old-re nil)
1009       (setq ivy--old-cands nil)
1010       (setq ivy--all-candidates coll))
1011     (setq ivy-exit nil)
1012     (setq ivy--default (or (thing-at-point 'symbol) ""))
1013     (setq ivy--prompt
1014           (cond ((string-match "%.*d" prompt)
1015                  prompt)
1016                 ((null ivy-count-format)
1017                  nil)
1018                 ((string-match "%d.*%d" ivy-count-format)
1019                  (let ((w (length (number-to-string
1020                                    (length ivy--all-candidates))))
1021                        (s (copy-sequence ivy-count-format)))
1022                    (string-match "%d" s)
1023                    (match-end 0)
1024                    (string-match "%d" s (match-end 0))
1025                    (setq s (replace-match (format "%%-%dd" w) nil nil s))
1026                    (string-match "%d" s)
1027                    (concat (replace-match (format "%%%dd" w) nil nil s)
1028                            prompt)))
1029                 ((string-match "%.*d" ivy-count-format)
1030                  (concat ivy-count-format prompt))
1031                 (ivy--directory
1032                  prompt)
1033                 (t
1034                  nil)))
1035     (setf (ivy-state-initial-input ivy-last) initial-input)))
1036
1037 ;;;###autoload
1038 (defun ivy-completing-read (prompt collection
1039                             &optional predicate require-match initial-input
1040                               history def _inherit-input-method)
1041   "Read a string in the minibuffer, with completion.
1042
1043 This is an interface that conforms to `completing-read', so that
1044 it can be used for `completing-read-function'.
1045
1046 PROMPT is a string to prompt with; normally it ends in a colon and a space.
1047 COLLECTION can be a list of strings, an alist, an obarray or a hash table.
1048 PREDICATE limits completion to a subset of COLLECTION.
1049 REQUIRE-MATCH is considered boolean. See `completing-read'.
1050 INITIAL-INPUT is a string that can be inserted into the minibuffer initially.
1051 _HISTORY is ignored for now.
1052 DEF is the default value.
1053 _INHERIT-INPUT-METHOD is ignored for now.
1054
1055 The history, defaults and input-method arguments are ignored for now."
1056   (ivy-read (replace-regexp-in-string "%" "%%" prompt)
1057             collection
1058             :predicate predicate
1059             :require-match require-match
1060             :initial-input (if (consp initial-input)
1061                                (car initial-input)
1062                              (if (and (stringp initial-input)
1063                                       (string-match "\\+" initial-input))
1064                                  (replace-regexp-in-string
1065                                   "\\+" "\\\\+" initial-input)
1066                                initial-input))
1067             :preselect (if (listp def) (car def) def)
1068             :history history
1069             :keymap nil
1070             :sort
1071             (let ((sort (assoc this-command ivy-sort-functions-alist)))
1072               (if sort
1073                   (cdr sort)
1074                 t))))
1075
1076 ;;;###autoload
1077 (define-minor-mode ivy-mode
1078   "Toggle Ivy mode on or off.
1079 With ARG, turn Ivy mode on if arg is positive, off otherwise.
1080 Turning on Ivy mode will set `completing-read-function' to
1081 `ivy-completing-read'.
1082
1083 Global bindings:
1084 \\{ivy-mode-map}
1085
1086 Minibuffer bindings:
1087 \\{ivy-minibuffer-map}"
1088   :group 'ivy
1089   :global t
1090   :keymap ivy-mode-map
1091   :lighter " ivy"
1092   (if ivy-mode
1093       (setq completing-read-function 'ivy-completing-read)
1094     (setq completing-read-function 'completing-read-default)))
1095
1096 (defun ivy--preselect-index (candidates initial-input preselect matcher)
1097   "Return the index in CANDIDATES filtered by INITIAL-INPUT for PRESELECT.
1098 When MATCHER is non-nil it's used instead of `cl-remove-if-not'."
1099   (if initial-input
1100       (progn
1101         (setq initial-input (ivy--regex-plus initial-input))
1102         (setq candidates
1103               (if matcher
1104                   (funcall matcher initial-input candidates)
1105                 (cl-remove-if-not
1106                  (lambda (x)
1107                    (string-match initial-input x))
1108                  candidates))))
1109     (when matcher
1110       (setq candidates (funcall matcher "" candidates))))
1111   (or (cl-position preselect candidates :test #'equal)
1112       (cl-position-if
1113        (lambda (x)
1114          (string-match (regexp-quote preselect) x))
1115        candidates)))
1116
1117 ;;* Implementation
1118 ;;** Regex
1119 (defvar ivy--regex-hash
1120   (make-hash-table :test #'equal)
1121   "Store pre-computed regex.")
1122
1123 (defun ivy--split (str)
1124   "Split STR into a list by single spaces.
1125 The remaining spaces stick to their left.
1126 This allows to \"quote\" N spaces by inputting N+1 spaces."
1127   (let ((len (length str))
1128         start0
1129         (start1 0)
1130         res s
1131         match-len)
1132     (while (and (string-match " +" str start1)
1133                 (< start1 len))
1134       (setq match-len (- (match-end 0) (match-beginning 0)))
1135       (if (= match-len 1)
1136           (progn
1137             (when start0
1138               (setq start1 start0)
1139               (setq start0 nil))
1140             (push (substring str start1 (match-beginning 0)) res)
1141             (setq start1 (match-end 0)))
1142         (setq str (replace-match
1143                    (make-string (1- match-len) ?\ )
1144                    nil nil str))
1145         (setq start0 (or start0 start1))
1146         (setq start1 (1- (match-end 0)))))
1147     (if start0
1148         (push (substring str start0) res)
1149       (setq s (substring str start1))
1150       (unless (= (length s) 0)
1151         (push s res)))
1152     (nreverse res)))
1153
1154 (defun ivy--regex (str &optional greedy)
1155   "Re-build regex from STR in case it has a space.
1156 When GREEDY is non-nil, join words in a greedy way."
1157   (let ((hashed (unless greedy
1158                   (gethash str ivy--regex-hash))))
1159     (if hashed
1160         (prog1 (cdr hashed)
1161           (setq ivy--subexps (car hashed)))
1162       (when (string-match "\\([^\\]\\|^\\)\\\\$" str)
1163         (setq str (substring str 0 -1)))
1164       (cdr (puthash str
1165                     (let ((subs (ivy--split str)))
1166                       (if (= (length subs) 1)
1167                           (cons
1168                            (setq ivy--subexps 0)
1169                            (car subs))
1170                         (cons
1171                          (setq ivy--subexps (length subs))
1172                          (mapconcat
1173                           (lambda (x)
1174                             (if (string-match "\\`\\\\(.*\\\\)\\'" x)
1175                                 x
1176                               (format "\\(%s\\)" x)))
1177                           subs
1178                           (if greedy
1179                               ".*"
1180                             ".*?")))))
1181                     ivy--regex-hash)))))
1182
1183 (defun ivy--regex-ignore-order (str)
1184   "Re-build regex from STR by splitting it on spaces.
1185 Ignore the order of each group."
1186   (let* ((subs (split-string str " +" t))
1187          (len (length subs)))
1188     (cl-case len
1189       (1
1190        (setq ivy--subexps 0)
1191        (car subs))
1192       (t
1193        (setq ivy--subexps len)
1194        (let ((all (mapconcat #'identity subs "\\|")))
1195          (mapconcat
1196           (lambda (x)
1197             (if (string-match "\\`\\\\(.*\\\\)\\'" x)
1198                 x
1199               (format "\\(%s\\)" x)))
1200           (make-list len all)
1201           ".*?"))))))
1202
1203 (defun ivy--regex-plus (str)
1204   "Build a regex sequence from STR.
1205 Spaces are wild, everything before \"!\" should match.
1206 Everything after \"!\" should not match."
1207   (let ((parts (split-string str "!" t)))
1208     (cl-case (length parts)
1209       (0
1210        "")
1211       (1
1212        (ivy--regex (car parts)))
1213       (2
1214        (let ((res
1215               (mapcar #'list
1216                       (split-string (cadr parts) " " t))))
1217          (cons (cons (ivy--regex (car parts)) t)
1218                res)))
1219       (t (error "Unexpected: use only one !")))))
1220
1221 (defun ivy--regex-fuzzy (str)
1222   "Build a regex sequence from STR.
1223 Insert .* between each char."
1224   (if (string-match "\\`\\(\\^?\\)\\(.*?\\)\\(\\$?\\)\\'" str)
1225       (concat (match-string 1 str)
1226               (mapconcat #'string (string-to-list (match-string 2 str)) ".*")
1227               (match-string 3 str))
1228     str))
1229
1230 ;;** Rest
1231 (defun ivy--minibuffer-setup ()
1232   "Setup ivy completion in the minibuffer."
1233   (set (make-local-variable 'completion-show-inline-help) nil)
1234   (set (make-local-variable 'minibuffer-default-add-function)
1235        (lambda ()
1236          (list ivy--default)))
1237   (when (display-graphic-p)
1238     (setq truncate-lines t))
1239   (setq-local max-mini-window-height ivy-height)
1240   (add-hook 'post-command-hook #'ivy--exhibit nil t)
1241   ;; show completions with empty input
1242   (ivy--exhibit))
1243
1244 (defun ivy--input ()
1245   "Return the current minibuffer input."
1246   ;; assume one-line minibuffer input
1247   (buffer-substring-no-properties
1248    (minibuffer-prompt-end)
1249    (line-end-position)))
1250
1251 (defun ivy--cleanup ()
1252   "Delete the displayed completion candidates."
1253   (save-excursion
1254     (goto-char (minibuffer-prompt-end))
1255     (delete-region (line-end-position) (point-max))))
1256
1257 (defun ivy--insert-prompt ()
1258   "Update the prompt according to `ivy--prompt'."
1259   (when ivy--prompt
1260     (unless (memq this-command '(ivy-done ivy-alt-done ivy-partial-or-done
1261                                  counsel-find-symbol))
1262       (setq ivy--prompt-extra ""))
1263     (let (head tail)
1264       (if (string-match "\\(.*\\): \\'" ivy--prompt)
1265           (progn
1266             (setq head (match-string 1 ivy--prompt))
1267             (setq tail ": "))
1268         (setq head (substring ivy--prompt 0 -1))
1269         (setq tail " "))
1270       (let ((inhibit-read-only t)
1271             (std-props '(front-sticky t rear-nonsticky t field t read-only t))
1272             (n-str
1273              (concat
1274               (if (and (bound-and-true-p minibuffer-depth-indicate-mode)
1275                        (> (minibuffer-depth) 1))
1276                   (format "[%d] " (minibuffer-depth))
1277                 "")
1278               (concat
1279                (if (string-match "%d.*%d" ivy-count-format)
1280                    (format head
1281                            (1+ ivy--index)
1282                            (or (and (ivy-state-dynamic-collection ivy-last)
1283                                     ivy--full-length)
1284                                ivy--length))
1285                  (format head
1286                          (or (and (ivy-state-dynamic-collection ivy-last)
1287                                   ivy--full-length)
1288                              ivy--length)))
1289                ivy--prompt-extra
1290                tail)
1291               (if ivy--directory
1292                   (abbreviate-file-name ivy--directory)
1293                 ""))))
1294         (save-excursion
1295           (goto-char (point-min))
1296           (delete-region (point-min) (minibuffer-prompt-end))
1297           (when (> (length n-str) (window-width))
1298             (setq n-str (concat (substring n-str 0
1299                                            (max (- (window-width) 30)
1300                                                 10)) "... ")))
1301           (set-text-properties 0 (length n-str)
1302                                `(face minibuffer-prompt ,@std-props)
1303                                n-str)
1304           (ivy--set-match-props n-str "confirm"
1305                                 `(face ivy-confirm-face ,@std-props))
1306           (ivy--set-match-props n-str "match required"
1307                                 `(face ivy-match-required-face ,@std-props))
1308           (insert n-str))
1309         ;; get out of the prompt area
1310         (constrain-to-field nil (point-max))))))
1311
1312 (defun ivy--set-match-props (str match props)
1313   "Set STR text proprties that match MATCH to PROPS."
1314   (when (string-match match str)
1315     (set-text-properties
1316      (match-beginning 0)
1317      (match-end 0)
1318      props
1319      str)))
1320
1321 (defvar inhibit-message)
1322
1323 (defun ivy--sort-maybe (collection)
1324   "Sort COLLECTION if needed."
1325   (let ((sort (ivy-state-sort ivy-last))
1326         entry)
1327     (if (null sort)
1328         collection
1329       (let ((sort-fn (cond ((functionp sort)
1330                             sort)
1331                            ((setq entry (assoc (ivy-state-collection ivy-last)
1332                                                ivy-sort-functions-alist))
1333                             (cdr entry))
1334                            (t
1335                             (cdr (assoc t ivy-sort-functions-alist))))))
1336         (if (functionp sort-fn)
1337             (cl-sort (copy-sequence collection) sort-fn)
1338           collection)))))
1339
1340 (defun ivy--exhibit ()
1341   "Insert Ivy completions display.
1342 Should be run via minibuffer `post-command-hook'."
1343   (when (memq 'ivy--exhibit post-command-hook)
1344     (setq ivy-text (ivy--input))
1345     (if (ivy-state-dynamic-collection ivy-last)
1346         ;; while-no-input would cause annoying
1347         ;; "Waiting for process to die...done" message interruptions
1348         (let ((inhibit-message t))
1349           (unless (equal ivy--old-text ivy-text)
1350             (while-no-input
1351               (setq ivy--all-candidates
1352                     (ivy--sort-maybe
1353                      (funcall (ivy-state-collection ivy-last) ivy-text)))
1354               (setq ivy--old-text ivy-text)))
1355           (when ivy--all-candidates
1356             (ivy--insert-minibuffer
1357              (ivy--format ivy--all-candidates))))
1358       (cond (ivy--directory
1359              (if (string-match "/\\'" ivy-text)
1360                  (if (member ivy-text ivy--all-candidates)
1361                      (ivy--cd (expand-file-name ivy-text ivy--directory))
1362                    (when (string-match "//\\'" ivy-text)
1363                      (if (and default-directory
1364                               (string-match "\\`[[:alpha:]]:/" default-directory))
1365                          (ivy--cd (match-string 0 default-directory))
1366                        (ivy--cd "/")))
1367                    (when (string-match "[[:alpha:]]:/" ivy-text)
1368                      (let ((drive-root (match-string 0 ivy-text)))
1369                        (when (file-exists-p drive-root)
1370                          (ivy--cd drive-root)))))
1371                (if (string-match "\\`~\\'" ivy-text)
1372                    (ivy--cd (expand-file-name "~/")))))
1373             ((eq (ivy-state-collection ivy-last) 'internal-complete-buffer)
1374              (when (or (and (string-match "\\` " ivy-text)
1375                             (not (string-match "\\` " ivy--old-text)))
1376                        (and (string-match "\\` " ivy--old-text)
1377                             (not (string-match "\\` " ivy-text))))
1378                (setq ivy--all-candidates
1379                      (if (and (> (length ivy-text) 0)
1380                               (eq (aref ivy-text 0)
1381                                   ?\ ))
1382                          (ivy--buffer-list " ")
1383                        (ivy--buffer-list "" ivy-use-virtual-buffers)))
1384                (setq ivy--old-re nil))))
1385       (ivy--insert-minibuffer
1386        (ivy--format
1387         (ivy--filter ivy-text ivy--all-candidates)))
1388       (setq ivy--old-text ivy-text))))
1389
1390 (defun ivy--insert-minibuffer (text)
1391   "Insert TEXT into minibuffer with appropriate cleanup."
1392   (let ((resize-mini-windows nil)
1393         (update-fn (ivy-state-update-fn ivy-last))
1394         deactivate-mark)
1395     (ivy--cleanup)
1396     (when update-fn
1397       (funcall update-fn))
1398     (ivy--insert-prompt)
1399     ;; Do nothing if while-no-input was aborted.
1400     (when (stringp text)
1401       (let ((buffer-undo-list t))
1402         (save-excursion
1403           (forward-line 1)
1404           (insert text))))
1405     (when (display-graphic-p)
1406       (ivy--resize-minibuffer-to-fit))))
1407
1408 (defun ivy--resize-minibuffer-to-fit ()
1409   "Resize the minibuffer window so it has enough space to display
1410 all of the text contained in the minibuffer."
1411   (with-selected-window (minibuffer-window)
1412     (if (fboundp 'window-text-pixel-size)
1413         (let ((text-height (cdr (window-text-pixel-size)))
1414               (body-height (window-body-height nil t)))
1415           (when (> text-height body-height)
1416             (window-resize nil (- text-height body-height) nil t t)))
1417         (let ((text-height (count-screen-lines))
1418               (body-height (window-body-height)))
1419           (when (> text-height body-height)
1420             (window-resize nil (- text-height body-height) nil t))))))
1421
1422 (declare-function colir-blend-face-background "ext:colir")
1423
1424 (defun ivy--add-face (str face)
1425   "Propertize STR with FACE.
1426 `font-lock-append-text-property' is used, since it's better than
1427 `propertize' or `add-face-text-property' in this case."
1428   (require 'colir)
1429   (condition-case nil
1430       (progn
1431         (colir-blend-face-background 0 (length str) face str)
1432         (let ((foreground (face-foreground face)))
1433           (when foreground
1434             (add-face-text-property
1435              0 (length str)
1436              `(:foreground ,foreground)
1437              nil
1438              str))))
1439     (error
1440      (ignore-errors
1441        (font-lock-append-text-property 0 (length str) 'face face str))))
1442   str)
1443
1444 (defun ivy--filter (name candidates)
1445   "Return all items that match NAME in CANDIDATES.
1446 CANDIDATES are assumed to be static."
1447   (let* ((re (funcall ivy--regex-function name))
1448          (re-str (if (listp re) (caar re) re))
1449          (matcher (ivy-state-matcher ivy-last))
1450          (case-fold-search (string= name (downcase name)))
1451          (cands (cond
1452                   (matcher
1453                    (funcall matcher re candidates))
1454                   ((and (equal re ivy--old-re)
1455                         ivy--old-cands)
1456                    ivy--old-cands)
1457                   ((and ivy--old-re
1458                         (stringp re)
1459                         (stringp ivy--old-re)
1460                         (not (string-match "\\\\" ivy--old-re))
1461                         (not (equal ivy--old-re ""))
1462                         (memq (cl-search
1463                                (if (string-match "\\\\)\\'" ivy--old-re)
1464                                    (substring ivy--old-re 0 -2)
1465                                  ivy--old-re)
1466                                re)
1467                               '(0 2)))
1468                    (ignore-errors
1469                      (cl-remove-if-not
1470                       (lambda (x) (string-match re x))
1471                       ivy--old-cands)))
1472                   (t
1473                    (let ((re-list (if (stringp re) (list (cons re t)) re))
1474                          (res candidates))
1475                      (dolist (re re-list)
1476                        (setq res
1477                              (ignore-errors
1478                                (funcall
1479                                 (if (cdr re)
1480                                     #'cl-remove-if-not
1481                                   #'cl-remove-if)
1482                                 (let ((re (car re)))
1483                                   (lambda (x) (string-match re x)))
1484                                 res))))
1485                      res))))
1486          (tail (nthcdr ivy--index ivy--old-cands))
1487          idx)
1488     (when (and tail ivy--old-cands (not (equal "^" ivy--old-re)))
1489       (unless (and (not (equal re-str ivy--old-re))
1490                    (or (setq ivy--index
1491                              (or
1492                               (cl-position (if (and (> (length re-str) 0)
1493                                                     (eq ?^ (aref re-str 0)))
1494                                                (substring re-str 1)
1495                                              re-str) cands
1496                                              :test #'equal)
1497                               (and ivy--directory
1498                                    (cl-position
1499                                     (concat re-str "/") cands
1500                                     :test #'equal))))))
1501         (while (and tail (null idx))
1502           ;; Compare with eq to handle equal duplicates in cands
1503           (setq idx (cl-position (pop tail) cands)))
1504         (setq ivy--index (or idx 0))))
1505     (when (and (string= name "") (not (equal ivy--old-re "")))
1506       (setq ivy--index
1507             (or (cl-position (ivy-state-preselect ivy-last)
1508                              cands :test #'equal)
1509                 ivy--index)))
1510     (setq ivy--old-re (if cands re-str ""))
1511     (setq ivy--old-cands cands)))
1512
1513 (defvar ivy-format-function 'ivy-format-function-default
1514   "Function to transform the list of candidates into a string.
1515 This string will be inserted into the minibuffer.")
1516
1517 (defun ivy-format-function-default (cands)
1518   "Transform CANDS into a string for minibuffer."
1519   (if (bound-and-true-p truncate-lines)
1520       (mapconcat #'identity cands "\n")
1521     (let ((ww (- (window-width)
1522                  (if (and (boundp 'fringe-mode) (eq fringe-mode 0)) 1 0))))
1523       (mapconcat
1524        (lambda (s)
1525          (if (> (length s) ww)
1526              (concat (substring s 0 (- ww 3)) "...")
1527            s))
1528        cands "\n"))))
1529
1530 (defun ivy-format-function-arrow (cands)
1531   "Transform CANDS into a string for minibuffer."
1532   (let ((i -1))
1533     (mapconcat
1534      (lambda (s)
1535        (concat (if (eq (cl-incf i) ivy--index)
1536                    "> "
1537                  "  ")
1538                s))
1539      cands "\n")))
1540
1541 (defcustom swiper-minibuffer-faces
1542   '(swiper-minibuffer-match-face-1
1543     swiper-minibuffer-match-face-2
1544     swiper-minibuffer-match-face-3
1545     swiper-minibuffer-match-face-4)
1546   "List of `swiper' faces for minibuffer group matches.")
1547
1548 (defun ivy--format-minibuffer-line (str)
1549   (let ((start 0)
1550         (str (copy-sequence str)))
1551     (when (eq ivy-display-style 'fancy)
1552       (unless ivy--old-re
1553         (setq ivy--old-re (funcall ivy--regex-function ivy-text)))
1554       (while (and (string-match ivy--old-re str start)
1555                   (> (- (match-end 0) (match-beginning 0)) 0))
1556         (setq start (match-end 0))
1557         (let ((i 0))
1558           (while (<= i ivy--subexps)
1559             (let ((face
1560                    (cond ((zerop ivy--subexps)
1561                           (cadr swiper-minibuffer-faces))
1562                          ((zerop i)
1563                           (car swiper-minibuffer-faces))
1564                          (t
1565                           (nth (1+ (mod (+ i 2) (1- (length swiper-minibuffer-faces))))
1566                                swiper-minibuffer-faces)))))
1567               (if (fboundp 'add-face-text-property)
1568                   (add-face-text-property
1569                    (match-beginning i)
1570                    (match-end i)
1571                    face
1572                    nil
1573                    str)
1574                 (font-lock-append-text-property
1575                  (match-beginning i)
1576                  (match-end i)
1577                  'face
1578                  face
1579                  str)))
1580             (cl-incf i)))))
1581     str))
1582
1583 (defun ivy--format (cands)
1584   "Return a string for CANDS suitable for display in the minibuffer.
1585 CANDS is a list of strings."
1586   (setq ivy--length (length cands))
1587   (when (>= ivy--index ivy--length)
1588     (setq ivy--index (max (1- ivy--length) 0)))
1589   (if (null cands)
1590       (setq ivy--current "")
1591     (let* ((half-height (/ ivy-height 2))
1592            (start (max 0 (- ivy--index half-height)))
1593            (end (min (+ start (1- ivy-height)) ivy--length))
1594            (start (max 0 (min start (- end (1- ivy-height)))))
1595            (cands (cl-subseq cands start end))
1596            (index (- ivy--index start)))
1597       (when ivy--directory
1598         (setq cands (mapcar (lambda (x)
1599                               (if (string-match-p "/\\'" x)
1600                                   (propertize x 'face 'ivy-subdir)
1601                                 x))
1602                             cands)))
1603       (setq ivy--current (copy-sequence (nth index cands)))
1604       (setq cands (mapcar
1605                    #'ivy--format-minibuffer-line
1606                    cands))
1607       (setf (nth index cands)
1608             (ivy--add-face (nth index cands) 'ivy-current-match))
1609       (let* ((ivy--index index)
1610              (res (concat "\n" (funcall ivy-format-function cands))))
1611         (put-text-property 0 (length res) 'read-only nil res)
1612         res))))
1613
1614 (defvar ivy--virtual-buffers nil
1615   "Store the virtual buffers alist.")
1616
1617 (defvar recentf-list)
1618
1619 (defface ivy-virtual '((t :inherit font-lock-builtin-face))
1620   "Face used by Ivy for matching virtual buffer names.")
1621
1622 (defun ivy--virtual-buffers ()
1623   "Adapted from `ido-add-virtual-buffers-to-list'."
1624   (unless recentf-mode
1625     (recentf-mode 1))
1626   (let ((bookmarks (and (boundp 'bookmark-alist)
1627                         bookmark-alist))
1628         virtual-buffers name)
1629     (dolist (head (append
1630                    recentf-list
1631                    (delete "   - no file -"
1632                            (delq nil (mapcar (lambda (bookmark)
1633                                                (cdr (assoc 'filename bookmark)))
1634                                              bookmarks)))))
1635       (setq name (file-name-nondirectory head))
1636       (when (equal name "")
1637         (setq name (file-name-nondirectory (directory-file-name head))))
1638       (when (equal name "")
1639         (setq name head))
1640       (and (not (equal name ""))
1641            (null (get-file-buffer head))
1642            (not (assoc name virtual-buffers))
1643            (push (cons name head) virtual-buffers)))
1644     (when virtual-buffers
1645       (dolist (comp virtual-buffers)
1646         (put-text-property 0 (length (car comp))
1647                            'face 'ivy-virtual
1648                            (car comp)))
1649       (setq ivy--virtual-buffers (nreverse virtual-buffers))
1650       (mapcar #'car ivy--virtual-buffers))))
1651
1652 (defun ivy--buffer-list (str &optional virtual)
1653   "Return the buffers that match STR.
1654 When VIRTUAL is non-nil, add virtual buffers."
1655   (delete-dups
1656    (append
1657     (mapcar
1658      (lambda (x)
1659        (if (with-current-buffer x
1660              (file-remote-p
1661               (abbreviate-file-name default-directory)))
1662            (propertize x 'face 'ivy-remote)
1663          x))
1664      (all-completions str 'internal-complete-buffer))
1665     (and virtual
1666          (ivy--virtual-buffers)))))
1667
1668 (defun ivy--switch-buffer-action (buffer)
1669   "Switch to BUFFER.
1670 BUFFER may be a string or nil."
1671   (with-ivy-window
1672     (if (zerop (length buffer))
1673         (switch-to-buffer
1674          ivy-text nil 'force-same-window)
1675       (let ((virtual (assoc buffer ivy--virtual-buffers)))
1676         (if (and virtual
1677                  (not (get-buffer buffer)))
1678             (find-file (cdr virtual))
1679           (switch-to-buffer
1680            buffer nil 'force-same-window))))))
1681
1682 (defun ivy--switch-buffer-other-window-action (buffer)
1683   "Switch to BUFFER in other window.
1684 BUFFER may be a string or nil."
1685   (if (zerop (length buffer))
1686       (switch-to-buffer-other-window ivy-text)
1687     (let ((virtual (assoc buffer ivy--virtual-buffers)))
1688       (if (and virtual
1689                (not (get-buffer buffer)))
1690           (find-file-other-window (cdr virtual))
1691         (switch-to-buffer-other-window buffer)))))
1692
1693 (defun ivy--rename-buffer-action (buffer)
1694   "Rename BUFFER."
1695   (let ((new-name (read-string "Rename buffer (to new name): ")))
1696     (with-current-buffer buffer
1697       (rename-buffer new-name))))
1698
1699 (defvar ivy-switch-buffer-map (make-sparse-keymap))
1700
1701 (ivy-set-actions
1702  'ivy-switch-buffer
1703  '(("k"
1704     (lambda (x)
1705       (kill-buffer x)
1706       (ivy--reset-state ivy-last))
1707     "kill")
1708    ("j"
1709     ivy--switch-buffer-other-window-action
1710     "other")
1711    ("r"
1712     ivy--rename-buffer-action
1713     "rename")))
1714
1715 ;;;###autoload
1716 (defun ivy-switch-buffer ()
1717   "Switch to another buffer."
1718   (interactive)
1719   (if (not ivy-mode)
1720       (call-interactively 'switch-to-buffer)
1721     (let ((this-command 'ivy-switch-buffer))
1722       (ivy-read "Switch to buffer: " 'internal-complete-buffer
1723                 :preselect (buffer-name (other-buffer (current-buffer)))
1724                 :action #'ivy--switch-buffer-action
1725                 :keymap ivy-switch-buffer-map))))
1726
1727 ;;;###autoload
1728 (defun ivy-recentf ()
1729   "Find a file on `recentf-list'."
1730   (interactive)
1731   (ivy-read "Recentf: " recentf-list
1732             :action
1733             (lambda (f)
1734               (with-ivy-window
1735                 (find-file f)))))
1736
1737 (defun ivy-yank-word ()
1738   "Pull next word from buffer into search string."
1739   (interactive)
1740   (let (amend)
1741     (with-ivy-window
1742       (let ((pt (point))
1743             (le (line-end-position)))
1744         (forward-word 1)
1745         (if (> (point) le)
1746             (goto-char pt)
1747           (setq amend (buffer-substring-no-properties pt (point))))))
1748     (when amend
1749       (insert amend))))
1750
1751 (defun ivy-kill-ring-save ()
1752   "Store the current candidates into the kill ring.
1753 If the region is active, forward to `kill-ring-save' instead."
1754   (interactive)
1755   (if (region-active-p)
1756       (call-interactively 'kill-ring-save)
1757     (kill-new
1758      (mapconcat
1759       #'identity
1760       ivy--old-cands
1761       "\n"))))
1762
1763 (defun ivy-insert-current ()
1764   "Make the current candidate into current input.
1765 Don't finish completion."
1766   (interactive)
1767   (delete-minibuffer-contents)
1768   (if (and ivy--directory
1769            (string-match "/$" ivy--current))
1770       (insert (substring ivy--current 0 -1))
1771     (insert ivy--current)))
1772
1773 (defun ivy-toggle-fuzzy ()
1774   "Toggle the re builder between `ivy--regex-fuzzy' and `ivy--regex-plus'."
1775   (interactive)
1776   (setq ivy--old-re nil)
1777   (if (eq ivy--regex-function 'ivy--regex-fuzzy)
1778       (setq ivy--regex-function 'ivy--regex-plus)
1779     (setq ivy--regex-function 'ivy--regex-fuzzy)))
1780
1781 (defun ivy-reverse-i-search ()
1782   "Enter a recursive `ivy-read' session using the current history.
1783 The selected history element will be inserted into the minibufer."
1784   (interactive)
1785   (let ((enable-recursive-minibuffers t)
1786         (history (symbol-value (ivy-state-history ivy-last)))
1787         (old-last ivy-last))
1788     (ivy-read "Reverse-i-search: "
1789               history
1790               :action (lambda (x)
1791                         (ivy--reset-state
1792                          (setq ivy-last old-last))
1793                         (delete-minibuffer-contents)
1794                         (insert (substring-no-properties x))
1795                         (ivy--cd-maybe)))))
1796
1797 (defun ivy-restrict-to-matches ()
1798   "Restrict candidates to current matches and erase input."
1799   (interactive)
1800   (delete-minibuffer-contents)
1801   (setq ivy--all-candidates
1802         (ivy--filter ivy-text ivy--all-candidates)))
1803
1804 (provide 'ivy)
1805
1806 ;;; ivy.el ends here