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