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