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