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.2
   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 ;;* Customization
  41 (defgroup ivy nil
  42   "Incremental vertical completion."
  43   :group 'convenience)
  44
  45 (defface ivy-current-match
  46   '((t (:inherit highlight)))
  47   "Face used by Ivy for highlighting first match.")
  48
  49 (defcustom ivy-height 10
  50   "Number of lines for the minibuffer window."
  51   :type 'integer)
  52
  53 (defcustom ivy-count-format "%-4d "
  54   "The style of showing the current candidate count for `ivy-read'.
  55 Set this to nil if you don't want the count."
  56   :type 'string)
  57
  58 (defcustom ivy-wrap nil
  59   "Whether to wrap around after the first and last candidate."
  60   :type 'boolean)
  61
  62 (defcustom ivy-on-del-error-function 'minibuffer-keyboard-quit
  63   "The handler for when `ivy-backward-delete-char' throws.
  64 This is usually meant as a quick exit out of the minibuffer."
  65   :type 'function)
  66
  67 ;;* User Visible
  68 ;;** Keymap
  69 (require 'delsel)
  70 (defvar ivy-minibuffer-map
  71   (let ((map (make-sparse-keymap)))
  72     (define-key map (kbd "C-m") 'ivy-done)
  73     (define-key map (kbd "C-n") 'ivy-next-line)
  74     (define-key map (kbd "C-p") 'ivy-previous-line)
  75     (define-key map (kbd "C-s") 'ivy-next-line-or-history)
  76     (define-key map (kbd "C-r") 'ivy-previous-line-or-history)
  77     (define-key map (kbd "SPC") 'self-insert-command)
  78     (define-key map (kbd "DEL") 'ivy-backward-delete-char)
  79     (define-key map (kbd "M-<") 'ivy-beginning-of-buffer)
  80     (define-key map (kbd "M->") 'ivy-end-of-buffer)
  81     (define-key map (kbd "M-n") 'ivy-next-history-element)
  82     (define-key map (kbd "M-p") 'ivy-previous-history-element)
  83     (define-key map (kbd "C-g") 'minibuffer-keyboard-quit)
  84     map)
  85   "Keymap used in the minibuffer.")
  86
  87 (defvar ivy-history nil
  88   "History list of candidates entered in the minibuffer.
  89
  90 Maximum length of the history list is determined by the value
  91 of `history-length', which see.")
  92
  93 ;;** Commands
  94 (defun ivy-done ()
  95   "Exit the minibuffer with the selected candidate."
  96   (interactive)
  97   (delete-minibuffer-contents)
  98   (unless (zerop ivy--length)
  99     (insert ivy--current)
 100     (setq ivy-exit 'done))
 101   (exit-minibuffer))
 102
 103 (defun ivy-beginning-of-buffer ()
 104   "Select the first completion candidate."
 105   (interactive)
 106   (setq ivy--index 0))
 107
 108 (defun ivy-end-of-buffer ()
 109   "Select the last completion candidate."
 110   (interactive)
 111   (setq ivy--index (1- ivy--length)))
 112
 113 (defun ivy-next-line (&optional arg)
 114   "Move cursor vertically down ARG candidates."
 115   (interactive "p")
 116   (setq arg (or arg 1))
 117   (cl-incf ivy--index arg)
 118   (when (>= ivy--index (1- ivy--length))
 119     (if ivy-wrap
 120         (ivy-beginning-of-buffer)
 121       (setq ivy--index (1- ivy--length)))))
 122
 123 (defun ivy-next-line-or-history (&optional arg)
 124   "Move cursor vertically down ARG candidates.
 125 If the input is empty, select the previous history element instead."
 126   (interactive "p")
 127   (when (string= ivy-text "")
 128     (ivy-previous-history-element 1))
 129   (ivy-next-line arg))
 130
 131 (defun ivy-previous-line (&optional arg)
 132   "Move cursor vertically up ARG candidates."
 133   (interactive "p")
 134   (setq arg (or arg 1))
 135   (cl-decf ivy--index arg)
 136   (when (< ivy--index 0)
 137     (if ivy-wrap
 138         (ivy-end-of-buffer)
 139       (setq ivy--index 0))))
 140
 141 (defun ivy-previous-line-or-history (arg)
 142   "Move cursor vertically up ARG candidates.
 143 If the input is empty, select the previous history element instead."
 144   (interactive "p")
 145   (when (string= ivy-text "")
 146     (ivy-previous-history-element 1))
 147   (ivy-previous-line arg))
 148
 149 (defun ivy-previous-history-element (arg)
 150   "Forward to `previous-history-element' with ARG."
 151   (interactive "p")
 152   (previous-history-element arg)
 153   (move-end-of-line 1))
 154
 155 (defun ivy-next-history-element (arg)
 156   "Forward to `next-history-element' with ARG."
 157   (interactive "p")
 158   (next-history-element arg)
 159   (move-end-of-line 1))
 160
 161 (defun ivy-backward-delete-char ()
 162   "Forward to `backward-delete-char'.
 163 On error (read-only), call `ivy-on-del-error-function'."
 164   (interactive)
 165   (condition-case nil
 166       (backward-delete-char 1)
 167     (error
 168      (when ivy-on-del-error-function
 169        (funcall ivy-on-del-error-function)))))
 170
 171 ;;** Entry Point
 172 (defun ivy-read (prompt collection
 173                  &optional initial-input keymap preselect update-fn)
 174   "Read a string in the minibuffer, with completion.
 175
 176 PROMPT is a string to prompt with; normally it ends in a colon
 177 and a space.  When PROMPT contains %d, it will be updated with
 178 the current number of matching candidates.
 179 See also `ivy-count-format'.
 180
 181 COLLECTION is a list of strings.
 182
 183 If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.
 184
 185 KEYMAP is composed together with `ivy-minibuffer-map'.
 186
 187 If PRESELECT is non-nil select the corresponding candidate out of
 188 the ones that match INITIAL-INPUT.
 189
 190 UPDATE-FN is called each time the current candidate(s) is changed."
 191   (cl-case (length collection)
 192     (0 nil)
 193     (1 (car collection))
 194     (t
 195      (setq ivy--index (or
 196                        (and preselect
 197                             (ivy--preselect-index
 198                              collection initial-input preselect))
 199                        0))
 200      (setq ivy--old-re nil)
 201      (setq ivy--old-cands nil)
 202      (setq ivy-text "")
 203      (setq ivy--all-candidates collection)
 204      (setq ivy--update-fn update-fn)
 205      (setq ivy-exit nil)
 206      (setq ivy--default (or (thing-at-point 'symbol) ""))
 207      (setq ivy--prompt
 208            (cond ((string-match "%.*d" prompt)
 209                   prompt)
 210                  ((string-match "%.*d" ivy-count-format)
 211                   (concat ivy-count-format prompt))
 212                  (t
 213                   nil)))
 214      (setq ivy--action nil)
 215      (prog1
 216          (unwind-protect
 217               (minibuffer-with-setup-hook
 218                   #'ivy--minibuffer-setup
 219                 (let ((res (read-from-minibuffer
 220                             prompt
 221                             initial-input
 222                             (make-composed-keymap keymap ivy-minibuffer-map)
 223                             nil
 224                             'ivy-history)))
 225                   (when (eq ivy-exit 'done)
 226                     (pop ivy-history)
 227                     (setq ivy-history
 228                           (cons ivy-text (delete ivy-text ivy-history)))
 229                     res)))
 230            (remove-hook 'post-command-hook #'ivy--exhibit))
 231        (when ivy--action
 232          (funcall ivy--action))))))
 233
 234 (defun ivy-completing-read (prompt collection
 235                             &optional predicate _require-match initial-input
 236                               _history def _inherit-input-method)
 237   "Read a string in the minibuffer, with completion.
 238
 239 This is an interface that conforms to `completing-read', so that
 240 it can be used for `completing-read-function'.
 241
 242 PROMPT is a string to prompt with; normally it ends in a colon and a space.
 243 COLLECTION can be a list of strings, an alist, an obarray or a hash table.
 244 PREDICATE limits completion to a subset of COLLECTION.
 245
 246 _REQUIRE-MATCH is ignored for now.
 247 INITIAL-INPUT is a string that can be inserted into the minibuffer initially.
 248 _HISTORY is ignored for now.
 249 DEF is the default value.
 250 _INHERIT-INPUT-METHOD is ignored for now.
 251
 252 The history, defaults and input-method arguments are ignored for now."
 253   (cond ((functionp collection)
 254          (setq collection (all-completions "" collection))
 255          (setq initial-input nil))
 256         ((hash-table-p collection)
 257          (error "Hash table as a collection unsupported"))
 258         ((listp (car collection))
 259          (setq collection (mapcar #'car collection))))
 260   (when predicate
 261     (setq collection (cl-remove-if-not predicate collection)))
 262   (when (listp def)
 263     (setq def (car def)))
 264   (ivy-read prompt collection initial-input nil def))
 265
 266 ;;;###autoload
 267 (define-minor-mode ivy-mode
 268     "Toggle Ivy mode on or off.
 269 With ARG, turn Ivy mode on if arg is positive, off otherwise.
 270 Turning on Ivy mode will set `completing-read-function' to
 271 `ivy-completing-read'."
 272   :group 'ivy
 273   :global t
 274   :lighter " ivy"
 275   (if ivy-mode
 276       (setq completing-read-function 'ivy-completing-read)
 277     (setq completing-read-function 'completing-read-default)))
 278
 279 (defvar ivy--action nil
 280   "Store a function to call at the end of `ivy--read'.")
 281
 282 (defun ivy--preselect-index (candidates initial-input preselect)
 283   "Return the index in CANDIDATES filtered by INITIAL-INPUT for PRESELECT."
 284   (when initial-input
 285     (setq candidates
 286           (cl-remove-if-not
 287            (lambda (x)
 288              (string-match initial-input x))
 289            candidates)))
 290   (cl-position-if
 291    (lambda (x)
 292      (string-match preselect x))
 293    candidates))
 294
 295 (defvar ivy-text ""
 296   "Stores the user's string as it is typed in.")
 297
 298 (defvar ivy-exit nil
 299   "Store 'done if the completion was successfully selected.
 300 Otherwise, store nil.")
 301
 302 ;;* Implementation
 303 ;;** Regex
 304 (defvar ivy--subexps 0
 305   "Number of groups in the current `ivy--regex'.")
 306
 307 (defvar ivy--regex-hash
 308   (make-hash-table :test 'equal)
 309   "Store pre-computed regex.")
 310
 311 (defun ivy--regex (str)
 312   "Re-build regex from STR in case it has a space."
 313   (let ((hashed (gethash str ivy--regex-hash)))
 314     (if hashed
 315         (prog1 (cdr hashed)
 316           (setq ivy--subexps (car hashed)))
 317       (cdr (puthash str
 318                     (let ((subs (split-string str " +" t)))
 319                       (if (= (length subs) 1)
 320                           (cons
 321                            (setq ivy--subexps 0)
 322                            (car subs))
 323                         (cons
 324                          (setq ivy--subexps (length subs))
 325                          (mapconcat
 326                           (lambda (x) (format "\\(%s\\)" x))
 327                           subs
 328                           ".*"))))
 329                     ivy--regex-hash)))))
 330
 331 ;;** Rest
 332 (defun ivy--minibuffer-setup ()
 333   "Setup ivy completion in the minibuffer."
 334   (set (make-local-variable 'completion-show-inline-help) nil)
 335   (set (make-local-variable 'minibuffer-default-add-function)
 336        (lambda ()
 337          (list ivy--default)))
 338   (use-local-map (make-composed-keymap ivy-minibuffer-map
 339                                        (current-local-map)))
 340   (setq-local max-mini-window-height ivy-height)
 341   (add-hook 'post-command-hook #'ivy--exhibit nil t)
 342   ;; show completions with empty input
 343   (ivy--exhibit))
 344
 345 (defvar ivy--all-candidates nil
 346   "Store the candidates passed to `ivy-read'.")
 347
 348 (defvar ivy--index 0
 349   "Store the index of the current candidate.")
 350
 351 (defvar ivy--length 0
 352   "Store the amount of viable candidates.")
 353
 354 (defvar ivy--current ""
 355   "Current candidate.")
 356
 357 (defvar ivy--default nil
 358   "Default initial input.")
 359
 360 (defvar ivy--update-fn nil
 361   "Current function to call when current candidate(s) update.")
 362
 363 (defun ivy--input ()
 364   "Return the current minibuffer input."
 365   ;; assume one-line minibuffer input
 366   (buffer-substring-no-properties
 367    (minibuffer-prompt-end)
 368    (line-end-position)))
 369
 370 (defun ivy--cleanup ()
 371   "Delete the displayed completion candidates."
 372   (save-excursion
 373     (goto-char (minibuffer-prompt-end))
 374     (delete-region (line-end-position) (point-max))))
 375
 376 (defvar ivy--prompt nil
 377   "Store the format-style prompt.
 378 When non-nil, it should contain one %d.")
 379
 380 (defun ivy--insert-prompt ()
 381   "Update the prompt according to `ivy--prompt'."
 382   (when ivy--prompt
 383     (let ((inhibit-read-only t)
 384           (n-str (format ivy--prompt ivy--length)))
 385       (save-excursion
 386         (goto-char (point-min))
 387         (delete-region (point-min) (minibuffer-prompt-end))
 388         (set-text-properties
 389          0 (length n-str)
 390          '(front-sticky t rear-nonsticky t field t read-only t face minibuffer-prompt)
 391          n-str)
 392         (insert n-str))
 393       ;; get out of the prompt area
 394       (constrain-to-field nil (point-max)))))
 395
 396 (defun ivy--exhibit ()
 397   "Insert Ivy completions display.
 398 Should be run via minibuffer `post-command-hook'."
 399   (setq ivy-text (ivy--input))
 400   (ivy--cleanup)
 401   (let ((text (ivy-completions
 402                ivy-text
 403                ivy--all-candidates))
 404         (buffer-undo-list t)
 405         deactivate-mark)
 406     (when ivy--update-fn
 407       (funcall ivy--update-fn))
 408     (ivy--insert-prompt)
 409     ;; Do nothing if while-no-input was aborted.
 410     (when (stringp text)
 411       (save-excursion
 412         (forward-line 1)
 413         (insert text)))))
 414
 415 (defvar ivy--old-re nil
 416   "Store the old regexp.")
 417
 418 (defvar ivy--old-cands nil
 419   "Store the candidates matched by `ivy--old-re'.")
 420
 421 (defun ivy--add-face (str face)
 422   "Propertize STR with FACE.
 423 `font-lock-append-text-property' is used, since it's better than
 424 `propertize' or `add-face-text-property' in this case."
 425   (font-lock-append-text-property 0 (length str) 'face face str)
 426   str)
 427
 428 (defun ivy-completions (name candidates)
 429   "Return as text the current completions.
 430 NAME is a string of words separated by spaces that is used to
 431 build a regex.
 432 CANDIDATES is a list of strings."
 433   (let* ((re (ivy--regex name))
 434          (cands (if (and (equal re ivy--old-re)
 435                          ivy--old-cands)
 436                     ivy--old-cands
 437                   (ignore-errors
 438                     (cl-remove-if-not
 439                      (lambda (x) (string-match re x))
 440                      candidates))))
 441          (tail (nthcdr ivy--index ivy--old-cands))
 442          (ww (window-width))
 443          idx)
 444     (when (and tail ivy--old-cands)
 445       (unless (and (not (equal re ivy--old-re))
 446                    (setq ivy--index (cl-position re cands :test 'equal)))
 447         (while (and tail (null idx))
 448           ;; Compare with eq to handle equal duplicates in cands
 449           (setq idx (cl-position (pop tail) cands)))
 450         (setq ivy--index (or idx 0))))
 451     (setq ivy--old-re re)
 452     (setq ivy--length (length cands))
 453     (setq ivy--old-cands cands)
 454     (when (>= ivy--index ivy--length)
 455       (setq ivy--index (max (1- ivy--length) 0)))
 456     (if (null cands)
 457         ""
 458       (let* ((half-height (/ ivy-height 2))
 459              (start (max 0 (- ivy--index half-height)))
 460              (end (min (+ start (1- ivy-height)) ivy--length))
 461              (cands (cl-subseq cands start end))
 462              (index (min ivy--index half-height (1- (length cands)))))
 463         (setq ivy--current (copy-sequence (nth index cands)))
 464         (setf (nth index cands)
 465               (ivy--add-face ivy--current 'ivy-current-match))
 466         (let ((res (concat "\n" (mapconcat
 467                                  (lambda (s)
 468                                    (if (> (length s) ww)
 469                                        (concat (substring s 0 (- ww 3)) "...")
 470                                      s))
 471                                  cands "\n"))))
 472           (put-text-property 0 (length res) 'read-only nil res)
 473           res)))))
 474
 475 (provide 'ivy)
 476
 477 ;;; ivy.el ends here