Commit 19c04f39 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

(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.
parent caea54f8
2008-04-23 Stefan Monnier <monnier@iro.umontreal.ca>
* 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 <agustin.martin@hispalinux.es> 2008-04-23 Agustin Martin <agustin.martin@hispalinux.es>
   
* ispell.el (ispell-set-spellchecker-params): New function to make sure * ispell.el (ispell-set-spellchecker-params): New function to make sure
......
...@@ -26,6 +26,7 @@ ...@@ -26,6 +26,7 @@
;;; Todo: ;;; Todo:
;; - Make read-file-name-predicate obsolete.
;; - New command minibuffer-force-complete that chooses one of all-completions. ;; - New command minibuffer-force-complete that chooses one of all-completions.
;; - Add vc-file-name-completion-table to read-file-name-internal. ;; - Add vc-file-name-completion-table to read-file-name-internal.
;; - A feature like completing-help.el. ;; - A feature like completing-help.el.
...@@ -239,7 +240,9 @@ the second failed attempt to complete." ...@@ -239,7 +240,9 @@ the second failed attempt to complete."
:group 'minibuffer) :group 'minibuffer)
(defvar completion-styles-alist (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 ;; (partial-completion
;; completion-pcm--try-completion completion-pcm--all-completions) ;; completion-pcm--try-completion completion-pcm--all-completions)
) )
...@@ -256,27 +259,47 @@ ALL-COMPLETIONS is the function that lists the completions.") ...@@ -256,27 +259,47 @@ ALL-COMPLETIONS is the function that lists the completions.")
:group 'minibuffer :group 'minibuffer
:version "23.1") :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 ;; The property `completion-styles' indicates that this functional
;; completion-table claims to take care of completion styles itself. ;; completion-table claims to take care of completion styles itself.
;; [I.e. It will most likely call us back at some point. ] ;; [I.e. It will most likely call us back at some point. ]
(if (and (symbolp table) (get table 'completion-styles)) (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) (completion--some (lambda (style)
(funcall (nth 1 (assq style completion-styles-alist)) (funcall (nth 1 (assq style completion-styles-alist))
string table pred)) string table pred point))
completion-styles))) 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 ;; The property `completion-styles' indicates that this functional
;; completion-table claims to take care of completion styles itself. ;; completion-table claims to take care of completion styles itself.
;; [I.e. It will most likely call us back at some point. ] ;; [I.e. It will most likely call us back at some point. ]
(let ((completion-all-completions-with-base-size t)) (let ((completion-all-completions-with-base-size t))
(if (and (symbolp table) (get table 'no-completion-styles)) (if (and (symbolp table) (get table 'completion-styles))
(funcall table string pred t) ;; 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) (completion--some (lambda (style)
(funcall (nth 2 (assq style completion-styles-alist)) (funcall (nth 2 (assq style completion-styles-alist))
string table pred)) string table pred point))
completion-styles)))) completion-styles))))
(defun minibuffer--bitset (modified completions exact) (defun minibuffer--bitset (modified completions exact)
...@@ -300,23 +323,26 @@ E = after completion we now have an Exact match. ...@@ -300,23 +323,26 @@ E = after completion we now have an Exact match.
110 6 some completion happened 110 6 some completion happened
111 7 completed to an exact completion" 111 7 completed to an exact completion"
(let* ((beg (field-beginning)) (let* ((beg (field-beginning))
(end (point)) (end (field-end))
(string (buffer-substring beg end)) (string (buffer-substring beg end))
(completion (funcall (or try-completion-function (comp (funcall (or try-completion-function
'completion-try-completion) 'completion-try-completion)
string string
minibuffer-completion-table minibuffer-completion-table
minibuffer-completion-predicate))) minibuffer-completion-predicate
(- (point) beg))))
(cond (cond
((null completion) ((null comp)
(ding) (minibuffer-message "No match") (minibuffer--bitset nil nil nil)) (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 (t
;; `completed' should be t if some completion was done, which doesn't ;; `completed' should be t if some completion was done, which doesn't
;; include simply changing the case of the entered string. However, ;; include simply changing the case of the entered string. However,
;; for appearance, the string is rewritten if the case changes. ;; for appearance, the string is rewritten if the case changes.
(let ((completed (not (eq t (compare-strings completion nil nil (let* ((comp-pos (cdr comp))
string nil nil t)))) (completion (car comp))
(completed (not (eq t (compare-strings completion nil nil
string nil nil t))))
(unchanged (eq t (compare-strings completion nil nil (unchanged (eq t (compare-strings completion nil nil
string nil nil nil)))) string nil nil nil))))
(unless unchanged (unless unchanged
...@@ -324,7 +350,8 @@ E = after completion we now have an Exact match. ...@@ -324,7 +350,8 @@ E = after completion we now have an Exact match.
;; Insert in minibuffer the chars we got. ;; Insert in minibuffer the chars we got.
(goto-char end) (goto-char end)
(insert completion) (insert completion)
(delete-region beg end)) (delete-region beg end)
(goto-char (+ beg comp-pos)))
(if (not (or unchanged completed)) (if (not (or unchanged completed))
;; The case of the string changed, but that's all. We're not sure ;; The case of the string changed, but that's all. We're not sure
...@@ -334,7 +361,7 @@ E = after completion we now have an Exact match. ...@@ -334,7 +361,7 @@ E = after completion we now have an Exact match.
(completion--do-completion try-completion-function) (completion--do-completion try-completion-function)
;; It did find a match. Do we match some possibility exactly now? ;; 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-table
minibuffer-completion-predicate))) minibuffer-completion-predicate)))
(unless completed (unless completed
...@@ -437,21 +464,23 @@ a repetition of this command will exit." ...@@ -437,21 +464,23 @@ a repetition of this command will exit."
nil)) nil))
(t nil)))))) (t nil))))))
(defun completion--try-word-completion (string table predicate) (defun completion--try-word-completion (string table predicate point)
(let ((completion (completion-try-completion string table predicate))) (let ((comp (completion-try-completion string table predicate point)))
(if (not (stringp completion)) (if (not (consp comp))
completion comp
;; If completion finds next char not unique, ;; If completion finds next char not unique,
;; consider adding a space or a hyphen. ;; consider adding a space or a hyphen.
(when (= (length string) (length completion)) (when (= (length string) (length (car comp)))
(let ((exts '(" " "-")) (let ((exts '(" " "-"))
tem) (before (substring string 0 point))
(while (and exts (not (stringp tem))) (after (substring string point))
tem)
(while (and exts (not (consp tem)))
(setq tem (completion-try-completion (setq tem (completion-try-completion
(concat string (pop exts)) (concat before (pop exts) after)
table predicate))) table predicate (1+ point))))
(if (stringp tem) (setq completion tem)))) (if (consp tem) (setq comp tem))))
;; Completing a single word is actually more difficult than completing ;; Completing a single word is actually more difficult than completing
;; as much as possible, because we first have to find the "current ;; as much as possible, because we first have to find the "current
...@@ -460,39 +489,58 @@ a repetition of this command will exit." ...@@ -460,39 +489,58 @@ a repetition of this command will exit."
;; which makes it trivial to find the position, but with fancier ;; which makes it trivial to find the position, but with fancier
;; completion (plus env-var expansion, ...) `completion' might not ;; completion (plus env-var expansion, ...) `completion' might not
;; look anything like `string' at all. ;; look anything like `string' at all.
(let* ((comppoint (cdr comp))
(when minibuffer-completing-file-name (completion (car comp))
;; In order to minimize the problem mentioned above, let's try to (before (substring string 0 point))
;; reduce the different between `string' and `completion' by (combined (concat before "\n" completion)))
;; mirroring some of the work done in read-file-name-internal. ;; Find in completion the longest text that was right before point.
(let ((substituted (condition-case nil (when (string-match "\\(.+\\)\n.*?\\1" combined)
;; Might fail when completing an env-var. (let* ((prefix (match-string 1 before))
(substitute-in-file-name string) ;; We used non-greedy match to make `rem' as long as possible.
(error string)))) (rem (substring combined (match-end 0)))
(unless (eq string substituted) ;; Find in the remainder of completion the longest text
(setq string substituted)))) ;; that was right after point.
(after (substring string point))
;; Make buffer (before point) contain the longest match (suffix (if (string-match "\\`\\(.+\\).*\n.*\\1"
;; of `string's tail and `completion's head. (concat after "\n" rem))
(let* ((startpos (max 0 (- (length string) (length completion)))) (match-string 1 after))))
(length (- (length string) startpos))) ;; The general idea is to try and guess what text was inserted
(while (and (> length 0) ;; at point by the completion. Problem is: if we guess wrong,
(not (eq t (compare-strings string startpos nil ;; we may end up treating as "added by completion" text that was
completion 0 length ;; actually painfully typed by the user. So if we then cut
completion-ignore-case)))) ;; after the first word, we may throw away things the
(setq startpos (1+ startpos)) ;; user wrote. So let's try to be as conservative as possible:
(setq length (1- length))) ;; only cut after the first word, if we're reasonably sure that
;; our guess is correct.
(setq string (substring string startpos))) ;; Note: a quick survey on emacs-devel seemed to indicate that
;; nobody actually cares about the "word-at-a-time" feature of
;; Now `string' is a prefix of `completion'. ;; minibuffer-complete-word, whose real raison-d'être is that it
;; tries to add "-" or " ". One more reason to only cut after
;; Otherwise cut after the first word. ;; the first word, if we're really sure we're right.
(if (string-match "\\W" completion (length string)) (when (and (or suffix (zerop (length after)))
;; First find first word-break in the stuff found by completion. (string-match (concat
;; i gets index in string of where to stop completing. ;; Make submatch 1 as small as possible
(substring completion 0 (match-end 0)) ;; to reduce the risk of cutting
completion)))) ;; 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)))))
(cons completion comppoint)))))
(defun minibuffer-complete-word () (defun minibuffer-complete-word ()
...@@ -624,7 +672,8 @@ during running `completion-setup-hook'." ...@@ -624,7 +672,8 @@ during running `completion-setup-hook'."
(completions (completion-all-completions (completions (completion-all-completions
string string
minibuffer-completion-table minibuffer-completion-table
minibuffer-completion-predicate))) minibuffer-completion-predicate
(- (point) (field-beginning)))))
(message nil) (message nil)
(if (and completions (if (and completions
(or (consp (cdr completions)) (or (consp (cdr completions))
...@@ -928,6 +977,41 @@ Like `internal-complete-buffer', but removes BUFFER from the completion list." ...@@ -928,6 +977,41 @@ Like `internal-complete-buffer', but removes BUFFER from the completion list."
(not (equal (if (consp name) (car name) name) except))) (not (equal (if (consp name) (car name) name) except)))
nil))) 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) (provide 'minibuffer)
;; arch-tag: ef8a0a15-1080-4790-a754-04017c02f08f ;; arch-tag: ef8a0a15-1080-4790-a754-04017c02f08f
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment