X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/39eb0cb563f5287270f3946804456dc766386638..d279e6680842b872ae3aab1fb429b1879db50f7f:/lisp/minibuffer.el diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index ab54b9da13..9146c29ed8 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1,6 +1,6 @@ ;;; minibuffer.el --- Minibuffer completion functions -*- lexical-binding: t -*- -;; Copyright (C) 2008-2013 Free Software Foundation, Inc. +;; Copyright (C) 2008-2015 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; Package: emacs @@ -179,7 +179,9 @@ FUN will be called in the buffer from which the minibuffer was entered. The result of the `completion-table-dynamic' form is a function that can be used as the COLLECTION argument to `try-completion' and -`all-completions'. See Info node `(elisp)Programmed Completion'." +`all-completions'. See Info node `(elisp)Programmed Completion'. + +See also the related function `completion-table-with-cache'." (lambda (string pred action) (if (or (eq (car-safe action) 'boundaries) (eq action 'metadata)) ;; `fun' is not supposed to return another function but a plain old @@ -190,6 +192,26 @@ that can be used as the COLLECTION argument to `try-completion' and (current-buffer))) (complete-with-action action (funcall fun string) string pred))))) +(defun completion-table-with-cache (fun &optional ignore-case) + "Create dynamic completion table from function FUN, with cache. +This is a wrapper for `completion-table-dynamic' that saves the last +argument-result pair from FUN, so that several lookups with the +same argument (or with an argument that starts with the first one) +only need to call FUN once. This can be useful when FUN performs a +relatively slow operation, such as calling an external process. + +When IGNORE-CASE is non-nil, FUN is expected to be case-insensitive." + ;; See eg bug#11906. + (let* (last-arg last-result + (new-fun + (lambda (arg) + (if (and last-arg (string-prefix-p last-arg arg ignore-case)) + last-result + (prog1 + (setq last-result (funcall fun arg)) + (setq last-arg arg)))))) + (completion-table-dynamic new-fun))) + (defmacro lazy-completion-table (var fun) "Initialize variable VAR as a lazy completion table. If the completion table VAR is used for the first time (e.g., by passing VAR @@ -370,11 +392,37 @@ Note: TABLE needs to be a proper completion table which obeys predicates." "Create a completion table that tries each table in TABLES in turn." ;; FIXME: the boundaries may come from TABLE1 even when the completion list ;; is returned by TABLE2 (because TABLE1 returned an empty list). + ;; Same potential problem if any of the tables use quoting. (lambda (string pred action) (completion--some (lambda (table) (complete-with-action action table string pred)) tables))) +(defun completion-table-merge (&rest tables) + "Create a completion table that collects completions from all TABLES." + ;; FIXME: same caveats as in `completion-table-in-turn'. + (lambda (string pred action) + (cond + ((null action) + (let ((retvals (mapcar (lambda (table) + (try-completion string table pred)) + tables))) + (if (member string retvals) + string + (try-completion string + (mapcar (lambda (value) + (if (eq value t) string value)) + (delq nil retvals)) + pred)))) + ((eq action t) + (apply #'append (mapcar (lambda (table) + (all-completions string table pred)) + tables))) + (t + (completion--some (lambda (table) + (complete-with-action action table string pred)) + tables))))) + (defun completion-table-with-quoting (table unquote requote) ;; A difficult part of completion-with-quoting is to map positions in the ;; quoted string to equivalent positions in the unquoted string and @@ -471,11 +519,35 @@ for use at QPOS." completions)) ((eq action 'completion--unquote) - (let ((ustring (funcall unquote string)) - (uprefix (funcall unquote (substring string 0 pred)))) - ;; We presume (more or less) that `concat' and `unquote' commute. - (cl-assert (string-prefix-p uprefix ustring)) - (list ustring table (length uprefix) + ;; PRED is really a POINT in STRING. + ;; We should return a new set (STRING TABLE POINT REQUOTE) + ;; where STRING is a new (unquoted) STRING to match against the new TABLE + ;; using a new POINT inside it, and REQUOTE is a requoting function which + ;; should reverse the unquoting, (i.e. it receives the completion result + ;; of using the new TABLE and should turn it into the corresponding + ;; quoted result). + (let* ((qpos pred) + (ustring (funcall unquote string)) + (uprefix (funcall unquote (substring string 0 qpos))) + ;; FIXME: we really should pass `qpos' to `unquote' and have that + ;; function give us the corresponding `uqpos'. But for now we + ;; presume (more or less) that `concat' and `unquote' commute. + (uqpos (if (string-prefix-p uprefix ustring) + ;; Yay!! They do seem to commute! + (length uprefix) + ;; They don't commute this time! :-( + ;; Maybe qpos is in some text that disappears in the + ;; ustring (bug#17239). Let's try a second chance guess. + (let ((usuffix (funcall unquote (substring string qpos)))) + (if (string-suffix-p usuffix ustring) + ;; Yay!! They still "commute" in a sense! + (- (length ustring) (length usuffix)) + ;; Still no luck! Let's just choose *some* position + ;; within ustring. + (/ (+ (min (length uprefix) (length ustring)) + (max (- (length ustring) (length usuffix)) 0)) + 2)))))) + (list ustring table uqpos (lambda (unquoted-result op) (pcase op (1 ;;try @@ -805,13 +877,14 @@ completing buffer and file names, respectively." (setq string (pop new)) (setq table (pop new)) (setq point (pop new)) + (cl-assert (<= point (length string))) (pop new)))) - (result - (completion--some (lambda (style) - (funcall (nth n (assq style - completion-styles-alist)) - string table pred point)) - (completion--styles metadata)))) + (result + (completion--some (lambda (style) + (funcall (nth n (assq style + completion-styles-alist)) + string table pred point)) + (completion--styles metadata)))) (if requote (funcall requote result n) result))) @@ -873,8 +946,9 @@ Moves point to the end of the new text." (setq end (- end suffix-len)) (setq newtext (substring newtext 0 (- suffix-len)))) (goto-char beg) - (insert-and-inherit newtext) - (delete-region (point) (+ (point) (- end beg))) + (let ((length (- end beg))) ;Read `end' before we insert the text. + (insert-and-inherit newtext) + (delete-region (point) (+ (point) length))) (forward-char suffix-len))) (defcustom completion-cycle-threshold nil @@ -1066,7 +1140,8 @@ scroll the window of possible completions." ;; If end is in view, scroll up to the beginning. (set-window-start window (point-min) nil) ;; Else scroll down one screen. - (scroll-other-window)) + (with-selected-window window + (scroll-up))) nil))) ;; If we're cycling, keep on cycling. ((and completion-cycling completion-all-sorted-completions) @@ -1100,7 +1175,7 @@ scroll the window of possible completions." (if (eq (car bounds) base) md-at-point (completion-metadata (substring string 0 base) table pred)))) -(defun completion-all-sorted-completions (start end) +(defun completion-all-sorted-completions (&optional start end) (or completion-all-sorted-completions (let* ((start (or start (minibuffer-prompt-end))) (end (or end (point-max))) @@ -1147,12 +1222,16 @@ scroll the window of possible completions." (defun minibuffer-force-complete-and-exit () "Complete the minibuffer with first of the matches and exit." (interactive) - (minibuffer-force-complete) - (completion--complete-and-exit - (minibuffer-prompt-end) (point-max) #'exit-minibuffer - ;; If the previous completion completed to an element which fails - ;; test-completion, then we shouldn't exit, but that should be rare. - (lambda () (minibuffer-message "Incomplete")))) + (if (and (eq (minibuffer-prompt-end) (point-max)) + minibuffer-default) + ;; Use the provided default if there's one (bug#17545). + (minibuffer-complete-and-exit) + (minibuffer-force-complete) + (completion--complete-and-exit + (minibuffer-prompt-end) (point-max) #'exit-minibuffer + ;; If the previous completion completed to an element which fails + ;; test-completion, then we shouldn't exit, but that should be rare. + (lambda () (minibuffer-message "Incomplete"))))) (defun minibuffer-force-complete (&optional start end) "Complete the minibuffer to an exact match. @@ -1202,7 +1281,7 @@ Repeated uses step through the possible completions." (interactive) (let ((completion-extra-properties extra-prop)) (completion-in-region start (point) table pred))))) - (set-temporary-overlay-map + (set-transient-map (let ((map (make-sparse-keymap))) (define-key map [remap completion-at-point] cmd) (define-key map (vector last-command-event) cmd) @@ -1319,6 +1398,8 @@ appear to be a match." (before (substring string 0 point)) (after (substring string point)) tem) + ;; If both " " and "-" lead to completions, prefer " " so SPC behaves + ;; a bit more like a self-inserting key (bug#17375). (while (and exts (not (consp tem))) (setq tem (completion-try-completion (concat before (pop exts) after) @@ -1523,15 +1604,26 @@ See also `display-completion-list'.") (defface completions-first-difference '((t (:inherit bold))) - "Face added on the first uncommon character in completions in *Completions* buffer.") + "Face for the first uncommon character in completions. +See also the face `completions-common-part'.") (defface completions-common-part '((t nil)) - "Face added on the common prefix substring in completions in *Completions* buffer. -The idea of `completions-common-part' is that you can use it to -make the common parts less visible than normal, so that the rest -of the differing parts is, by contrast, slightly highlighted.") - -(defun completion-hilit-commonality (completions prefix-len base-size) + "Face for the common prefix substring in completions. +The idea of this face is that you can use it to make the common parts +less visible than normal, so that the differing parts are emphasized +by contrast. +See also the face `completions-first-difference'.") + +(defun completion-hilit-commonality (completions prefix-len &optional base-size) + "Apply font-lock highlighting to a list of completions, COMPLETIONS. +PREFIX-LEN is an integer. BASE-SIZE is an integer or nil (meaning zero). + +This adds the face `completions-common-part' to the first +\(PREFIX-LEN - BASE-SIZE) characters of each completion, and the face +`completions-first-difference' to the first character after that. + +It returns a list with font-lock properties applied to each element, +and with BASE-SIZE appended as the last element." (when completions (let ((com-str-len (- prefix-len (or base-size 0)))) (nconc @@ -1788,14 +1880,14 @@ variables.") (exit-minibuffer)) (defvar completion-in-region-functions nil - "Wrapper hook around `completion-in-region'.") + "Wrapper hook around `completion--in-region'.") (make-obsolete-variable 'completion-in-region-functions 'completion-in-region-function "24.4") (defvar completion-in-region-function #'completion--in-region "Function to perform the job of `completion-in-region'. The function is called with 4 arguments: START END COLLECTION PREDICATE. -The arguments and expected return value are like the ones of +The arguments and expected return value are as specified for `completion-in-region'.") (defvar completion-in-region--data nil) @@ -1813,10 +1905,12 @@ we entered `completion-in-region-mode'.") (defun completion-in-region (start end collection &optional predicate) "Complete the text between START and END using COLLECTION. -Return nil if there is no valid completion, else t. Point needs to be somewhere between START and END. -PREDICATE (a function called with no arguments) says when to -exit." +PREDICATE (a function called with no arguments) says when to exit. +This calls the function that `completion-in-region-function' specifies +\(passing the same four arguments that it received) to do the work, +and returns whatever it does. The return value should be nil +if there was no valid completion, else t." (cl-assert (<= start (point)) (<= (point) end)) (funcall completion-in-region-function start end collection predicate)) @@ -1828,6 +1922,9 @@ exit." :version "22.1") (defun completion--in-region (start end collection &optional predicate) + "Default function to use for `completion-in-region-function'. +Its arguments and return value are as specified for `completion-in-region'. +This respects the wrapper hook `completion-in-region-functions'." (with-wrapper-hook ;; FIXME: Maybe we should use this hook to provide a "display ;; completions" operation as well. @@ -1853,7 +1950,7 @@ exit." "Keymap activated during `completion-in-region'.") ;; It is difficult to know when to exit completion-in-region-mode (i.e. hide -;; the *Completions*). +;; the *Completions*). Here's how previous packages did it: ;; - lisp-mode: never. ;; - comint: only do it if you hit SPC at the right time. ;; - pcomplete: pop it down on SPC or after some time-delay. @@ -2346,7 +2443,7 @@ such as making the current buffer visit no file in the case of (defun read-file-name (prompt &optional dir default-filename mustmatch initial predicate) "Read file name, prompting with PROMPT and completing in directory DIR. -Value is not expanded---you must call `expand-file-name' yourself. +The return value is not expanded---you must call `expand-file-name' yourself. DIR is the directory to use for completing relative file names. It should be an absolute directory name, or nil (which means the @@ -2708,7 +2805,7 @@ expression (not containing character ranges like `a-z')." (defcustom completion-pcm-complete-word-inserts-delimiters nil "Treat the SPC or - inserted by `minibuffer-complete-word' as delimiters. -Those chars are treated as delimiters iff this variable is non-nil. +Those chars are treated as delimiters if this variable is non-nil. I.e. if non-nil, M-x SPC will just insert a \"-\" in the minibuffer, whereas if nil, it will list all possible commands in *Completions* because none of the commands start with a \"-\" or a SPC." @@ -3127,11 +3224,20 @@ the same set of elements." ;; Not `prefix'. mergedpat)) ;; New pos from the start. - (newpos (length (completion-pcm--pattern->string pointpat))) + (newpos (length (completion-pcm--pattern->string pointpat))) ;; Do it afterwards because it changes `pointpat' by side effect. (merged (completion-pcm--pattern->string (nreverse mergedpat)))) - (setq suffix (completion--merge-suffix merged newpos suffix)) + (setq suffix (completion--merge-suffix + ;; The second arg should ideally be "the position right + ;; after the last char of `merged' that comes from the text + ;; to be completed". But completion-pcm--merge-completions + ;; currently doesn't give us that info. So instead we just + ;; use the "last but one" position, which tends to work + ;; well in practice since `suffix' always starts + ;; with a boundary and we hence mostly/only care about + ;; merging this boundary (bug#15419). + merged (max 0 (1- (length merged))) suffix)) (cons (concat prefix merged suffix) (+ newpos (length prefix))))))) (defun completion-pcm-try-completion (string table pred point)