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 ;;* User Visible
  93 ;;** Keymap
  94 (require 'delsel)
  95 (defvar ivy-minibuffer-map
  96   (let ((map (make-sparse-keymap)))
  97     (define-key map (kbd "C-m") 'ivy-done)
  98     (define-key map (kbd "C-j") 'ivy-alt-done)
  99     (define-key map (kbd "TAB") 'ivy-partial-or-done)
 100     (define-key map (kbd "C-n") 'ivy-next-line)
 101     (define-key map (kbd "C-p") 'ivy-previous-line)
 102     (define-key map (kbd "<down>") 'ivy-next-line)
 103     (define-key map (kbd "<up>") 'ivy-previous-line)
 104     (define-key map (kbd "C-s") 'ivy-next-line-or-history)
 105     (define-key map (kbd "C-r") 'ivy-previous-line-or-history)
 106     (define-key map (kbd "SPC") 'self-insert-command)
 107     (define-key map (kbd "DEL") 'ivy-backward-delete-char)
 108     (define-key map (kbd "M-<") 'ivy-beginning-of-buffer)
 109     (define-key map (kbd "M->") 'ivy-end-of-buffer)
 110     (define-key map (kbd "<left>") 'ivy-beginning-of-buffer)
 111     (define-key map (kbd "<right>") 'ivy-end-of-buffer)
 112     (define-key map (kbd "M-n") 'ivy-next-history-element)
 113     (define-key map (kbd "M-p") 'ivy-previous-history-element)
 114     (define-key map (kbd "C-g") 'minibuffer-keyboard-quit)
 115     (define-key map (kbd "C-v") 'ivy-scroll-up-command)
 116     (define-key map (kbd "M-v") 'ivy-scroll-down-command)
 117     (define-key map (kbd "C-M-n") 'ivy-next-line-and-call)
 118     (define-key map (kbd "C-M-p") 'ivy-previous-line-and-call)
 119     (define-key map (kbd "M-q") 'ivy-toggle-regexp-quote)
 120     map)
 121   "Keymap used in the minibuffer.")
 122
 123 (defvar ivy-history nil
 124   "History list of candidates entered in the minibuffer.
 125
 126 Maximum length of the history list is determined by the value
 127 of `history-length', which see.")
 128
 129 (defvar ivy-require-match t
 130   "Store require-match.  See `completing-read'.")
 131
 132 (defvar ivy-def nil
 133   "Store the default completion value.  See `completing-read'.")
 134
 135 (defvar ivy--directory nil
 136   "Current directory when completing file names.")
 137
 138 (defvar ivy--length 0
 139   "Store the amount of viable candidates.")
 140
 141 (defvar ivy-text ""
 142   "Store the user's string as it is typed in.")
 143
 144 (defvar ivy-window nil
 145   "Store the window in which `ivy-read' was called.")
 146
 147 (defvar ivy--current ""
 148   "Current candidate.")
 149
 150 (defvar ivy--index 0
 151   "Store the index of the current candidate.")
 152
 153 (defvar ivy-exit nil
 154   "Store 'done if the completion was successfully selected.
 155 Otherwise, store nil.")
 156
 157 (defvar ivy--action nil
 158   "Store a function to call at the end of `ivy--read'.")
 159
 160 (defvar ivy--persistent-action nil
 161   "Store a function to call for current candidate without exiting.")
 162
 163 (defvar ivy--all-candidates nil
 164   "Store the candidates passed to `ivy-read'.")
 165
 166 (defvar ivy--default nil
 167   "Default initial input.")
 168
 169 (defvar ivy--update-fn nil
 170   "Current function to call when current candidate(s) update.")
 171
 172 (defvar ivy--prompt nil
 173   "Store the format-style prompt.
 174 When non-nil, it should contain one %d.")
 175
 176 (defvar ivy--prompt-extra ""
 177   "Temporary modifications to the prompt.")
 178
 179 (defvar ivy--old-re nil
 180   "Store the old regexp.")
 181
 182 (defvar ivy--old-cands nil
 183   "Store the candidates matched by `ivy--old-re'.")
 184
 185 (defvar ivy--regex-function 'ivy--regex
 186   "Current function for building a regex.")
 187
 188 (defvar ivy--collection nil
 189   "Store the current collection function.")
 190
 191 (defvar Info-current-file)
 192
 193 ;;** Commands
 194 (defun ivy-done ()
 195   "Exit the minibuffer with the selected candidate."
 196   (interactive)
 197   (delete-minibuffer-contents)
 198   (when (cond (ivy--directory
 199                (if (zerop ivy--length)
 200                    (if (or (not (eq confirm-nonexistent-file-or-buffer t))
 201                            (equal " (confirm)" ivy--prompt-extra))
 202                        (progn
 203                          (insert
 204                           (expand-file-name ivy-text ivy--directory))
 205                          (setq ivy-exit 'done))
 206                      (setq ivy--prompt-extra " (confirm)")
 207                      (insert ivy-text)
 208                      (ivy--exhibit)
 209                      nil)
 210                  (insert
 211                   (expand-file-name
 212                    ivy--current ivy--directory))
 213                  (setq ivy-exit 'done)))
 214               ((zerop ivy--length)
 215                (if (memq ivy-require-match
 216                          '(nil confirm confirm-after-completion))
 217                    (progn
 218                      (insert ivy-text)
 219                      (setq ivy-exit 'done))
 220                  (setq ivy--prompt-extra " (match required)")
 221                  (insert ivy-text)
 222                  (ivy--exhibit)
 223                  nil))
 224               (t
 225                (insert ivy--current)
 226                (setq ivy-exit 'done)))
 227     (exit-minibuffer)))
 228
 229 (defun ivy-build-tramp-name (x)
 230   "Reconstruct X into a path.
 231 Is is a cons cell, related to `tramp-get-completion-function'."
 232   (let ((user (car x))
 233         (domain (cadr x)))
 234     (if user
 235         (concat user "@" domain)
 236       domain)))
 237
 238 (defun ivy-alt-done (&optional arg)
 239   "Exit the minibuffer with the selected candidate.
 240 When ARG is t, exit with current text, ignoring the candidates."
 241   (interactive "P")
 242   (if arg
 243       (ivy-immediate-done)
 244     (let (dir)
 245       (cond ((and ivy--directory
 246                   (or
 247                    (and
 248                     (not (string= ivy--current "./"))
 249                     (cl-plusp ivy--length)
 250                     (file-directory-p
 251                      (setq dir (expand-file-name
 252                                 ivy--current ivy--directory))))))
 253              (ivy--cd dir)
 254              (ivy--exhibit))
 255             ((string-match "^/\\([^/]+?\\):\\(?:\\(.*\\)@\\)?" ivy-text)
 256              (let ((method (match-string 1 ivy-text))
 257                    (user (match-string 2 ivy-text))
 258                    res)
 259                (dolist (x (tramp-get-completion-function method))
 260                  (setq res (append res (funcall (car x) (cadr x)))))
 261                (setq res (delq nil res))
 262                (when user
 263                  (dolist (x res)
 264                    (setcar x user)))
 265                (setq res (cl-delete-duplicates res :test 'equal))
 266                (let ((host (ivy-read "Find File: "
 267                                      (mapcar #'ivy-build-tramp-name res))))
 268                  (when host
 269                    (setq ivy--directory "/")
 270                    (ivy--cd (concat "/" method ":" host ":"))))))
 271             (t
 272              (ivy-done))))))
 273
 274 (defun ivy-partial-or-done ()
 275   "Complete the minibuffer text as much as possible.
 276 When called twice in a row, exit the minibuffer with the current
 277 candidate."
 278   (interactive)
 279   (if (eq this-command last-command)
 280       (progn
 281         (delete-minibuffer-contents)
 282         (insert ivy--current)
 283         (setq ivy-exit 'done)
 284         (exit-minibuffer))
 285     (let* ((parts (split-string ivy-text " " t))
 286            (postfix (car (last parts)))
 287            (new (try-completion postfix
 288                                 (mapcar (lambda (str) (substring str (string-match postfix str)))
 289                                         ivy--old-cands))))
 290       (delete-region (minibuffer-prompt-end) (point-max))
 291       (setcar (last parts) new)
 292       (insert (mapconcat #'identity parts " ") " "))))
 293
 294 (defun ivy-immediate-done ()
 295   "Exit the minibuffer with the current input."
 296   (interactive)
 297   (delete-minibuffer-contents)
 298   (insert ivy-text)
 299   (setq ivy-exit 'done)
 300   (exit-minibuffer))
 301
 302 (defun ivy-beginning-of-buffer ()
 303   "Select the first completion candidate."
 304   (interactive)
 305   (setq ivy--index 0))
 306
 307 (defun ivy-end-of-buffer ()
 308   "Select the last completion candidate."
 309   (interactive)
 310   (setq ivy--index (1- ivy--length)))
 311
 312 (defun ivy-scroll-up-command ()
 313   "Scroll the candidates upward by the minibuffer height."
 314   (interactive)
 315   (setq ivy--index (min (+ ivy--index ivy-height)
 316                         (1- ivy--length))))
 317
 318 (defun ivy-scroll-down-command ()
 319   "Scroll the candidates downward by the minibuffer height."
 320   (interactive)
 321   (setq ivy--index (max (- ivy--index ivy-height)
 322                         0)))
 323
 324 (defun ivy-next-line (&optional arg)
 325   "Move cursor vertically down ARG candidates."
 326   (interactive "p")
 327   (setq arg (or arg 1))
 328   (cl-incf ivy--index arg)
 329   (when (>= ivy--index (1- ivy--length))
 330     (if ivy-wrap
 331         (ivy-beginning-of-buffer)
 332       (setq ivy--index (1- ivy--length)))))
 333
 334 (defun ivy-next-line-or-history (&optional arg)
 335   "Move cursor vertically down ARG candidates.
 336 If the input is empty, select the previous history element instead."
 337   (interactive "p")
 338   (when (string= ivy-text "")
 339     (ivy-previous-history-element 1))
 340   (ivy-next-line arg))
 341
 342 (defun ivy-previous-line (&optional arg)
 343   "Move cursor vertically up ARG candidates."
 344   (interactive "p")
 345   (setq arg (or arg 1))
 346   (cl-decf ivy--index arg)
 347   (when (< ivy--index 0)
 348     (if ivy-wrap
 349         (ivy-end-of-buffer)
 350       (setq ivy--index 0))))
 351
 352 (defun ivy-previous-line-or-history (arg)
 353   "Move cursor vertically up ARG candidates.
 354 If the input is empty, select the previous history element instead."
 355   (interactive "p")
 356   (when (string= ivy-text "")
 357     (ivy-previous-history-element 1))
 358   (ivy-previous-line arg))
 359
 360 (defun ivy-next-line-and-call (&optional arg)
 361   "Move cursor vertically down ARG candidates."
 362   (interactive "p")
 363   (ivy-next-line arg)
 364   (ivy--exhibit)
 365   (when ivy--persistent-action
 366     (with-selected-window ivy-window
 367       (funcall ivy--persistent-action ivy--current))))
 368
 369 (defun ivy-previous-line-and-call (&optional arg)
 370   "Move cursor vertically down ARG candidates."
 371   (interactive "p")
 372   (ivy-previous-line arg)
 373   (ivy--exhibit)
 374   (when ivy--persistent-action
 375     (with-selected-window ivy-window
 376       (funcall ivy--persistent-action ivy--current))))
 377
 378 (defun ivy-previous-history-element (arg)
 379   "Forward to `previous-history-element' with ARG."
 380   (interactive "p")
 381   (previous-history-element arg)
 382   (move-end-of-line 1)
 383   (ivy--maybe-scroll-history))
 384
 385 (defun ivy-next-history-element (arg)
 386   "Forward to `next-history-element' with ARG."
 387   (interactive "p")
 388   (next-history-element arg)
 389   (move-end-of-line 1)
 390   (ivy--maybe-scroll-history))
 391
 392 (defun ivy--maybe-scroll-history ()
 393   "If the selected history element has an index, scroll there."
 394   (let ((idx (ignore-errors
 395                (get-text-property
 396                 (minibuffer-prompt-end)
 397                 'ivy-index))))
 398     (when idx
 399       (ivy--exhibit)
 400       (setq ivy--index idx))))
 401
 402 (defun ivy--cd (dir)
 403   "When completing file names, move to directory DIR."
 404   (if (null ivy--directory)
 405       (error "Unexpected")
 406     (setq ivy--old-cands nil)
 407     (setq ivy--old-re nil)
 408     (setq ivy--index 0)
 409     (setq ivy--all-candidates
 410           (ivy--sorted-files (setq ivy--directory dir)))
 411     (setq ivy-text "")
 412     (delete-minibuffer-contents)))
 413
 414 (defun ivy-backward-delete-char ()
 415   "Forward to `backward-delete-char'.
 416 On error (read-only), call `ivy-on-del-error-function'."
 417   (interactive)
 418   (if (and ivy--directory (= (minibuffer-prompt-end) (point)))
 419       (progn
 420         (ivy--cd (file-name-directory
 421                   (directory-file-name
 422                    (expand-file-name
 423                     ivy--directory))))
 424         (ivy--exhibit))
 425     (condition-case nil
 426         (backward-delete-char 1)
 427       (error
 428        (when ivy-on-del-error-function
 429          (funcall ivy-on-del-error-function))))))
 430
 431 (defvar ivy--regexp-quote 'regexp-quote
 432   "Store the regexp quoting state.")
 433
 434 (defun ivy-toggle-regexp-quote ()
 435   "Toggle the regexp quoting."
 436   (interactive)
 437   (setq ivy--old-re nil)
 438   (cl-rotatef ivy--regex-function ivy--regexp-quote))
 439
 440 (defun ivy-sort-file-function-default (x y)
 441   "Compare two files X and Y.
 442 Prioritize directories."
 443   (if (get-text-property 0 'dirp x)
 444       (if (get-text-property 0 'dirp y)
 445           (string< x y)
 446         t)
 447     (if (get-text-property 0 'dirp y)
 448         nil
 449       (string< x y))))
 450
 451 (defvar ivy-sort-functions-alist
 452   '((read-file-name-internal . ivy-sort-file-function-default)
 453     (internal-complete-buffer . nil)
 454     (counsel-git-grep-function . nil)
 455     (t . string-lessp))
 456   "An alist of sorting functions for each collection function.
 457 For each entry, nil means no sorting.
 458 The entry associated to t is used for all fall-through cases.")
 459
 460 (defvar ivy-re-builders-alist
 461   '((t . ivy--regex-plus))
 462   "An alist of regex building functions for each collection function.
 463 Each function should take a string and return a valid regex or a
 464 regex sequence (see below).
 465
 466 The entry associated to t is used for all fall-through cases.
 467 Possible choices: `ivy--regex', `regexp-quote', `ivy--regex-plus'.
 468
 469 In case a function returns a list, it should look like this:
 470 '((\"matching-regexp\" . t) (\"non-matching-regexp\") ...).
 471
 472 The matches will be filtered in a sequence, you can mix the
 473 regexps that should match and that should not match as you
 474 like.")
 475
 476 (defcustom ivy-sort-max-size 30000
 477   "Sorting won't be done for collections larger than this."
 478   :type 'integer)
 479
 480 (defun ivy--sorted-files (dir)
 481   "Return the list of files in DIR.
 482 Directories come first."
 483   (let* ((default-directory dir)
 484          (seq (all-completions "" 'read-file-name-internal))
 485          sort-fn)
 486     (if (equal dir "/")
 487         seq
 488       (setq seq (delete "./" (delete "../" seq)))
 489       (when (eq (setq sort-fn (cdr (assoc 'read-file-name-internal
 490                                           ivy-sort-functions-alist)))
 491                 'ivy-sort-file-function-default)
 492         (setq seq (mapcar (lambda (x)
 493                             (propertize x 'dirp (string-match-p "/$" x)))
 494                           seq)))
 495       (when sort-fn
 496         (setq seq (cl-sort seq sort-fn)))
 497       (dolist (dir ivy-extra-directories)
 498         (push dir seq))
 499       seq)))
 500
 501 ;;** Entry Point
 502 (cl-defun ivy-read (prompt collection
 503                     &key predicate require-match initial-input
 504                       history preselect keymap update-fn sort)
 505   "Read a string in the minibuffer, with completion.
 506
 507 PROMPT is a string to prompt with; normally it ends in a colon
 508 and a space.  When PROMPT contains %d, it will be updated with
 509 the current number of matching candidates.
 510 See also `ivy-count-format'.
 511
 512 COLLECTION is a list of strings.
 513
 514 If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.
 515
 516 KEYMAP is composed together with `ivy-minibuffer-map'.
 517
 518 If PRESELECT is non-nil select the corresponding candidate out of
 519 the ones that match INITIAL-INPUT.
 520
 521 UPDATE-FN is called each time the current candidate(s) is changed.
 522
 523 When SORT is t, refer to `ivy-sort-functions-alist' for sorting."
 524   (setq ivy--directory nil)
 525   (setq ivy-require-match require-match)
 526   (setq ivy-def preselect)
 527   (setq ivy-window (selected-window))
 528   (setq ivy--regex-function
 529         (or (and (functionp collection)
 530                  (cdr (assoc collection ivy-re-builders-alist)))
 531             (cdr (assoc t ivy-re-builders-alist))
 532             'ivy--regex))
 533   (setq ivy--subexps 0)
 534   (setq ivy--regexp-quote 'regexp-quote)
 535   (setq ivy--collection (and (functionp collection)
 536                              collection))
 537   (setq ivy--old-text "")
 538   (setq ivy-text "")
 539   (let (coll sort-fn)
 540     (cond ((eq collection 'Info-read-node-name-1)
 541            (if (equal Info-current-file "dir")
 542                (setq coll
 543                      (mapcar (lambda (x) (format "(%s)" x))
 544                              (cl-delete-duplicates
 545                               (all-completions "(" collection predicate)
 546                               :test 'equal)))
 547              (setq coll (all-completions "" collection predicate))))
 548           ((eq collection 'read-file-name-internal)
 549            (setq ivy--directory default-directory)
 550            (setq coll
 551                  (ivy--sorted-files default-directory))
 552            (when initial-input
 553              (unless (or require-match
 554                          (equal initial-input default-directory))
 555                (setq coll (cons initial-input coll)))
 556              (setq initial-input nil)))
 557           ((eq collection 'internal-complete-buffer)
 558            (setq coll
 559                  (mapcar (lambda (x)
 560                            (if (with-current-buffer x
 561                                  (file-remote-p
 562                                   (abbreviate-file-name default-directory)))
 563                                (propertize x 'face 'ivy-remote)
 564                              x))
 565                          (all-completions "" collection predicate))))
 566           ((or (functionp collection)
 567                (vectorp collection)
 568                (listp (car collection)))
 569            (setq coll (all-completions "" collection predicate)))
 570           ((hash-table-p collection)
 571            (error "Hash table as a collection unsupported"))
 572           (t
 573            (setq coll collection)))
 574     (when sort
 575       (if (and (functionp collection)
 576                (setq sort-fn (assoc collection ivy-sort-functions-alist)))
 577           (when (and (setq sort-fn (cdr sort-fn))
 578                      (not (eq collection 'read-file-name-internal)))
 579             (setq coll (cl-sort coll sort-fn)))
 580         (unless (eq history 'org-refile-history)
 581           (if (and (setq sort-fn (cdr (assoc t ivy-sort-functions-alist)))
 582                    (<= (length coll) ivy-sort-max-size))
 583               (setq coll (cl-sort (copy-sequence coll) sort-fn))))))
 584     (when preselect
 585       (unless (or require-match
 586                   (cl-find-if `(lambda (x)
 587                                  (string-match ,(format "^%s" preselect) x))
 588                               coll))
 589         (setq coll (cons preselect coll))))
 590     (setq ivy--index (or
 591                       (and preselect
 592                            (ivy--preselect-index
 593                             coll initial-input preselect))
 594                       0))
 595     (setq ivy--old-re nil)
 596     (setq ivy--old-cands nil)
 597     (setq ivy--all-candidates coll)
 598     (setq ivy--update-fn update-fn)
 599     (setq ivy-exit nil)
 600     (setq ivy--default (or (thing-at-point 'symbol) ""))
 601     (setq ivy--prompt
 602           (cond ((string-match "%.*d" prompt)
 603                  prompt)
 604                 ((string-match "%.*d" ivy-count-format)
 605                  (concat ivy-count-format prompt))
 606                 (ivy--directory
 607                  prompt)
 608                 (t
 609                  nil)))
 610     (setq ivy--action nil)
 611     (prog1
 612         (unwind-protect
 613              (minibuffer-with-setup-hook
 614                  #'ivy--minibuffer-setup
 615                (let* ((hist (or history 'ivy-history))
 616                       (res (read-from-minibuffer
 617                             prompt
 618                             initial-input
 619                             (make-composed-keymap keymap ivy-minibuffer-map)
 620                             nil
 621                             hist)))
 622                  (when (eq ivy-exit 'done)
 623                    (set hist (cons (propertize ivy-text 'ivy-index ivy--index)
 624                                    (delete ivy-text
 625                                            (cdr (symbol-value hist)))))
 626                    res)))
 627           (remove-hook 'post-command-hook #'ivy--exhibit))
 628       (when ivy--action
 629         (funcall ivy--action)))))
 630
 631 (defun ivy-completing-read (prompt collection
 632                             &optional predicate require-match initial-input
 633                               history def _inherit-input-method)
 634   "Read a string in the minibuffer, with completion.
 635
 636 This is an interface that conforms to `completing-read', so that
 637 it can be used for `completing-read-function'.
 638
 639 PROMPT is a string to prompt with; normally it ends in a colon and a space.
 640 COLLECTION can be a list of strings, an alist, an obarray or a hash table.
 641 PREDICATE limits completion to a subset of COLLECTION.
 642
 643 REQUIRE-MATCH is stored into `ivy-require-match'.  See `completing-read'.
 644 INITIAL-INPUT is a string that can be inserted into the minibuffer initially.
 645 _HISTORY is ignored for now.
 646 DEF is the default value.
 647 _INHERIT-INPUT-METHOD is ignored for now.
 648
 649 The history, defaults and input-method arguments are ignored for now."
 650   (ivy-read prompt collection
 651             :predicate predicate
 652             :require-match require-match
 653             :initial-input initial-input
 654             :preselect (if (listp def) (car def) def)
 655             :history history
 656             :keymap nil
 657             :sort t))
 658
 659 ;;;###autoload
 660 (define-minor-mode ivy-mode
 661     "Toggle Ivy mode on or off.
 662 With ARG, turn Ivy mode on if arg is positive, off otherwise.
 663 Turning on Ivy mode will set `completing-read-function' to
 664 `ivy-completing-read'.
 665
 666 \\{ivy-minibuffer-map}"
 667   :group 'ivy
 668   :global t
 669   :lighter " ivy"
 670   (if ivy-mode
 671       (setq completing-read-function 'ivy-completing-read)
 672     (setq completing-read-function 'completing-read-default)))
 673
 674 (defun ivy--preselect-index (candidates initial-input preselect)
 675   "Return the index in CANDIDATES filtered by INITIAL-INPUT for PRESELECT."
 676   (when initial-input
 677     (setq candidates
 678           (cl-remove-if-not
 679            (lambda (x)
 680              (string-match initial-input x))
 681            candidates)))
 682   (or (cl-position preselect candidates :test 'equal)
 683       (cl-position-if
 684        (lambda (x)
 685          (string-match preselect x))
 686        candidates)))
 687
 688 ;;* Implementation
 689 ;;** Regex
 690 (defvar ivy--subexps 0
 691   "Number of groups in the current `ivy--regex'.")
 692
 693 (defvar ivy--regex-hash
 694   (make-hash-table :test 'equal)
 695   "Store pre-computed regex.")
 696
 697 (defun ivy--regex (str &optional greedy)
 698   "Re-build regex from STR in case it has a space.
 699 When GREEDY is non-nil, join words in a greedy way."
 700   (let ((hashed (unless greedy
 701                   (gethash str ivy--regex-hash))))
 702     (if hashed
 703         (prog1 (cdr hashed)
 704           (setq ivy--subexps (car hashed)))
 705       (cdr (puthash str
 706                     (let ((subs (split-string str " +" t)))
 707                       (if (= (length subs) 1)
 708                           (cons
 709                            (setq ivy--subexps 0)
 710                            (car subs))
 711                         (cons
 712                          (setq ivy--subexps (length subs))
 713                          (mapconcat
 714                           (lambda (x)
 715                             (if (string-match "^\\\\(.*\\\\)$" x)
 716                                 x
 717                               (format "\\(%s\\)" x)))
 718                           subs
 719                           (if greedy
 720                               ".*"
 721                             ".*?")))))
 722                     ivy--regex-hash)))))
 723
 724 (defun ivy--regex-plus (str)
 725   "Build a regex sequence from STR.
 726 Spaces are wild, everything before \"!\" should match.
 727 Everything after \"!\" should not match."
 728   (let ((parts (split-string str "!" t)))
 729     (cl-case (length parts)
 730       (0
 731        "")
 732       (1
 733        (ivy--regex (car parts)))
 734       (2
 735        (let ((res
 736               (mapcar #'list
 737                       (split-string (cadr parts) " " t))))
 738          (cons (cons (ivy--regex (car parts)) t)
 739                res)))
 740       (t (error "Unexpected: use only one !")))))
 741
 742 ;;** Rest
 743 (defun ivy--minibuffer-setup ()
 744   "Setup ivy completion in the minibuffer."
 745   (set (make-local-variable 'completion-show-inline-help) nil)
 746   (set (make-local-variable 'minibuffer-default-add-function)
 747        (lambda ()
 748          (list ivy--default)))
 749   (setq-local max-mini-window-height ivy-height)
 750   (add-hook 'post-command-hook #'ivy--exhibit nil t)
 751   ;; show completions with empty input
 752   (ivy--exhibit))
 753
 754 (defun ivy--input ()
 755   "Return the current minibuffer input."
 756   ;; assume one-line minibuffer input
 757   (buffer-substring-no-properties
 758    (minibuffer-prompt-end)
 759    (line-end-position)))
 760
 761 (defun ivy--cleanup ()
 762   "Delete the displayed completion candidates."
 763   (save-excursion
 764     (goto-char (minibuffer-prompt-end))
 765     (delete-region (line-end-position) (point-max))))
 766
 767 (defvar ivy--dynamic-function nil
 768   "When this is non-nil, call it for each input change to get new candidates.")
 769
 770 (defvar ivy--full-length nil
 771   "When `ivy--dynamic-function' is non-nil, this can be the total amount of candidates.")
 772
 773 (defvar ivy--old-text ""
 774   "Store old `ivy-text' for dynamic completion.")
 775
 776 (defun ivy--insert-prompt ()
 777   "Update the prompt according to `ivy--prompt'."
 778   (when ivy--prompt
 779     (unless (memq this-command '(ivy-done ivy-alt-done ivy-partial-or-done))
 780       (setq ivy--prompt-extra ""))
 781     (let (head tail)
 782       (if (string-match "\\(.*\\): $" ivy--prompt)
 783           (progn
 784             (setq head (match-string 1 ivy--prompt))
 785             (setq tail ": "))
 786         (setq head (substring ivy--prompt 0 -1))
 787         (setq tail " "))
 788       (let ((inhibit-read-only t)
 789             (std-props '(front-sticky t rear-nonsticky t field t read-only t))
 790             (n-str
 791              (format
 792               (concat head
 793                       ivy--prompt-extra
 794                       tail
 795                       (if ivy--directory
 796                           (abbreviate-file-name ivy--directory)
 797                         ""))
 798               (or (and ivy--dynamic-function
 799                        ivy--full-length)
 800                   ivy--length))))
 801         (save-excursion
 802           (goto-char (point-min))
 803           (delete-region (point-min) (minibuffer-prompt-end))
 804           (set-text-properties 0 (length n-str)
 805                                `(face minibuffer-prompt ,@std-props)
 806                                n-str)
 807           (ivy--set-match-props n-str "confirm"
 808                                 `(face ivy-confirm-face ,@std-props))
 809           (ivy--set-match-props n-str "match required"
 810                                 `(face ivy-match-required-face ,@std-props))
 811           (insert n-str))
 812         ;; get out of the prompt area
 813         (constrain-to-field nil (point-max))))))
 814
 815 (defun ivy--set-match-props (str match props)
 816   "Set STR text proprties that match MATCH to PROPS."
 817   (when (string-match match str)
 818     (set-text-properties
 819      (match-beginning 0)
 820      (match-end 0)
 821      props
 822      str)))
 823
 824 (defvar inhibit-message)
 825
 826 (defun ivy--exhibit ()
 827   "Insert Ivy completions display.
 828 Should be run via minibuffer `post-command-hook'."
 829   (setq ivy-text (ivy--input))
 830   (if ivy--dynamic-function
 831       ;; while-no-input would cause annoying
 832       ;; "Waiting for process to die...done" message interruptions
 833       (let ((inhibit-message t))
 834         (while-no-input
 835           (unless (equal ivy--old-text ivy-text)
 836             (let ((store ivy--dynamic-function)
 837                   (ivy--dynamic-function nil))
 838               (setq ivy--all-candidates (funcall store ivy-text))))
 839           (ivy--insert-minibuffer (ivy--format ivy--all-candidates))))
 840     (cond (ivy--directory
 841            (if (string-match "/$" ivy-text)
 842                (if (member ivy-text ivy--all-candidates)
 843                    (ivy--cd (expand-file-name ivy-text ivy--directory))
 844                  (when (string-match "//$" ivy-text)
 845                    (ivy--cd "/")))
 846              (if (string-match "~$" ivy-text)
 847                  (ivy--cd (expand-file-name "~/")))))
 848           ((eq ivy--collection 'internal-complete-buffer)
 849            (when (or (and (string-match "^ " ivy-text)
 850                           (not (string-match "^ " ivy--old-text)))
 851                      (and (string-match "^ " ivy--old-text)
 852                           (not (string-match "^ " ivy-text))))
 853              (setq ivy--all-candidates
 854                    (all-completions
 855                     (if (and (> (length ivy-text) 0)
 856                              (eq (aref ivy-text 0)
 857                                  ?\ ))
 858                         " "
 859                       "")
 860                     'internal-complete-buffer))
 861              (setq ivy--old-re nil))))
 862     (ivy--insert-minibuffer
 863      (ivy--format
 864       (ivy--filter ivy-text ivy--all-candidates))))
 865   (setq ivy--old-text ivy-text))
 866
 867 (defun ivy--insert-minibuffer (text)
 868   "Insert TEXT into minibuffer with appropriate cleanup."
 869   (ivy--cleanup)
 870   (let ((buffer-undo-list t)
 871         deactivate-mark)
 872     (when ivy--update-fn
 873       (funcall ivy--update-fn))
 874     (ivy--insert-prompt)
 875     ;; Do nothing if while-no-input was aborted.
 876     (when (stringp text)
 877       (save-excursion
 878         (forward-line 1)
 879         (insert text)))))
 880
 881 (defun ivy--add-face (str face)
 882   "Propertize STR with FACE.
 883 `font-lock-append-text-property' is used, since it's better than
 884 `propertize' or `add-face-text-property' in this case."
 885   (require 'colir)
 886   (condition-case nil
 887       (colir-blend-face-background 0 (length str) face str)
 888     (error
 889      (ignore-errors
 890        (font-lock-append-text-property 0 (length str) 'face face str))))
 891   str)
 892
 893 (defun ivy--filter (name candidates)
 894   "Return all items that match NAME in CANDIDATES.
 895 CANDIDATES are assumed to be static."
 896   (let* ((re (funcall ivy--regex-function name))
 897          (cands (cond ((and (equal re ivy--old-re)
 898                             ivy--old-cands)
 899                        ivy--old-cands)
 900                       ((and ivy--old-re
 901                             (stringp re)
 902                             (stringp ivy--old-re)
 903                             (not (string-match "\\\\" ivy--old-re))
 904                             (not (equal ivy--old-re ""))
 905                             (memq (cl-search
 906                                    (if (string-match "\\\\)$" ivy--old-re)
 907                                        (substring ivy--old-re 0 -2)
 908                                      ivy--old-re)
 909                                    re) '(0 2)))
 910                        (ignore-errors
 911                          (cl-remove-if-not
 912                           (lambda (x) (string-match re x))
 913                           ivy--old-cands)))
 914                       (t
 915                        (let ((re-list (if (stringp re) (list (cons re t)) re))
 916                              (res candidates))
 917                          (dolist (re re-list)
 918                            (setq res
 919                                  (ignore-errors
 920                                    (funcall
 921                                     (if (cdr re)
 922                                         #'cl-remove-if-not
 923                                       #'cl-remove-if)
 924                                     `(lambda (x) (string-match ,(car re) x))
 925                                     res))))
 926                          res))))
 927          (tail (nthcdr ivy--index ivy--old-cands))
 928          idx)
 929     (when (and tail ivy--old-cands)
 930       (unless (and (not (equal re ivy--old-re))
 931                    (or (setq ivy--index
 932                              (or
 933                               (cl-position re cands
 934                                            :test 'equal)
 935                               (and ivy--directory
 936                                    (cl-position
 937                                     (concat re "/") cands
 938                                     :test 'equal))))))
 939         (while (and tail (null idx))
 940           ;; Compare with eq to handle equal duplicates in cands
 941           (setq idx (cl-position (pop tail) cands)))
 942         (setq ivy--index (or idx 0))))
 943     (when (and (string= name "") (not (equal ivy--old-re "")))
 944       (setq ivy--index
 945             (or (cl-position ivy-def cands :test 'equal)
 946                 ivy--index)))
 947     (setq ivy--old-re re)
 948     (setq ivy--old-cands cands)))
 949
 950 (defun ivy--format (cands)
 951   "Return a string for CANDS suitable for display in the minibuffer.
 952 CANDS is a list of strings."
 953   (setq ivy--length (length cands))
 954   (when (>= ivy--index ivy--length)
 955     (setq ivy--index (max (1- ivy--length) 0)))
 956   (if (null cands)
 957       ""
 958     (let* ((half-height (/ ivy-height 2))
 959            (start (max 0 (- ivy--index half-height)))
 960            (end (min (+ start (1- ivy-height)) ivy--length))
 961            (cands (cl-subseq cands start end))
 962            (index (min ivy--index half-height (1- (length cands)))))
 963       (when ivy--directory
 964         (setq cands (mapcar (lambda (x)
 965                               (if (string-match-p "/$" x)
 966                                   (propertize x 'face 'ivy-subdir)
 967                                 x))
 968                             cands)))
 969       (setq ivy--current (copy-sequence (nth index cands)))
 970       (setf (nth index cands)
 971             (ivy--add-face ivy--current 'ivy-current-match))
 972       (let* ((ww (window-width))
 973              (res (concat "\n" (mapconcat
 974                                 (lambda (s)
 975                                   (if (> (length s) ww)
 976                                       (concat (substring s 0 (- ww 3)) "...")
 977                                     s))
 978                                 cands "\n"))))
 979         (put-text-property 0 (length res) 'read-only nil res)
 980         res))))
 981
 982 (provide 'ivy)
 983
 984 ;;; ivy.el ends here