# HG changeset patch # User Stefan Monnier # Date 1208984491 0 # Node ID bc48ced5cf89d4e260833df3bd5f13e74038c2e5 # Parent e0b01f455de069c862715f583d81803d48a6778b (completion-try-completion): Add `point' argument. Change return value. (completion-all-completions): Add `point' argument. (minibuffer-completion-help): Pass the new `point' argument. (completion--do-completion): Pass the whole field to try-completion. (completion--try-word-completion): Rewrite, making fewer assumptions. (completion-emacs21-try-completion, completion-emacs21-all-completions) (completion-emacs22-try-completion, completion-emacs22-all-completions) (completion-basic-try-completion, completion-basic-all-completions): New funs. (completion-styles-alist): Use them. diff -r e0b01f455de0 -r bc48ced5cf89 lisp/ChangeLog --- a/lisp/ChangeLog Wed Apr 23 20:39:10 2008 +0000 +++ b/lisp/ChangeLog Wed Apr 23 21:01:31 2008 +0000 @@ -1,3 +1,17 @@ +2008-04-23 Stefan Monnier + + * minibuffer.el (completion-try-completion): Add `point' argument. + Change return value. + (completion-all-completions): Add `point' argument. + (minibuffer-completion-help): Pass the new `point' argument. + (completion--do-completion): Pass the whole field to try-completion. + (completion--try-word-completion): Rewrite, making fewer assumptions. + (completion-emacs21-try-completion, completion-emacs21-all-completions) + (completion-emacs22-try-completion, completion-emacs22-all-completions) + (completion-basic-try-completion, completion-basic-all-completions): + New functions. + (completion-styles-alist): Use them. + 2008-04-23 Agustin Martin * ispell.el (ispell-set-spellchecker-params): New function to make sure diff -r e0b01f455de0 -r bc48ced5cf89 lisp/minibuffer.el --- a/lisp/minibuffer.el Wed Apr 23 20:39:10 2008 +0000 +++ b/lisp/minibuffer.el Wed Apr 23 21:01:31 2008 +0000 @@ -26,6 +26,7 @@ ;;; Todo: +;; - Make read-file-name-predicate obsolete. ;; - New command minibuffer-force-complete that chooses one of all-completions. ;; - Add vc-file-name-completion-table to read-file-name-internal. ;; - A feature like completing-help.el. @@ -239,7 +240,9 @@ :group 'minibuffer) (defvar completion-styles-alist - '((basic try-completion all-completions) + '((basic completion-basic-try-completion completion-basic-all-completions) + (emacs22 completion-emacs22-try-completion completion-emacs22-all-completions) + (emacs21 completion-emacs21-try-completion completion-emacs21-all-completions) ;; (partial-completion ;; completion-pcm--try-completion completion-pcm--all-completions) ) @@ -256,27 +259,47 @@ :group 'minibuffer :version "23.1") -(defun completion-try-completion (string table pred) +(defun completion-try-completion (string table pred point) + "Try to complete STRING using completion table TABLE. +Only the elements of table that satisfy predicate PRED are considered. +POINT is the position of point within STRING. +The return value can be either nil to indicate that there is no completion, +t to indicate that STRING is the only possible completion, +or a pair (STRING . NEWPOINT) of the completed result string together with +a new position for point." ;; The property `completion-styles' indicates that this functional ;; completion-table claims to take care of completion styles itself. ;; [I.e. It will most likely call us back at some point. ] (if (and (symbolp table) (get table 'completion-styles)) - (funcall table string pred nil) + ;; Extended semantics for functional completion-tables: + ;; They accept a 4th argument `point' and when called with action=nil + ;; and this 4th argument (a position inside `string'), they should + ;; return instead of a string a pair (STRING . NEWPOINT). + (funcall table string pred nil point) (completion--some (lambda (style) (funcall (nth 1 (assq style completion-styles-alist)) - string table pred)) + string table pred point)) completion-styles))) -(defun completion-all-completions (string table pred) +(defun completion-all-completions (string table pred point) + "List the possible completions of STRING in completion table TABLE. +Only the elements of table that satisfy predicate PRED are considered. +POINT is the position of point within STRING. +The return value is a list of completions and may contain the BASE-SIZE +in the last `cdr'." ;; The property `completion-styles' indicates that this functional ;; completion-table claims to take care of completion styles itself. ;; [I.e. It will most likely call us back at some point. ] (let ((completion-all-completions-with-base-size t)) - (if (and (symbolp table) (get table 'no-completion-styles)) - (funcall table string pred t) + (if (and (symbolp table) (get table 'completion-styles)) + ;; Extended semantics for functional completion-tables: + ;; They accept a 4th argument `point' and when called with action=t + ;; and this 4th argument (a position inside `string'), they may + ;; return BASE-SIZE in the last `cdr'. + (funcall table string pred t point) (completion--some (lambda (style) (funcall (nth 2 (assq style completion-styles-alist)) - string table pred)) + string table pred point)) completion-styles)))) (defun minibuffer--bitset (modified completions exact) @@ -300,23 +323,26 @@ 110 6 some completion happened 111 7 completed to an exact completion" (let* ((beg (field-beginning)) - (end (point)) + (end (field-end)) (string (buffer-substring beg end)) - (completion (funcall (or try-completion-function - 'completion-try-completion) - string - minibuffer-completion-table - minibuffer-completion-predicate))) + (comp (funcall (or try-completion-function + 'completion-try-completion) + string + minibuffer-completion-table + minibuffer-completion-predicate + (- (point) beg)))) (cond - ((null completion) + ((null comp) (ding) (minibuffer-message "No match") (minibuffer--bitset nil nil nil)) - ((eq t completion) (minibuffer--bitset nil nil t)) ;Exact and unique match. + ((eq t comp) (minibuffer--bitset nil nil t)) ;Exact and unique match. (t ;; `completed' should be t if some completion was done, which doesn't ;; include simply changing the case of the entered string. However, ;; for appearance, the string is rewritten if the case changes. - (let ((completed (not (eq t (compare-strings completion nil nil - string nil nil t)))) + (let* ((comp-pos (cdr comp)) + (completion (car comp)) + (completed (not (eq t (compare-strings completion nil nil + string nil nil t)))) (unchanged (eq t (compare-strings completion nil nil string nil nil nil)))) (unless unchanged @@ -324,7 +350,8 @@ ;; Insert in minibuffer the chars we got. (goto-char end) (insert completion) - (delete-region beg end)) + (delete-region beg end) + (goto-char (+ beg comp-pos))) (if (not (or unchanged completed)) ;; The case of the string changed, but that's all. We're not sure @@ -334,7 +361,7 @@ (completion--do-completion try-completion-function) ;; It did find a match. Do we match some possibility exactly now? - (let ((exact (test-completion (field-string) + (let ((exact (test-completion completion minibuffer-completion-table minibuffer-completion-predicate))) (unless completed @@ -437,21 +464,23 @@ nil)) (t nil)))))) -(defun completion--try-word-completion (string table predicate) - (let ((completion (completion-try-completion string table predicate))) - (if (not (stringp completion)) - completion +(defun completion--try-word-completion (string table predicate point) + (let ((comp (completion-try-completion string table predicate point))) + (if (not (consp comp)) + comp ;; If completion finds next char not unique, ;; consider adding a space or a hyphen. - (when (= (length string) (length completion)) + (when (= (length string) (length (car comp))) (let ((exts '(" " "-")) - tem) - (while (and exts (not (stringp tem))) + (before (substring string 0 point)) + (after (substring string point)) + tem) + (while (and exts (not (consp tem))) (setq tem (completion-try-completion - (concat string (pop exts)) - table predicate))) - (if (stringp tem) (setq completion tem)))) + (concat before (pop exts) after) + table predicate (1+ point)))) + (if (consp tem) (setq comp tem)))) ;; Completing a single word is actually more difficult than completing ;; as much as possible, because we first have to find the "current @@ -460,39 +489,58 @@ ;; which makes it trivial to find the position, but with fancier ;; completion (plus env-var expansion, ...) `completion' might not ;; look anything like `string' at all. - - (when minibuffer-completing-file-name - ;; In order to minimize the problem mentioned above, let's try to - ;; reduce the different between `string' and `completion' by - ;; mirroring some of the work done in read-file-name-internal. - (let ((substituted (condition-case nil - ;; Might fail when completing an env-var. - (substitute-in-file-name string) - (error string)))) - (unless (eq string substituted) - (setq string substituted)))) + (let* ((comppoint (cdr comp)) + (completion (car comp)) + (before (substring string 0 point)) + (combined (concat before "\n" completion))) + ;; Find in completion the longest text that was right before point. + (when (string-match "\\(.+\\)\n.*?\\1" combined) + (let* ((prefix (match-string 1 before)) + ;; We used non-greedy match to make `rem' as long as possible. + (rem (substring combined (match-end 0))) + ;; Find in the remainder of completion the longest text + ;; that was right after point. + (after (substring string point)) + (suffix (if (string-match "\\`\\(.+\\).*\n.*\\1" + (concat after "\n" rem)) + (match-string 1 after)))) + ;; The general idea is to try and guess what text was inserted + ;; at point by the completion. Problem is: if we guess wrong, + ;; we may end up treating as "added by completion" text that was + ;; actually painfully typed by the user. So if we then cut + ;; after the first word, we may throw away things the + ;; user wrote. So let's try to be as conservative as possible: + ;; only cut after the first word, if we're reasonably sure that + ;; our guess is correct. + ;; Note: a quick survey on emacs-devel seemed to indicate that + ;; nobody actually cares about the "word-at-a-time" feature of + ;; minibuffer-complete-word, whose real raison-d'être is that it + ;; tries to add "-" or " ". One more reason to only cut after + ;; the first word, if we're really sure we're right. + (when (and (or suffix (zerop (length after))) + (string-match (concat + ;; Make submatch 1 as small as possible + ;; to reduce the risk of cutting + ;; valuable text. + ".*" (regexp-quote prefix) "\\(.*?\\)" + (if suffix (regexp-quote suffix) "\\'")) + completion) + ;; The new point in `completion' should also be just + ;; before the suffix, otherwise something more complex + ;; is going on, and we're not sure where we are. + (eq (match-end 1) comppoint) + ;; (match-beginning 1)..comppoint is now the stretch + ;; of text in `completion' that was completed at point. + (string-match "\\W" completion (match-beginning 1)) + ;; Is there really something to cut? + (> comppoint (match-end 0))) + ;; Cut after the first word. + (let ((cutpos (match-end 0))) + (setq completion (concat (substring completion 0 cutpos) + (substring completion comppoint))) + (setq comppoint cutpos))))) - ;; Make buffer (before point) contain the longest match - ;; of `string's tail and `completion's head. - (let* ((startpos (max 0 (- (length string) (length completion)))) - (length (- (length string) startpos))) - (while (and (> length 0) - (not (eq t (compare-strings string startpos nil - completion 0 length - completion-ignore-case)))) - (setq startpos (1+ startpos)) - (setq length (1- length))) - - (setq string (substring string startpos))) - - ;; Now `string' is a prefix of `completion'. - - ;; Otherwise cut after the first word. - (if (string-match "\\W" completion (length string)) - ;; First find first word-break in the stuff found by completion. - ;; i gets index in string of where to stop completing. - (substring completion 0 (match-end 0)) - completion)))) + (cons completion comppoint))))) (defun minibuffer-complete-word () @@ -624,7 +672,8 @@ (completions (completion-all-completions string minibuffer-completion-table - minibuffer-completion-predicate))) + minibuffer-completion-predicate + (- (point) (field-beginning))))) (message nil) (if (and completions (or (consp (cdr completions)) @@ -928,6 +977,41 @@ (not (equal (if (consp name) (car name) name) except))) nil))) +;;; Old-style completion, used in Emacs-21. + +(defun completion-emacs21-try-completion (string table pred point) + (let ((completion (try-completion string table pred))) + (if (stringp completion) + (cons completion (length completion)) + completion))) + +(defun completion-emacs21-all-completions (string table pred point) + (all-completions string table pred t)) + +;;; Basic completion, used in Emacs-22. + +(defun completion-emacs22-try-completion (string table pred point) + (let ((suffix (substring string point)) + (completion (try-completion (substring string 0 point) table pred))) + (if (not (stringp completion)) + completion + ;; Merge a trailing / in completion with a / after point. + ;; We used to only do it for word completion, but it seems to make + ;; sense for all completions. + (if (and (eq ?/ (aref completion (1- (length completion)))) + (not (zerop (length suffix))) + (eq ?/ (aref suffix 0))) + ;; This leaves point before the / . + ;; Should we maybe put it after the / ? --Stef + (setq completion (substring completion 0 -1))) + (cons (concat completion suffix) (length completion))))) + +(defun completion-emacs22-all-completions (string table pred point) + (all-completions (substring string 0 point) table pred t)) + +(defalias 'completion-basic-try-completion 'completion-emacs22-try-completion) +(defalias 'completion-basic-all-completions 'completion-emacs22-all-completions) + (provide 'minibuffer) ;; arch-tag: ef8a0a15-1080-4790-a754-04017c02f08f