]> code.delx.au - gnu-emacs-elpa/blobdiff - packages/swiper/ivy.el
Merge commit '5a2e0fd355fea83e3c172402b965a1aa826fcc0c' from swiper
[gnu-emacs-elpa] / packages / swiper / ivy.el
index ed9d3f90e23c924dc85e258f2f95711c2eaa3bdd..4fba496920acd52753e2ea011f699e5c3ab09273 100644 (file)
   '((t (:inherit highlight)))
   "Face used by Ivy for highlighting first match.")
 
+(defface ivy-confirm-face
+  '((t :foreground "ForestGreen" :inherit minibuffer-prompt))
+  "Face used by Ivy to issue a confirmation prompt.")
+
+(defface ivy-match-required-face
+  '((t :foreground "red" :inherit minibuffer-prompt))
+  "Face used by Ivy to issue a match required prompt.")
+
 (defface ivy-subdir
-  '((t (:weight bold)))
+  '((t (:inherit 'dired-directory)))
   "Face used by Ivy for highlighting subdirs in the alternatives.")
 
+(defface ivy-remote
+  '((t (:foreground "#110099")))
+  "Face used by Ivy for highlighting remotes in the alternatives.")
+
 (defcustom ivy-height 10
   "Number of lines for the minibuffer window."
   :type 'integer)
@@ -84,6 +96,7 @@ Only \"./\" and \"../\" apply here. They appear in reverse order."
   (let ((map (make-sparse-keymap)))
     (define-key map (kbd "C-m") 'ivy-done)
     (define-key map (kbd "C-j") 'ivy-alt-done)
+    (define-key map (kbd "TAB") 'ivy-partial-or-done)
     (define-key map (kbd "C-n") 'ivy-next-line)
     (define-key map (kbd "C-p") 'ivy-previous-line)
     (define-key map (kbd "<down>") 'ivy-next-line)
@@ -114,7 +127,10 @@ Maximum length of the history list is determined by the value
 of `history-length', which see.")
 
 (defvar ivy-require-match t
-  "Store require-match. See `completing-read'.")
+  "Store require-match.  See `completing-read'.")
+
+(defvar ivy-def nil
+  "Store the default completion value.  See `completing-read'.")
 
 (defvar ivy--directory nil
   "Current directory when completing file names.")
@@ -157,6 +173,9 @@ Otherwise, store nil.")
   "Store the format-style prompt.
 When non-nil, it should contain one %d.")
 
+(defvar ivy--prompt-extra ""
+  "Temporary modifications to the prompt.")
+
 (defvar ivy--old-re nil
   "Store the old regexp.")
 
@@ -166,6 +185,9 @@ When non-nil, it should contain one %d.")
 (defvar ivy--regex-function 'ivy--regex
   "Current function for building a regex.")
 
+(defvar ivy--collection nil
+  "Store the current collection function.")
+
 (defvar Info-current-file)
 
 ;;** Commands
@@ -174,26 +196,28 @@ When non-nil, it should contain one %d.")
   (interactive)
   (delete-minibuffer-contents)
   (when (cond (ivy--directory
-               (insert
-                (if (zerop ivy--length)
-                    (expand-file-name ivy-text ivy--directory)
-                  (expand-file-name ivy--current ivy--directory)))
-               (setq ivy-exit 'done))
+               (if (zerop ivy--length)
+                   (if (or (not (eq confirm-nonexistent-file-or-buffer t))
+                           (equal " (confirm)" ivy--prompt-extra))
+                       (progn
+                         (insert
+                          (expand-file-name ivy-text ivy--directory))
+                         (setq ivy-exit 'done))
+                     (setq ivy--prompt-extra " (confirm)")
+                     (insert ivy-text)
+                     (ivy--exhibit)
+                     nil)
+                 (insert
+                  (expand-file-name
+                   ivy--current ivy--directory))
+                 (setq ivy-exit 'done)))
               ((zerop ivy--length)
                (if (memq ivy-require-match
                          '(nil confirm confirm-after-completion))
                    (progn
                      (insert ivy-text)
                      (setq ivy-exit 'done))
-                 (unless (string-match "match required" ivy--prompt)
-                   (setq ivy--prompt
-                         (if (string-match ": $" ivy--prompt)
-                             (concat
-                              (substring ivy--prompt 0 -2)
-                              " (match required): ")
-                           (concat
-                            ivy--prompt
-                            "(match required) "))))
+                 (setq ivy--prompt-extra " (match required)")
                  (insert ivy-text)
                  (ivy--exhibit)
                  nil))
@@ -202,6 +226,15 @@ When non-nil, it should contain one %d.")
                (setq ivy-exit 'done)))
     (exit-minibuffer)))
 
+(defun ivy-build-tramp-name (x)
+  "Reconstruct X into a path.
+Is is a cons cell, related to `tramp-get-completion-function'."
+  (let ((user (car x))
+        (domain (cadr x)))
+    (if user
+        (concat user "@" domain)
+      domain)))
+
 (defun ivy-alt-done (&optional arg)
   "Exit the minibuffer with the selected candidate.
 When ARG is t, exit with current text, ignoring the candidates."
@@ -209,16 +242,54 @@ When ARG is t, exit with current text, ignoring the candidates."
   (if arg
       (ivy-immediate-done)
     (let (dir)
-      (if (and ivy--directory
-               (not (string= ivy--current "./"))
-               (cl-plusp ivy--length)
-               (file-directory-p
-                (setq dir (expand-file-name
-                           ivy--current ivy--directory))))
-          (progn
-            (ivy--cd dir)
-            (ivy--exhibit))
-        (ivy-done)))))
+      (cond ((and ivy--directory
+                  (or
+                   (and
+                    (not (string= ivy--current "./"))
+                    (cl-plusp ivy--length)
+                    (file-directory-p
+                     (setq dir (expand-file-name
+                                ivy--current ivy--directory))))))
+             (ivy--cd dir)
+             (ivy--exhibit))
+            ((string-match "^/\\([^/]+?\\):\\(?:\\(.*\\)@\\)?" ivy-text)
+             (let ((method (match-string 1 ivy-text))
+                   (user (match-string 2 ivy-text))
+                   res)
+               (dolist (x (tramp-get-completion-function method))
+                 (setq res (append res (funcall (car x) (cadr x)))))
+               (setq res (delq nil res))
+               (when user
+                 (dolist (x res)
+                   (setcar x user)))
+               (setq res (cl-delete-duplicates res :test 'equal))
+               (let ((host (ivy-read "Find File: "
+                                     (mapcar #'ivy-build-tramp-name res))))
+                 (when host
+                   (setq ivy--directory "/")
+                   (ivy--cd (concat "/" method ":" host ":"))))))
+            (t
+             (ivy-done))))))
+
+(defun ivy-partial-or-done ()
+  "Complete the minibuffer text as much as possible.
+When called twice in a row, exit the minibuffer with the current
+candidate."
+  (interactive)
+  (if (eq this-command last-command)
+      (progn
+        (delete-minibuffer-contents)
+        (insert ivy--current)
+        (setq ivy-exit 'done)
+        (exit-minibuffer))
+    (let* ((parts (split-string ivy-text " " t))
+           (postfix (car (last parts)))
+           (new (try-completion postfix
+                                (mapcar (lambda (str) (substring str (string-match postfix str)))
+                                        ivy--old-cands))))
+      (delete-region (minibuffer-prompt-end) (point-max))
+      (setcar (last parts) new)
+      (insert (mapconcat #'identity parts " ") " "))))
 
 (defun ivy-immediate-done ()
   "Exit the minibuffer with the current input."
@@ -308,19 +379,33 @@ If the input is empty, select the previous history element instead."
   "Forward to `previous-history-element' with ARG."
   (interactive "p")
   (previous-history-element arg)
-  (move-end-of-line 1))
+  (move-end-of-line 1)
+  (ivy--maybe-scroll-history))
 
 (defun ivy-next-history-element (arg)
   "Forward to `next-history-element' with ARG."
   (interactive "p")
   (next-history-element arg)
-  (move-end-of-line 1))
+  (move-end-of-line 1)
+  (ivy--maybe-scroll-history))
+
+(defun ivy--maybe-scroll-history ()
+  "If the selected history element has an index, scroll there."
+  (let ((idx (ignore-errors
+               (get-text-property
+                (minibuffer-prompt-end)
+                'ivy-index))))
+    (when idx
+      (ivy--exhibit)
+      (setq ivy--index idx))))
 
 (defun ivy--cd (dir)
   "When completing file names, move to directory DIR."
   (if (null ivy--directory)
       (error "Unexpected")
     (setq ivy--old-cands nil)
+    (setq ivy--old-re nil)
+    (setq ivy--index 0)
     (setq ivy--all-candidates
           (ivy--sorted-files (setq ivy--directory dir)))
     (setq ivy-text "")
@@ -373,11 +458,20 @@ For each entry, nil means no sorting.
 The entry associated to t is used for all fall-through cases.")
 
 (defvar ivy-re-builders-alist
-  '((t . ivy--regex))
+  '((t . ivy--regex-plus))
   "An alist of regex building functions for each collection function.
-Each function should take a string and return a valid regex.
+Each function should take a string and return a valid regex or a
+regex sequence (see below).
+
 The entry associated to t is used for all fall-through cases.
-Possible choices: `ivy--regex', `regexp-quote'.")
+Possible choices: `ivy--regex', `regexp-quote', `ivy--regex-plus'.
+
+In case a function returns a list, it should look like this:
+'((\"matching-regexp\" . t) (\"non-matching-regexp\") ...).
+
+The matches will be filtered in a sequence, you can mix the
+regexps that should match and that should not match as you
+like.")
 
 (defcustom ivy-sort-max-size 30000
   "Sorting won't be done for collections larger than this."
@@ -429,6 +523,7 @@ UPDATE-FN is called each time the current candidate(s) is changed.
 When SORT is t, refer to `ivy-sort-functions-alist' for sorting."
   (setq ivy--directory nil)
   (setq ivy-require-match require-match)
+  (setq ivy-def preselect)
   (setq ivy-window (selected-window))
   (setq ivy--regex-function
         (or (and (functionp collection)
@@ -437,6 +532,10 @@ When SORT is t, refer to `ivy-sort-functions-alist' for sorting."
             'ivy--regex))
   (setq ivy--subexps 0)
   (setq ivy--regexp-quote 'regexp-quote)
+  (setq ivy--collection (and (functionp collection)
+                             collection))
+  (setq ivy--old-text "")
+  (setq ivy-text "")
   (let (coll sort-fn)
     (cond ((eq collection 'Info-read-node-name-1)
            (if (equal Info-current-file "dir")
@@ -455,6 +554,15 @@ When SORT is t, refer to `ivy-sort-functions-alist' for sorting."
                          (equal initial-input default-directory))
                (setq coll (cons initial-input coll)))
              (setq initial-input nil)))
+          ((eq collection 'internal-complete-buffer)
+           (setq coll
+                 (mapcar (lambda (x)
+                           (if (with-current-buffer x
+                                 (file-remote-p
+                                  (abbreviate-file-name default-directory)))
+                               (propertize x 'face 'ivy-remote)
+                             x))
+                         (all-completions "" collection predicate))))
           ((or (functionp collection)
                (vectorp collection)
                (listp (car collection)))
@@ -475,7 +583,9 @@ When SORT is t, refer to `ivy-sort-functions-alist' for sorting."
               (setq coll (cl-sort (copy-sequence coll) sort-fn))))))
     (when preselect
       (unless (or require-match
-                  (member preselect coll))
+                  (cl-find-if `(lambda (x)
+                                 (string-match ,(format "^%s" preselect) x))
+                              coll))
         (setq coll (cons preselect coll))))
     (setq ivy--index (or
                       (and preselect
@@ -484,7 +594,6 @@ When SORT is t, refer to `ivy-sort-functions-alist' for sorting."
                       0))
     (setq ivy--old-re nil)
     (setq ivy--old-cands nil)
-    (setq ivy-text "")
     (setq ivy--all-candidates coll)
     (setq ivy--update-fn update-fn)
     (setq ivy-exit nil)
@@ -511,7 +620,7 @@ When SORT is t, refer to `ivy-sort-functions-alist' for sorting."
                             nil
                             hist)))
                  (when (eq ivy-exit 'done)
-                   (set hist (cons ivy-text
+                   (set hist (cons (propertize ivy-text 'ivy-index ivy--index)
                                    (delete ivy-text
                                            (cdr (symbol-value hist)))))
                    res)))
@@ -531,20 +640,18 @@ PROMPT is a string to prompt with; normally it ends in a colon and a space.
 COLLECTION can be a list of strings, an alist, an obarray or a hash table.
 PREDICATE limits completion to a subset of COLLECTION.
 
-REQUIRE-MATCH is stored into `ivy-require-match'. See `completing-read'.
+REQUIRE-MATCH is stored into `ivy-require-match'.  See `completing-read'.
 INITIAL-INPUT is a string that can be inserted into the minibuffer initially.
 _HISTORY is ignored for now.
 DEF is the default value.
 _INHERIT-INPUT-METHOD is ignored for now.
 
 The history, defaults and input-method arguments are ignored for now."
-  (when (listp def)
-    (setq def (car def)))
   (ivy-read prompt collection
             :predicate predicate
             :require-match require-match
             :initial-input initial-input
-            :preselect def
+            :preselect (if (listp def) (car def) def)
             :history history
             :keymap nil
             :sort t))
@@ -614,6 +721,24 @@ When GREEDY is non-nil, join words in a greedy way."
                             ".*?")))))
                     ivy--regex-hash)))))
 
+(defun ivy--regex-plus (str)
+  "Build a regex sequence from STR.
+Spaces are wild, everything before \"!\" should match.
+Everything after \"!\" should not match."
+  (let ((parts (split-string str "!" t)))
+    (cl-case (length parts)
+      (0
+       "")
+      (1
+       (ivy--regex (car parts)))
+      (2
+       (let ((res
+              (mapcar #'list
+                      (split-string (cadr parts) " " t))))
+         (cons (cons (ivy--regex (car parts)) t)
+               res)))
+      (t (error "Unexpected: use only one !")))))
+
 ;;** Rest
 (defun ivy--minibuffer-setup ()
   "Setup ivy completion in the minibuffer."
@@ -645,31 +770,56 @@ When GREEDY is non-nil, join words in a greedy way."
 (defvar ivy--full-length nil
   "When `ivy--dynamic-function' is non-nil, this can be the total amount of candidates.")
 
-(defvar ivy--old-text nil
+(defvar ivy--old-text ""
   "Store old `ivy-text' for dynamic completion.")
 
 (defun ivy--insert-prompt ()
   "Update the prompt according to `ivy--prompt'."
   (when ivy--prompt
-    (let ((inhibit-read-only t)
-          (n-str
-           (format
-            (if ivy--directory
-                (concat ivy--prompt (abbreviate-file-name ivy--directory))
-              ivy--prompt)
-            (or (and ivy--dynamic-function
-                     ivy--full-length)
-                ivy--length))))
-      (save-excursion
-        (goto-char (point-min))
-        (delete-region (point-min) (minibuffer-prompt-end))
-        (set-text-properties
-         0 (length n-str)
-         '(front-sticky t rear-nonsticky t field t read-only t face minibuffer-prompt)
-         n-str)
-        (insert n-str))
-      ;; get out of the prompt area
-      (constrain-to-field nil (point-max)))))
+    (unless (memq this-command '(ivy-done ivy-alt-done ivy-partial-or-done))
+      (setq ivy--prompt-extra ""))
+    (let (head tail)
+      (if (string-match "\\(.*\\): $" ivy--prompt)
+          (progn
+            (setq head (match-string 1 ivy--prompt))
+            (setq tail ": "))
+        (setq head (substring ivy--prompt 0 -1))
+        (setq tail " "))
+      (let ((inhibit-read-only t)
+            (std-props '(front-sticky t rear-nonsticky t field t read-only t))
+            (n-str
+             (format
+              (concat head
+                      ivy--prompt-extra
+                      tail
+                      (if ivy--directory
+                          (abbreviate-file-name ivy--directory)
+                        ""))
+              (or (and ivy--dynamic-function
+                       ivy--full-length)
+                  ivy--length))))
+        (save-excursion
+          (goto-char (point-min))
+          (delete-region (point-min) (minibuffer-prompt-end))
+          (set-text-properties 0 (length n-str)
+                               `(face minibuffer-prompt ,@std-props)
+                               n-str)
+          (ivy--set-match-props n-str "confirm"
+                                `(face ivy-confirm-face ,@std-props))
+          (ivy--set-match-props n-str "match required"
+                                `(face ivy-match-required-face ,@std-props))
+          (insert n-str))
+        ;; get out of the prompt area
+        (constrain-to-field nil (point-max))))))
+
+(defun ivy--set-match-props (str match props)
+  "Set STR text proprties that match MATCH to PROPS."
+  (when (string-match match str)
+    (set-text-properties
+     (match-beginning 0)
+     (match-end 0)
+     props
+     str)))
 
 (defvar inhibit-message)
 
@@ -681,26 +831,41 @@ Should be run via minibuffer `post-command-hook'."
       ;; while-no-input would cause annoying
       ;; "Waiting for process to die...done" message interruptions
       (let ((inhibit-message t))
-       (while-no-input
-         (unless (equal ivy--old-text ivy-text)
-           (let ((store ivy--dynamic-function)
-                 (ivy--dynamic-function nil))
-             (setq ivy--all-candidates (funcall store ivy-text)))
-           (setq ivy--old-text ivy-text))
-         (ivy--insert-minibuffer (ivy--format ivy--all-candidates))))
-    (when ivy--directory
-      (if (string-match "/$" ivy-text)
-          (if (member ivy-text ivy--all-candidates)
-              (ivy--cd (expand-file-name ivy-text ivy--directory))
-            (when (string-match "//$" ivy-text)
-              (ivy--cd "/")))
-        (if (string-match "~$" ivy-text)
-            (ivy--cd (expand-file-name "~/")))))
+        (while-no-input
+          (unless (equal ivy--old-text ivy-text)
+            (let ((store ivy--dynamic-function)
+                  (ivy--dynamic-function nil))
+              (setq ivy--all-candidates (funcall store ivy-text))))
+          (ivy--insert-minibuffer (ivy--format ivy--all-candidates))))
+    (cond (ivy--directory
+           (if (string-match "/$" ivy-text)
+               (if (member ivy-text ivy--all-candidates)
+                   (ivy--cd (expand-file-name ivy-text ivy--directory))
+                 (when (string-match "//$" ivy-text)
+                   (ivy--cd "/")))
+             (if (string-match "~$" ivy-text)
+                 (ivy--cd (expand-file-name "~/")))))
+          ((eq ivy--collection 'internal-complete-buffer)
+           (when (or (and (string-match "^ " ivy-text)
+                          (not (string-match "^ " ivy--old-text)))
+                     (and (string-match "^ " ivy--old-text)
+                          (not (string-match "^ " ivy-text))))
+             (setq ivy--all-candidates
+                   (all-completions
+                    (if (and (> (length ivy-text) 0)
+                             (eq (aref ivy-text 0)
+                                 ?\ ))
+                        " "
+                      "")
+                    'internal-complete-buffer))
+             (setq ivy--old-re nil))))
     (ivy--insert-minibuffer
      (ivy--format
-      (ivy--filter ivy-text ivy--all-candidates)))))
+      (ivy--filter ivy-text ivy--all-candidates))))
+  (setq ivy--old-text ivy-text))
 
 (defun ivy--insert-minibuffer (text)
+  "Insert TEXT into minibuffer with appropriate cleanup."
   (ivy--cleanup)
   (let ((buffer-undo-list t)
         deactivate-mark)
@@ -717,18 +882,24 @@ Should be run via minibuffer `post-command-hook'."
   "Propertize STR with FACE.
 `font-lock-append-text-property' is used, since it's better than
 `propertize' or `add-face-text-property' in this case."
-  (ignore-errors
-    (font-lock-append-text-property 0 (length str) 'face face str))
+  (require 'colir)
+  (condition-case nil
+      (colir-blend-face-background 0 (length str) face str)
+    (error
+     (ignore-errors
+       (font-lock-append-text-property 0 (length str) 'face face str))))
   str)
 
 (defun ivy--filter (name candidates)
-  "Return the matches for NAME for CANDIDATES.
+  "Return all items that match NAME in CANDIDATES.
 CANDIDATES are assumed to be static."
   (let* ((re (funcall ivy--regex-function name))
          (cands (cond ((and (equal re ivy--old-re)
                             ivy--old-cands)
                        ivy--old-cands)
                       ((and ivy--old-re
+                            (stringp re)
+                            (stringp ivy--old-re)
                             (not (string-match "\\\\" ivy--old-re))
                             (not (equal ivy--old-re ""))
                             (memq (cl-search
@@ -741,10 +912,18 @@ CANDIDATES are assumed to be static."
                           (lambda (x) (string-match re x))
                           ivy--old-cands)))
                       (t
-                       (ignore-errors
-                         (cl-remove-if-not
-                          (lambda (x) (string-match re x))
-                          candidates)))))
+                       (let ((re-list (if (stringp re) (list (cons re t)) re))
+                             (res candidates))
+                         (dolist (re re-list)
+                           (setq res
+                                 (ignore-errors
+                                   (funcall
+                                    (if (cdr re)
+                                        #'cl-remove-if-not
+                                      #'cl-remove-if)
+                                    `(lambda (x) (string-match ,(car re) x))
+                                    res))))
+                         res))))
          (tail (nthcdr ivy--index ivy--old-cands))
          idx)
     (when (and tail ivy--old-cands)
@@ -761,6 +940,10 @@ CANDIDATES are assumed to be static."
           ;; Compare with eq to handle equal duplicates in cands
           (setq idx (cl-position (pop tail) cands)))
         (setq ivy--index (or idx 0))))
+    (when (and (string= name "") (not (equal ivy--old-re "")))
+      (setq ivy--index
+            (or (cl-position ivy-def cands :test 'equal)
+                ivy--index)))
     (setq ivy--old-re re)
     (setq ivy--old-cands cands)))