code.delx.au - gnu-emacs-elpa/blob - 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 ;; Version: 0.2.3
   8 ;; Package-Requires: ((emacs "24.1"))
   9 ;; Keywords: matching
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; This file is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 3, or (at your option)
  16 ;; any later version.
  17
  18 ;; This program is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; For a full copy of the GNU General Public License
  24 ;; see <http://www.gnu.org/licenses/>.
  25
  26 ;;; Commentary:
  27 ;;
  28 ;; This package provides `ivy-read' as an alternative to
  29 ;; `completing-read' and similar functions.
  30 ;;
  31 ;; There's no intricate code to determine the best candidate.
  32 ;; Instead, the user can navigate to it with `ivy-next-line' and
  33 ;; `ivy-previous-line'.
  34 ;;
  35 ;; The matching is done by splitting the input text by spaces and
  36 ;; re-building it into a regex.
  37 ;; So "for example" is transformed into "\\(for\\).*\\(example\\)".
  38
  39 ;;; Code:
  40 (require 'cl-lib)
  41
  42 ;;* Customization
  43 (defgroup ivy nil
  44   "Incremental vertical completion."
  45   :group 'convenience)
  46
  47 (defface ivy-current-match
  48   '((t (:inherit highlight)))
  49   "Face used by Ivy for highlighting first match.")
  50
  51 (defface ivy-confirm-face
  52   '((t :foreground "ForestGreen" :inherit minibuffer-prompt))
  53   "Face used by Ivy to issue a confirmation prompt.")
  54
  55 (defface ivy-match-required-face
  56   '((t :foreground "red" :inherit minibuffer-prompt))
  57   "Face used by Ivy to issue a match required prompt.")
  58
  59 (defface ivy-subdir
  60   '((t (:inherit 'dired-directory)))
  61   "Face used by Ivy for highlighting subdirs in the alternatives.")
  62
  63 (defface ivy-remote
  64   '((t (:foreground "#110099")))
  65   "Face used by Ivy for highlighting remotes in the alternatives.")
  66
  67 (defcustom ivy-height 10
  68   "Number of lines for the minibuffer window."
  69   :type 'integer)
  70
  71 (defcustom ivy-count-format "%-4d "
  72   "The style of showing the current candidate count for `ivy-read'.
  73 Set this to nil if you don't want the count."
  74   :type 'string)
  75
  76 (defcustom ivy-wrap nil
  77   "Whether to wrap around after the first and last candidate."
  78   :type 'boolean)
  79
  80 (defcustom ivy-on-del-error-function 'minibuffer-keyboard-quit
  81   "The handler for when `ivy-backward-delete-char' throws.
  82 This is usually meant as a quick exit out of the minibuffer."
  83   :type 'function)
  84
  85 (defcustom ivy-extra-directories '("../" "./")
  86   "Add this to the front of the list when completing file names.
  87 Only \"./\" and \"../\" apply here. They appear in reverse order."
  88   :type 'list)
  89
  90 (defcustom ivy-use-virtual-buffers nil
  91   "When non-nil, add `recentf-mode' and bookmarks to the list of buffers."
  92   :type 'boolean)
  93
  94 ;;* Keymap
  95 (require 'delsel)
  96 (defvar ivy-minibuffer-map
  97   (let ((map (make-sparse-keymap)))
  98     (define-key map (kbd "C-m") 'ivy-done)
  99     (define-key map (kbd "C-j") 'ivy-alt-done)
 100     (define-key map (kbd "TAB") 'ivy-partial-or-done)
 101     (define-key map (kbd "C-n") 'ivy-next-line)
 102     (define-key map (kbd "C-p") 'ivy-previous-line)
 103     (define-key map (kbd "<down>") 'ivy-next-line)
 104     (define-key map (kbd "<up>") 'ivy-previous-line)
 105     (define-key map (kbd "C-s") 'ivy-next-line-or-history)
 106     (define-key map (kbd "C-r") 'ivy-previous-line-or-history)
 107     (define-key map (kbd "SPC") 'self-insert-command)
 108     (define-key map (kbd "DEL") 'ivy-backward-delete-char)
 109     (define-key map (kbd "M-DEL") 'ivy-backward-kill-word)
 110     (define-key map (kbd "M-<") 'ivy-beginning-of-buffer)
 111     (define-key map (kbd "M->") 'ivy-end-of-buffer)
 112     (define-key map (kbd "<left>") 'ivy-beginning-of-buffer)
 113     (define-key map (kbd "<right>") 'ivy-end-of-buffer)
 114     (define-key map (kbd "M-n") 'ivy-next-history-element)
 115     (define-key map (kbd "M-p") 'ivy-previous-history-element)
 116     (define-key map (kbd "C-g") 'minibuffer-keyboard-quit)
 117     (define-key map (kbd "C-v") 'ivy-scroll-up-command)
 118     (define-key map (kbd "M-v") 'ivy-scroll-down-command)
 119     (define-key map (kbd "C-M-n") 'ivy-next-line-and-call)
 120     (define-key map (kbd "C-M-p") 'ivy-previous-line-and-call)
 121     (define-key map (kbd "M-q") 'ivy-toggle-regexp-quote)
 122     map)
 123   "Keymap used in the minibuffer.")
 124
 125 (defvar ivy-mode-map
 126   (let ((map (make-sparse-keymap)))
 127     (define-key map [remap switch-to-buffer] 'ivy-switch-buffer)
 128     map)
 129   "Keymap for `ivy-mode'.")
 130
 131 ;;* Globals
 132 (cl-defstruct ivy-state
 133   prompt collection
 134   predicate require-match initial-input
 135   history preselect keymap update-fn sort
 136   ;; The window in which `ivy-read' was called
 137   window
 138   action
 139   unwind
 140   re-builder
 141   matcher
 142   ;; When this is non-nil, call it for each input change to get new candidates
 143   dynamic-collection)
 144
 145 (defvar ivy-last nil
 146   "The last parameters passed to `ivy-read'.")
 147
 148 (defsubst ivy-set-action (action)
 149   (setf (ivy-state-action ivy-last) action))
 150
 151 (defvar ivy-history nil
 152   "History list of candidates entered in the minibuffer.
 153
 154 Maximum length of the history list is determined by the value
 155 of `history-length', which see.")
 156
 157 (defvar ivy--directory nil
 158   "Current directory when completing file names.")
 159
 160 (defvar ivy--length 0
 161   "Store the amount of viable candidates.")
 162
 163 (defvar ivy-text ""
 164   "Store the user's string as it is typed in.")
 165
 166 (defvar ivy--current ""
 167   "Current candidate.")
 168
 169 (defvar ivy--index 0
 170   "Store the index of the current candidate.")
 171
 172 (defvar ivy-exit nil
 173   "Store 'done if the completion was successfully selected.
 174 Otherwise, store nil.")
 175
 176 (defvar ivy--all-candidates nil
 177   "Store the candidates passed to `ivy-read'.")
 178
 179 (defvar ivy--default nil
 180   "Default initial input.")
 181
 182 (defvar ivy--prompt nil
 183   "Store the format-style prompt.
 184 When non-nil, it should contain one %d.")
 185
 186 (defvar ivy--prompt-extra ""
 187   "Temporary modifications to the prompt.")
 188
 189 (defvar ivy--old-re nil
 190   "Store the old regexp.")
 191
 192 (defvar ivy--old-cands nil
 193   "Store the candidates matched by `ivy--old-re'.")
 194
 195 (defvar ivy--regex-function 'ivy--regex
 196   "Current function for building a regex.")
 197
 198 (defvar Info-current-file)
 199
 200 (defmacro ivy-quit-and-run (&rest body)
 201   "Quit the minibuffer and run BODY afterwards."
 202   `(progn
 203      (put 'quit 'error-message "")
 204      (run-at-time nil nil
 205                   (lambda ()
 206                     (put 'quit 'error-message "Quit")
 207                     ,@body))
 208      (minibuffer-keyboard-quit)))
 209
 210 (defun ivy--done (text)
 211   "Insert TEXT and exit minibuffer."
 212   (if (and ivy--directory
 213            (not (eq (ivy-state-history ivy-last) 'grep-files-history)))
 214       (insert (expand-file-name
 215                  text ivy--directory))
 216     (insert text))
 217   (setq ivy-exit 'done)
 218   (exit-minibuffer))
 219
 220 ;;* Commands
 221 (defun ivy-done ()
 222   "Exit the minibuffer with the selected candidate."
 223   (interactive)
 224   (delete-minibuffer-contents)
 225   (cond ((> ivy--length 0)
 226          (ivy--done ivy--current))
 227         ((memq (ivy-state-collection ivy-last)
 228                '(read-file-name-internal internal-complete-buffer))
 229          (if (or (not (eq confirm-nonexistent-file-or-buffer t))
 230                  (equal " (confirm)" ivy--prompt-extra))
 231              (ivy--done ivy-text)
 232            (setq ivy--prompt-extra " (confirm)")
 233            (insert ivy-text)
 234            (ivy--exhibit)))
 235         ((memq (ivy-state-require-match ivy-last)
 236                '(nil confirm confirm-after-completion))
 237          (ivy--done ivy-text))
 238         (t
 239          (setq ivy--prompt-extra " (match required)")
 240          (insert ivy-text)
 241          (ivy--exhibit))))
 242
 243 (defun ivy-build-tramp-name (x)
 244   "Reconstruct X into a path.
 245 Is is a cons cell, related to `tramp-get-completion-function'."
 246   (let ((user (car x))
 247         (domain (cadr x)))
 248     (if user
 249         (concat user "@" domain)
 250       domain)))
 251
 252 (declare-function tramp-get-completion-function "tramp")
 253
 254 (defun ivy-alt-done (&optional arg)
 255   "Exit the minibuffer with the selected candidate.
 256 When ARG is t, exit with current text, ignoring the candidates."
 257   (interactive "P")
 258   (if arg
 259       (ivy-immediate-done)
 260     (let (dir)
 261       (cond ((and ivy--directory
 262                   (or
 263                    (and
 264                     (not (string= ivy--current "./"))
 265                     (cl-plusp ivy--length)
 266                     (file-directory-p
 267                      (setq dir (expand-file-name
 268                                 ivy--current ivy--directory))))))
 269              (ivy--cd dir)
 270              (ivy--exhibit))
 271             ((string-match "^/\\([^/]+?\\):\\(?:\\(.*\\)@\\)?" ivy-text)
 272              (let ((method (match-string 1 ivy-text))
 273                    (user (match-string 2 ivy-text))
 274                    res)
 275                (dolist (x (tramp-get-completion-function method))
 276                  (setq res (append res (funcall (car x) (cadr x)))))
 277                (setq res (delq nil res))
 278                (when user
 279                  (dolist (x res)
 280                    (setcar x user)))
 281                (setq res (cl-delete-duplicates res :test 'equal))
 282                (let ((host (ivy-read "Find File: "
 283                                      (mapcar #'ivy-build-tramp-name res))))
 284                  (when host
 285                    (setq ivy--directory "/")
 286                    (ivy--cd (concat "/" method ":" host ":"))))))
 287             (t
 288              (ivy-done))))))
 289
 290 (defcustom ivy-tab-space nil
 291   "When non-nil, `ivy-partial-or-done' should insert a space."
 292   :type 'boolean)
 293
 294 (defun ivy-partial-or-done ()
 295   "Complete the minibuffer text as much as possible.
 296 When called twice in a row, exit the minibuffer with the current
 297 candidate."
 298   (interactive)
 299   (if (and (eq (ivy-state-collection ivy-last) 'read-file-name-internal)
 300            (string-match "^/" ivy-text))
 301       (let ((default-directory ivy--directory))
 302         (minibuffer-complete)
 303         (setq ivy-text (ivy--input))
 304         (when (and (file-directory-p ivy-text)
 305                    (= ivy--length 1))
 306           (ivy--cd (expand-file-name ivy-text))))
 307     (or (ivy-partial)
 308         (if (eq this-command last-command)
 309             (ivy-done)
 310           (ivy-alt-done)))))
 311
 312 (defun ivy-partial ()
 313   "Complete the minibuffer text as much as possible."
 314   (interactive)
 315   (let* ((parts (or (split-string ivy-text " " t) (list "")))
 316          (postfix (car (last parts)))
 317          (completion-ignore-case t)
 318          (new (try-completion postfix
 319                               (mapcar (lambda (str) (substring str (string-match postfix str)))
 320                                       ivy--old-cands))))
 321     (cond ((eq new t) nil)
 322           ((string= new ivy-text) nil)
 323           (new
 324            (delete-region (minibuffer-prompt-end) (point-max))
 325            (setcar (last parts) new)
 326            (insert (mapconcat #'identity parts " ")
 327                    (if ivy-tab-space " " ""))
 328            t))))
 329
 330 (defun ivy-immediate-done ()
 331   "Exit the minibuffer with the current input."
 332   (interactive)
 333   (delete-minibuffer-contents)
 334   (insert ivy-text)
 335   (setq ivy-exit 'done)
 336   (exit-minibuffer))
 337
 338 (defun ivy-resume ()
 339   "Resume the last completion session."
 340   (interactive)
 341   (ivy-read
 342    (ivy-state-prompt ivy-last)
 343    (ivy-state-collection ivy-last)
 344    :predicate (ivy-state-predicate ivy-last)
 345    :require-match (ivy-state-require-match ivy-last)
 346    :initial-input ivy-text
 347    :history (ivy-state-history ivy-last)
 348    :preselect (regexp-quote ivy--current)
 349    :keymap (ivy-state-keymap ivy-last)
 350    :update-fn (ivy-state-update-fn ivy-last)
 351    :sort (ivy-state-sort ivy-last)
 352    :action (ivy-state-action ivy-last)
 353    :unwind (ivy-state-unwind ivy-last)
 354    :re-builder (ivy-state-re-builder ivy-last)
 355    :matcher (ivy-state-matcher ivy-last)
 356    :dynamic-collection (ivy-state-dynamic-collection ivy-last)))
 357
 358 (defun ivy-beginning-of-buffer ()
 359   "Select the first completion candidate."
 360   (interactive)
 361   (setq ivy--index 0))
 362
 363 (defun ivy-end-of-buffer ()
 364   "Select the last completion candidate."
 365   (interactive)
 366   (setq ivy--index (1- ivy--length)))
 367
 368 (defun ivy-scroll-up-command ()
 369   "Scroll the candidates upward by the minibuffer height."
 370   (interactive)
 371   (setq ivy--index (min (+ ivy--index ivy-height)
 372                         (1- ivy--length))))
 373
 374 (defun ivy-scroll-down-command ()
 375   "Scroll the candidates downward by the minibuffer height."
 376   (interactive)
 377   (setq ivy--index (max (- ivy--index ivy-height)
 378                         0)))
 379
 380 (defun ivy-next-line (&optional arg)
 381   "Move cursor vertically down ARG candidates."
 382   (interactive "p")
 383   (setq arg (or arg 1))
 384   (cl-incf ivy--index arg)
 385   (when (>= ivy--index (1- ivy--length))
 386     (if ivy-wrap
 387         (ivy-beginning-of-buffer)
 388       (setq ivy--index (1- ivy--length)))))
 389
 390 (defun ivy-next-line-or-history (&optional arg)
 391   "Move cursor vertically down ARG candidates.
 392 If the input is empty, select the previous history element instead."
 393   (interactive "p")
 394   (when (string= ivy-text "")
 395     (ivy-previous-history-element 1))
 396   (ivy-next-line arg))
 397
 398 (defun ivy-previous-line (&optional arg)
 399   "Move cursor vertically up ARG candidates."
 400   (interactive "p")
 401   (setq arg (or arg 1))
 402   (cl-decf ivy--index arg)
 403   (when (< ivy--index 0)
 404     (if ivy-wrap
 405         (ivy-end-of-buffer)
 406       (setq ivy--index 0))))
 407
 408 (defun ivy-previous-line-or-history (arg)
 409   "Move cursor vertically up ARG candidates.
 410 If the input is empty, select the previous history element instead."
 411   (interactive "p")
 412   (when (string= ivy-text "")
 413     (ivy-previous-history-element 1))
 414   (ivy-previous-line arg))
 415
 416 (defun ivy-next-line-and-call (&optional arg)
 417   "Move cursor vertically down ARG candidates."
 418   (interactive "p")
 419   (ivy-next-line arg)
 420   (ivy--exhibit)
 421   (with-selected-window (ivy-state-window ivy-last)
 422     (funcall (ivy-state-action ivy-last))))
 423
 424 (defun ivy-previous-line-and-call (&optional arg)
 425   "Move cursor vertically down ARG candidates."
 426   (interactive "p")
 427   (ivy-previous-line arg)
 428   (ivy--exhibit)
 429   (with-selected-window (ivy-state-window ivy-last)
 430     (funcall (ivy-state-action ivy-last))))
 431
 432 (defun ivy-previous-history-element (arg)
 433   "Forward to `previous-history-element' with ARG."
 434   (interactive "p")
 435   (previous-history-element arg)
 436   (move-end-of-line 1)
 437   (ivy--maybe-scroll-history))
 438
 439 (defun ivy-next-history-element (arg)
 440   "Forward to `next-history-element' with ARG."
 441   (interactive "p")
 442   (next-history-element arg)
 443   (move-end-of-line 1)
 444   (ivy--maybe-scroll-history))
 445
 446 (defun ivy--maybe-scroll-history ()
 447   "If the selected history element has an index, scroll there."
 448   (let ((idx (ignore-errors
 449                (get-text-property
 450                 (minibuffer-prompt-end)
 451                 'ivy-index))))
 452     (when idx
 453       (ivy--exhibit)
 454       (setq ivy--index idx))))
 455
 456 (defun ivy--cd (dir)
 457   "When completing file names, move to directory DIR."
 458   (if (null ivy--directory)
 459       (error "Unexpected")
 460     (setq ivy--old-cands nil)
 461     (setq ivy--old-re nil)
 462     (setq ivy--index 0)
 463     (setq ivy--all-candidates
 464           (ivy--sorted-files (setq ivy--directory dir)))
 465     (setq ivy-text "")
 466     (delete-minibuffer-contents)))
 467
 468 (defun ivy-backward-delete-char ()
 469   "Forward to `backward-delete-char'.
 470 On error (read-only), call `ivy-on-del-error-function'."
 471   (interactive)
 472   (if (and ivy--directory (= (minibuffer-prompt-end) (point)))
 473       (progn
 474         (ivy--cd (file-name-directory
 475                   (directory-file-name
 476                    (expand-file-name
 477                     ivy--directory))))
 478         (ivy--exhibit))
 479     (condition-case nil
 480         (backward-delete-char 1)
 481       (error
 482        (when ivy-on-del-error-function
 483          (funcall ivy-on-del-error-function))))))
 484
 485 (defun ivy-backward-kill-word ()
 486   "Forward to `backward-kill-word'."
 487   (interactive)
 488   (if (and ivy--directory (= (minibuffer-prompt-end) (point)))
 489       (progn
 490         (ivy--cd (file-name-directory
 491                   (directory-file-name
 492                    (expand-file-name
 493                     ivy--directory))))
 494         (ivy--exhibit))
 495     (ignore-errors
 496       (backward-kill-word 1))))
 497
 498 (defvar ivy--regexp-quote 'regexp-quote
 499   "Store the regexp quoting state.")
 500
 501 (defun ivy-toggle-regexp-quote ()
 502   "Toggle the regexp quoting."
 503   (interactive)
 504   (setq ivy--old-re nil)
 505   (cl-rotatef ivy--regex-function ivy--regexp-quote))
 506
 507 (defun ivy-sort-file-function-default (x y)
 508   "Compare two files X and Y.
 509 Prioritize directories."
 510   (if (get-text-property 0 'dirp x)
 511       (if (get-text-property 0 'dirp y)
 512           (string< x y)
 513         t)
 514     (if (get-text-property 0 'dirp y)
 515         nil
 516       (string< x y))))
 517
 518 (defvar ivy-sort-functions-alist
 519   '((read-file-name-internal . ivy-sort-file-function-default)
 520     (internal-complete-buffer . nil)
 521     (counsel-git-grep-function . nil)
 522     (t . string-lessp))
 523   "An alist of sorting functions for each collection function.
 524 For each entry, nil means no sorting.
 525 The entry associated to t is used for all fall-through cases.")
 526
 527 (defvar ivy-re-builders-alist
 528   '((t . ivy--regex-plus))
 529   "An alist of regex building functions for each collection function.
 530 Each function should take a string and return a valid regex or a
 531 regex sequence (see below).
 532
 533 The entry associated to t is used for all fall-through cases.
 534 Possible choices: `ivy--regex', `regexp-quote', `ivy--regex-plus'.
 535
 536 In case a function returns a list, it should look like this:
 537 '((\"matching-regexp\" . t) (\"non-matching-regexp\") ...).
 538
 539 The matches will be filtered in a sequence, you can mix the
 540 regexps that should match and that should not match as you
 541 like.")
 542
 543 (defcustom ivy-sort-max-size 30000
 544   "Sorting won't be done for collections larger than this."
 545   :type 'integer)
 546
 547 (defun ivy--sorted-files (dir)
 548   "Return the list of files in DIR.
 549 Directories come first."
 550   (let* ((default-directory dir)
 551          (seq (all-completions "" 'read-file-name-internal))
 552          sort-fn)
 553     (if (equal dir "/")
 554         seq
 555       (setq seq (delete "./" (delete "../" seq)))
 556       (when (eq (setq sort-fn (cdr (assoc 'read-file-name-internal
 557                                           ivy-sort-functions-alist)))
 558                 'ivy-sort-file-function-default)
 559         (setq seq (mapcar (lambda (x)
 560                             (propertize x 'dirp (string-match-p "/$" x)))
 561                           seq)))
 562       (when sort-fn
 563         (setq seq (cl-sort seq sort-fn)))
 564       (dolist (dir ivy-extra-directories)
 565         (push dir seq))
 566       seq)))
 567
 568 ;;** Entry Point
 569 (cl-defun ivy-read (prompt collection
 570                     &key predicate require-match initial-input
 571                       history preselect keymap update-fn sort
 572                       action unwind re-builder matcher dynamic-collection)
 573   "Read a string in the minibuffer, with completion.
 574
 575 PROMPT is a string to prompt with; normally it ends in a colon
 576 and a space.  When PROMPT contains %d, it will be updated with
 577 the current number of matching candidates.
 578 See also `ivy-count-format'.
 579
 580 COLLECTION is a list of strings.
 581
 582 If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.
 583
 584 KEYMAP is composed together with `ivy-minibuffer-map'.
 585
 586 If PRESELECT is non-nil select the corresponding candidate out of
 587 the ones that match INITIAL-INPUT.
 588
 589 UPDATE-FN is called each time the current candidate(s) is changed.
 590
 591 When SORT is t, refer to `ivy-sort-functions-alist' for sorting.
 592
 593 ACTION is a lambda to call after a result was selected.
 594
 595 UNWIND is a lambda to call before exiting.
 596
 597 RE-BUILDER is a lambda that transforms text into a regex.
 598
 599 MATCHER can completely override matching.
 600
 601 DYNAMIC-COLLECTION is a function to call to update the list of
 602 candidates with each input."
 603   (setq ivy-last
 604         (make-ivy-state
 605          :prompt prompt
 606          :collection collection
 607          :predicate predicate
 608          :require-match require-match
 609          :initial-input initial-input
 610          :history history
 611          :preselect preselect
 612          :keymap keymap
 613          :update-fn update-fn
 614          :sort sort
 615          :action action
 616          :window (selected-window)
 617          :unwind unwind
 618          :re-builder re-builder
 619          :matcher matcher
 620          :dynamic-collection dynamic-collection))
 621   (setq ivy--directory nil)
 622   (setq ivy--regex-function
 623         (or re-builder
 624             (and (functionp collection)
 625                  (cdr (assoc collection ivy-re-builders-alist)))
 626             (cdr (assoc t ivy-re-builders-alist))
 627             'ivy--regex))
 628   (setq ivy--subexps 0)
 629   (setq ivy--regexp-quote 'regexp-quote)
 630   (setq ivy--old-text "")
 631   (setq ivy-text "")
 632   (let (coll sort-fn)
 633     (cond ((eq collection 'Info-read-node-name-1)
 634            (if (equal Info-current-file "dir")
 635                (setq coll
 636                      (mapcar (lambda (x) (format "(%s)" x))
 637                              (cl-delete-duplicates
 638                               (all-completions "(" collection predicate)
 639                               :test 'equal)))
 640              (setq coll (all-completions "" collection predicate))))
 641           ((eq collection 'read-file-name-internal)
 642            (setq ivy--directory default-directory)
 643            (require 'dired)
 644            (setq coll
 645                  (ivy--sorted-files default-directory))
 646            (when initial-input
 647              (unless (or require-match
 648                          (equal initial-input default-directory))
 649                (setq coll (cons initial-input coll)))
 650              (setq initial-input nil)))
 651           ((eq collection 'internal-complete-buffer)
 652            (setq coll (ivy--buffer-list "" ivy-use-virtual-buffers)))
 653           ((or (functionp collection)
 654                (vectorp collection)
 655                (listp (car collection)))
 656            (setq coll (all-completions "" collection predicate)))
 657           ((hash-table-p collection)
 658            (error "Hash table as a collection unsupported"))
 659           (t
 660            (setq coll collection)))
 661     (when sort
 662       (if (and (functionp collection)
 663                (setq sort-fn (assoc collection ivy-sort-functions-alist)))
 664           (when (and (setq sort-fn (cdr sort-fn))
 665                      (not (eq collection 'read-file-name-internal)))
 666             (setq coll (cl-sort coll sort-fn)))
 667         (unless (eq history 'org-refile-history)
 668           (if (and (setq sort-fn (cdr (assoc t ivy-sort-functions-alist)))
 669                    (<= (length coll) ivy-sort-max-size))
 670               (setq coll (cl-sort (copy-sequence coll) sort-fn))))))
 671     (when preselect
 672       (unless (or require-match
 673                   (cl-find-if `(lambda (x)
 674                                  (string-match ,(format "^%s" preselect) x))
 675                               coll))
 676         (setq coll (cons preselect coll))))
 677     (setq ivy--index (or
 678                       (and dynamic-collection
 679                            ivy--index)
 680                       (and preselect
 681                            (ivy--preselect-index
 682                             coll initial-input preselect))
 683                       0))
 684     (setq ivy--old-re nil)
 685     (setq ivy--old-cands nil)
 686     (setq ivy--all-candidates coll)
 687     (setq ivy-exit nil)
 688     (setq ivy--default (or (thing-at-point 'symbol) ""))
 689     (setq ivy--prompt
 690           (cond ((string-match "%.*d" prompt)
 691                  prompt)
 692                 ((string-match "%.*d" ivy-count-format)
 693                  (concat ivy-count-format prompt))
 694                 (ivy--directory
 695                  prompt)
 696                 (t
 697                  nil)))
 698     (prog1
 699         (unwind-protect
 700              (minibuffer-with-setup-hook
 701                  #'ivy--minibuffer-setup
 702                (let* ((hist (or history 'ivy-history))
 703                       (minibuffer-completion-table collection)
 704                       (minibuffer-completion-predicate predicate)
 705                       (res (read-from-minibuffer
 706                             prompt
 707                             initial-input
 708                             (make-composed-keymap keymap ivy-minibuffer-map)
 709                             nil
 710                             hist)))
 711                  (when (eq ivy-exit 'done)
 712                    (set hist (cons (propertize ivy-text 'ivy-index ivy--index)
 713                                    (delete ivy-text
 714                                            (cdr (symbol-value hist)))))
 715                    res)))
 716           (remove-hook 'post-command-hook #'ivy--exhibit)
 717           (when (setq unwind (ivy-state-unwind ivy-last))
 718             (funcall unwind)))
 719       (when (setq action (ivy-state-action ivy-last))
 720         (funcall action)))))
 721
 722 (defun ivy-completing-read (prompt collection
 723                             &optional predicate require-match initial-input
 724                               history def _inherit-input-method)
 725   "Read a string in the minibuffer, with completion.
 726
 727 This is an interface that conforms to `completing-read', so that
 728 it can be used for `completing-read-function'.
 729
 730 PROMPT is a string to prompt with; normally it ends in a colon and a space.
 731 COLLECTION can be a list of strings, an alist, an obarray or a hash table.
 732 PREDICATE limits completion to a subset of COLLECTION.
 733 REQUIRE-MATCH is considered boolean. See `completing-read'.
 734 INITIAL-INPUT is a string that can be inserted into the minibuffer initially.
 735 _HISTORY is ignored for now.
 736 DEF is the default value.
 737 _INHERIT-INPUT-METHOD is ignored for now.
 738
 739 The history, defaults and input-method arguments are ignored for now."
 740   (ivy-read prompt collection
 741             :predicate predicate
 742             :require-match require-match
 743             :initial-input initial-input
 744             :preselect (if (listp def) (car def) def)
 745             :history history
 746             :keymap nil
 747             :sort t))
 748
 749 ;;;###autoload
 750 (define-minor-mode ivy-mode
 751   "Toggle Ivy mode on or off.
 752 With ARG, turn Ivy mode on if arg is positive, off otherwise.
 753 Turning on Ivy mode will set `completing-read-function' to
 754 `ivy-completing-read'.
 755
 756 Global bindings:
 757 \\{ivy-mode-map}
 758
 759 Minibuffer bindings:
 760 \\{ivy-minibuffer-map}"
 761   :group 'ivy
 762   :global t
 763   :keymap ivy-mode-map
 764   :lighter " ivy"
 765   (if ivy-mode
 766       (setq completing-read-function 'ivy-completing-read)
 767     (setq completing-read-function 'completing-read-default)))
 768
 769 (defun ivy--preselect-index (candidates initial-input preselect)
 770   "Return the index in CANDIDATES filtered by INITIAL-INPUT for PRESELECT."
 771   (when initial-input
 772     (setq initial-input (ivy--regex-plus initial-input))
 773     (setq candidates
 774           (cl-remove-if-not
 775            (lambda (x)
 776              (string-match initial-input x))
 777            candidates)))
 778   (or (cl-position preselect candidates :test 'equal)
 779       (cl-position-if
 780        (lambda (x)
 781          (string-match preselect x))
 782        candidates)))
 783
 784 ;;* Implementation
 785 ;;** Regex
 786 (defvar ivy--subexps 0
 787   "Number of groups in the current `ivy--regex'.")
 788
 789 (defvar ivy--regex-hash
 790   (make-hash-table :test 'equal)
 791   "Store pre-computed regex.")
 792
 793 (defun ivy--split (str)
 794   "Split STR into a list by single spaces.
 795 The remaining spaces stick to their left.
 796 This allows to \"quote\" N spaces by inputting N+1 spaces."
 797   (let ((len (length str))
 798         (start 0)
 799         res s)
 800     (while (and (string-match " +" str start)
 801                 (< start len))
 802       (setq s (substring str start (1- (match-end 0))))
 803       (unless (= (length s) 0)
 804         (push s res))
 805       (setq start (match-end 0)))
 806     (setq s (substring str start))
 807     (unless (= (length s) 0)
 808       (push s res))
 809     (nreverse res)))
 810
 811 (defun ivy--regex (str &optional greedy)
 812   "Re-build regex from STR in case it has a space.
 813 When GREEDY is non-nil, join words in a greedy way."
 814   (let ((hashed (unless greedy
 815                   (gethash str ivy--regex-hash))))
 816     (if hashed
 817         (prog1 (cdr hashed)
 818           (setq ivy--subexps (car hashed)))
 819       (cdr (puthash str
 820                     (let ((subs (ivy--split str)))
 821                       (if (= (length subs) 1)
 822                           (cons
 823                            (setq ivy--subexps 0)
 824                            (car subs))
 825                         (cons
 826                          (setq ivy--subexps (length subs))
 827                          (mapconcat
 828                           (lambda (x)
 829                             (if (string-match "^\\\\(.*\\\\)$" x)
 830                                 x
 831                               (format "\\(%s\\)" x)))
 832                           subs
 833                           (if greedy
 834                               ".*"
 835                             ".*?")))))
 836                     ivy--regex-hash)))))
 837
 838 (defun ivy--regex-ignore-order (str)
 839   "Re-build regex from STR by splitting it on spaces.
 840 Ignore the order of each group."
 841   (let* ((subs (split-string str " +" t))
 842          (len (length subs)))
 843     (cl-case len
 844       (1
 845        (setq ivy--subexps 0)
 846        (car subs))
 847       (t
 848        (setq ivy--subexps len)
 849        (let ((all (mapconcat #'identity subs "\\|")))
 850          (mapconcat
 851           (lambda (x)
 852             (if (string-match "^\\\\(.*\\\\)$" x)
 853                 x
 854               (format "\\(%s\\)" x)))
 855           (make-list len all)
 856           ".*?"))))))
 857
 858 (defun ivy--regex-plus (str)
 859   "Build a regex sequence from STR.
 860 Spaces are wild, everything before \"!\" should match.
 861 Everything after \"!\" should not match."
 862   (let ((parts (split-string str "!" t)))
 863     (cl-case (length parts)
 864       (0
 865        "")
 866       (1
 867        (ivy--regex (car parts)))
 868       (2
 869        (let ((res
 870               (mapcar #'list
 871                       (split-string (cadr parts) " " t))))
 872          (cons (cons (ivy--regex (car parts)) t)
 873                res)))
 874       (t (error "Unexpected: use only one !")))))
 875
 876 ;;** Rest
 877 (defun ivy--minibuffer-setup ()
 878   "Setup ivy completion in the minibuffer."
 879   (set (make-local-variable 'completion-show-inline-help) nil)
 880   (set (make-local-variable 'minibuffer-default-add-function)
 881        (lambda ()
 882          (list ivy--default)))
 883   (setq-local max-mini-window-height ivy-height)
 884   (add-hook 'post-command-hook #'ivy--exhibit nil t)
 885   ;; show completions with empty input
 886   (ivy--exhibit))
 887
 888 (defun ivy--input ()
 889   "Return the current minibuffer input."
 890   ;; assume one-line minibuffer input
 891   (buffer-substring-no-properties
 892    (minibuffer-prompt-end)
 893    (line-end-position)))
 894
 895 (defun ivy--cleanup ()
 896   "Delete the displayed completion candidates."
 897   (save-excursion
 898     (goto-char (minibuffer-prompt-end))
 899     (delete-region (line-end-position) (point-max))))
 900
 901 (defvar ivy--full-length nil
 902   "When :dynamic-collection is non-nil, this can be the total amount of candidates.")
 903
 904 (defvar ivy--old-text ""
 905   "Store old `ivy-text' for dynamic completion.")
 906
 907 (defun ivy--insert-prompt ()
 908   "Update the prompt according to `ivy--prompt'."
 909   (when ivy--prompt
 910     (unless (memq this-command '(ivy-done ivy-alt-done ivy-partial-or-done
 911                                  counsel-find-symbol))
 912       (setq ivy--prompt-extra ""))
 913     (let (head tail)
 914       (if (string-match "\\(.*\\): $" ivy--prompt)
 915           (progn
 916             (setq head (match-string 1 ivy--prompt))
 917             (setq tail ": "))
 918         (setq head (substring ivy--prompt 0 -1))
 919         (setq tail " "))
 920       (let ((inhibit-read-only t)
 921             (std-props '(front-sticky t rear-nonsticky t field t read-only t))
 922             (n-str
 923              (format
 924               (concat head
 925                       ivy--prompt-extra
 926                       tail
 927                       (if ivy--directory
 928                           (abbreviate-file-name ivy--directory)
 929                         ""))
 930               (or (and (ivy-state-dynamic-collection ivy-last)
 931                        ivy--full-length)
 932                   ivy--length))))
 933         (save-excursion
 934           (goto-char (point-min))
 935           (delete-region (point-min) (minibuffer-prompt-end))
 936           (set-text-properties 0 (length n-str)
 937                                `(face minibuffer-prompt ,@std-props)
 938                                n-str)
 939           (ivy--set-match-props n-str "confirm"
 940                                 `(face ivy-confirm-face ,@std-props))
 941           (ivy--set-match-props n-str "match required"
 942                                 `(face ivy-match-required-face ,@std-props))
 943           (insert n-str))
 944         ;; get out of the prompt area
 945         (constrain-to-field nil (point-max))))))
 946
 947 (defun ivy--set-match-props (str match props)
 948   "Set STR text proprties that match MATCH to PROPS."
 949   (when (string-match match str)
 950     (set-text-properties
 951      (match-beginning 0)
 952      (match-end 0)
 953      props
 954      str)))
 955
 956 (defvar inhibit-message)
 957
 958 (defun ivy--exhibit ()
 959   "Insert Ivy completions display.
 960 Should be run via minibuffer `post-command-hook'."
 961   (setq ivy-text (ivy--input))
 962   (if (ivy-state-dynamic-collection ivy-last)
 963       ;; while-no-input would cause annoying
 964       ;; "Waiting for process to die...done" message interruptions
 965       (let ((inhibit-message t))
 966         (while-no-input
 967           (unless (equal ivy--old-text ivy-text)
 968             (cl-letf ((store (ivy-state-dynamic-collection ivy-last))
 969                       ((ivy-state-dynamic-collection ivy-last) nil))
 970               (setq ivy--all-candidates (funcall store ivy-text))))
 971           (ivy--insert-minibuffer (ivy--format ivy--all-candidates))))
 972     (cond (ivy--directory
 973            (if (string-match "/$" ivy-text)
 974                (if (member ivy-text ivy--all-candidates)
 975                    (ivy--cd (expand-file-name ivy-text ivy--directory))
 976                  (when (string-match "//$" ivy-text)
 977                    (ivy--cd "/")))
 978              (if (string-match "~$" ivy-text)
 979                  (ivy--cd (expand-file-name "~/")))))
 980           ((eq (ivy-state-collection ivy-last) 'internal-complete-buffer)
 981            (when (or (and (string-match "^ " ivy-text)
 982                           (not (string-match "^ " ivy--old-text)))
 983                      (and (string-match "^ " ivy--old-text)
 984                           (not (string-match "^ " ivy-text))))
 985              (setq ivy--all-candidates
 986                    (if (and (> (length ivy-text) 0)
 987                             (eq (aref ivy-text 0)
 988                                 ?\ ))
 989                        (ivy--buffer-list " ")
 990                      (ivy--buffer-list "" ivy-use-virtual-buffers)))
 991              (setq ivy--old-re nil))))
 992     (ivy--insert-minibuffer
 993      (ivy--format
 994       (ivy--filter ivy-text ivy--all-candidates))))
 995   (setq ivy--old-text ivy-text))
 996
 997 (defun ivy--insert-minibuffer (text)
 998   "Insert TEXT into minibuffer with appropriate cleanup."
 999   (let ((resize-mini-windows nil)
1000         (buffer-undo-list t)
1001         (update-fn (ivy-state-update-fn ivy-last))
1002         deactivate-mark)
1003     (ivy--cleanup)
1004     (when update-fn
1005       (funcall update-fn))
1006     (ivy--insert-prompt)
1007     ;; Do nothing if while-no-input was aborted.
1008     (when (stringp text)
1009       (save-excursion
1010         (forward-line 1)
1011         (insert text)))))
1012
1013 (defun ivy--add-face (str face)
1014   "Propertize STR with FACE.
1015 `font-lock-append-text-property' is used, since it's better than
1016 `propertize' or `add-face-text-property' in this case."
1017   (require 'colir)
1018   (condition-case nil
1019       (colir-blend-face-background 0 (length str) face str)
1020     (error
1021      (ignore-errors
1022        (font-lock-append-text-property 0 (length str) 'face face str))))
1023   str)
1024
1025 (defun ivy--filter (name candidates)
1026   "Return all items that match NAME in CANDIDATES.
1027 CANDIDATES are assumed to be static."
1028   (let* ((re (funcall ivy--regex-function name))
1029          (matcher (ivy-state-matcher ivy-last))
1030          (cands (cond
1031                   (matcher
1032                    (let ((ivy--old-re re))
1033                      (cl-remove-if-not matcher candidates)))
1034                   ((and (equal re ivy--old-re)
1035                         ivy--old-cands)
1036                    ivy--old-cands)
1037                   ((and ivy--old-re
1038                         (stringp re)
1039                         (stringp ivy--old-re)
1040                         (not (string-match "\\\\" ivy--old-re))
1041                         (not (equal ivy--old-re ""))
1042                         (memq (cl-search
1043                                (if (string-match "\\\\)$" ivy--old-re)
1044                                    (substring ivy--old-re 0 -2)
1045                                  ivy--old-re)
1046                                re) '(0 2)))
1047                    (ignore-errors
1048                      (cl-remove-if-not
1049                       (lambda (x) (string-match re x))
1050                       ivy--old-cands)))
1051                   (t
1052                    (let ((re-list (if (stringp re) (list (cons re t)) re))
1053                          (res candidates))
1054                      (dolist (re re-list)
1055                        (setq res
1056                              (ignore-errors
1057                                (funcall
1058                                 (if (cdr re)
1059                                     #'cl-remove-if-not
1060                                   #'cl-remove-if)
1061                                 `(lambda (x) (string-match ,(car re) x))
1062                                 res))))
1063                      res))))
1064          (tail (nthcdr ivy--index ivy--old-cands))
1065          idx)
1066     (when (and tail ivy--old-cands)
1067       (unless (and (not (equal re ivy--old-re))
1068                    (or (setq ivy--index
1069                              (or
1070                               (cl-position re cands
1071                                            :test 'equal)
1072                               (and ivy--directory
1073                                    (cl-position
1074                                     (concat re "/") cands
1075                                     :test 'equal))))))
1076         (while (and tail (null idx))
1077           ;; Compare with eq to handle equal duplicates in cands
1078           (setq idx (cl-position (pop tail) cands)))
1079         (setq ivy--index (or idx 0))))
1080     (when (and (string= name "") (not (equal ivy--old-re "")))
1081       (setq ivy--index
1082             (or (cl-position (ivy-state-preselect ivy-last)
1083                              cands :test 'equal)
1084                 ivy--index)))
1085     (setq ivy--old-re (if cands re ""))
1086     (setq ivy--old-cands cands)))
1087
1088 (defvar ivy-format-function 'ivy-format-function-default
1089   "Function to transform the list of candidates into a string.
1090 This string will be inserted into the minibuffer.")
1091
1092 (defun ivy-format-function-default (cands)
1093   "Transform CANDS into a string for minibuffer."
1094   (let ((ww (window-width)))
1095     (mapconcat
1096      (lambda (s)
1097        (if (> (length s) ww)
1098            (concat (substring s 0 (- ww 3)) "...")
1099          s))
1100      cands "\n")))
1101
1102 (defun ivy-format-function-arrow (cands)
1103   "Transform CANDS into a string for minibuffer."
1104   (let ((i -1))
1105     (mapconcat
1106      (lambda (s)
1107        (concat (if (eq (cl-incf i) ivy--index)
1108                    "==> "
1109                  "    ")
1110                s))
1111      cands "\n")))
1112
1113 (defun ivy--format (cands)
1114   "Return a string for CANDS suitable for display in the minibuffer.
1115 CANDS is a list of strings."
1116   (setq ivy--length (length cands))
1117   (when (>= ivy--index ivy--length)
1118     (setq ivy--index (max (1- ivy--length) 0)))
1119   (if (null cands)
1120       (setq ivy--current "")
1121     (let* ((half-height (/ ivy-height 2))
1122            (start (max 0 (- ivy--index half-height)))
1123            (end (min (+ start (1- ivy-height)) ivy--length))
1124            (cands (cl-subseq cands start end))
1125            (index (min ivy--index half-height (1- (length cands)))))
1126       (when ivy--directory
1127         (setq cands (mapcar (lambda (x)
1128                               (if (string-match-p "/$" x)
1129                                   (propertize x 'face 'ivy-subdir)
1130                                 x))
1131                             cands)))
1132       (setq ivy--current (copy-sequence (nth index cands)))
1133       (setf (nth index cands)
1134             (ivy--add-face ivy--current 'ivy-current-match))
1135       (let* ((ivy--index index)
1136              (res (concat "\n" (funcall ivy-format-function cands))))
1137         (put-text-property 0 (length res) 'read-only nil res)
1138         res))))
1139
1140 (defvar ivy--virtual-buffers nil
1141   "Store the virtual buffers alist.")
1142
1143 (defvar recentf-list)
1144 (defvar ido-use-faces)
1145
1146 (defun ivy--virtual-buffers ()
1147   "Adapted from `ido-add-virtual-buffers-to-list'."
1148   (unless recentf-mode
1149     (recentf-mode 1))
1150   (let ((bookmarks (and (boundp 'bookmark-alist)
1151                         bookmark-alist))
1152         virtual-buffers name)
1153     (dolist (head (append
1154                    recentf-list
1155                    (delete "   - no file -"
1156                            (delq nil (mapcar (lambda (bookmark)
1157                                                (cdr (assoc 'filename bookmark)))
1158                                              bookmarks)))))
1159       (setq name (file-name-nondirectory head))
1160       (when (equal name "")
1161         (setq name (file-name-nondirectory (directory-file-name head))))
1162       (when (equal name "")
1163         (setq name head))
1164       (and (not (equal name ""))
1165            (null (get-file-buffer head))
1166            (not (assoc name virtual-buffers))
1167            (push (cons name head) virtual-buffers)))
1168     (when virtual-buffers
1169       (if ido-use-faces
1170           (dolist (comp virtual-buffers)
1171             (put-text-property 0 (length (car comp))
1172                                'face 'ido-virtual
1173                                (car comp))))
1174       (setq ivy--virtual-buffers (nreverse virtual-buffers))
1175       (mapcar #'car ivy--virtual-buffers))))
1176
1177 (defun ivy--buffer-list (str &optional virtual)
1178   "Return the buffers that match STR.
1179 When VIRTUAL is non-nil, add virtual buffers."
1180   (delete-dups
1181    (append
1182     (mapcar
1183      (lambda (x)
1184        (if (with-current-buffer x
1185              (file-remote-p
1186               (abbreviate-file-name default-directory)))
1187            (propertize x 'face 'ivy-remote)
1188          x))
1189      (all-completions str 'internal-complete-buffer))
1190     (and virtual
1191          (ivy--virtual-buffers)))))
1192
1193 (defun ivy--switch-buffer-action ()
1194   "Finalizer for `ivy-switch-buffer'."
1195   (if (zerop (length ivy--current))
1196       (switch-to-buffer
1197        ivy-text nil 'force-same-window)
1198     (let ((virtual (assoc ivy--current ivy--virtual-buffers)))
1199       (if virtual
1200           (find-file (cdr virtual))
1201         (switch-to-buffer
1202          ivy--current nil 'force-same-window)))))
1203
1204 (defun ivy-switch-buffer ()
1205   "Switch to another buffer."
1206   (interactive)
1207   (if (not ivy-mode)
1208       (call-interactively 'switch-to-buffer)
1209     (ivy-read "Switch to buffer: " 'internal-complete-buffer
1210               :action #'ivy--switch-buffer-action
1211               :preselect (buffer-name (other-buffer (current-buffer))))))
1212
1213 (provide 'ivy)
1214
1215 ;;; ivy.el ends here