X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/fddedd20a99a84be82c14bc76c63c56d2fb9b570..413744728dffde2f9b82a3bd6f0018eefa122a32:/packages/swiper/ivy.el diff --git a/packages/swiper/ivy.el b/packages/swiper/ivy.el index ed9d3f90e..4fba49692 100644 --- a/packages/swiper/ivy.el +++ b/packages/swiper/ivy.el @@ -50,10 +50,22 @@ '((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 "") '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)))