# HG changeset patch # User Stefan Monnier # Date 1208804574 0 # Node ID 81b6ecd7be019e1c56da77f40ef23fe2fc546a37 # Parent 7cc87e1801a686b7426a76b664b2170d1bb84bfd (completion-try-completion): Change magic symbol property name. Rename from minibuffer-try-completion. (completion-all-completions): Rename from minibuffer-all-completions. Remove hide-spaces argument. (completion--do-completion): Rename from minibuffer--do-completion. (minibuffer-complete-and-exit): Call just try-completion rather than completion-try-completion to fix up the case. (completion--try-word-completion): Try to add space or hyphen before making `string' a prefix of `completion'. (completion--insert-strings): Rename from minibuffer--insert-strings. diff -r 7cc87e1801a6 -r 81b6ecd7be01 lisp/ChangeLog --- a/lisp/ChangeLog Mon Apr 21 16:18:12 2008 +0000 +++ b/lisp/ChangeLog Mon Apr 21 19:02:54 2008 +0000 @@ -1,3 +1,16 @@ +2008-04-21 Stefan Monnier + + * minibuffer.el (completion-try-completion): Change magic symbol + property name. Rename from minibuffer-try-completion. + (completion-all-completions): Rename from minibuffer-all-completions. + Remove hide-spaces argument. + (completion--do-completion): Rename from minibuffer--do-completion. + (minibuffer-complete-and-exit): Call just try-completion rather than + completion-try-completion to fix up the case. + (completion--try-word-completion): Try to add space or hyphen before + making `string' a prefix of `completion'. + (completion--insert-strings): Rename from minibuffer--insert-strings. + 2008-04-22 Naohiro Aota (tiny change) * net/tls.el (tls-program): Add -ign_eof argument to call the diff -r 7cc87e1801a6 -r 81b6ecd7be01 lisp/minibuffer.el --- a/lisp/minibuffer.el Mon Apr 21 16:18:12 2008 +0000 +++ b/lisp/minibuffer.el Mon Apr 21 19:02:54 2008 +0000 @@ -24,9 +24,12 @@ ;; Names starting with "minibuffer--" are for functions and variables that ;; are meant to be for internal use only. -;; TODO: +;;; Todo: + ;; - New command minibuffer-force-complete that chooses one of all-completions. -;; - make the `hide-spaces' arg of all-completions obsolete? +;; - Add vc-file-name-completion-table to read-file-name-internal. +;; - A feature like completing-help.el. +;; - Make the `hide-spaces' arg of all-completions obsolete? ;;; Code: @@ -149,8 +152,8 @@ argument is an element of TABLE which should be considered for completion. STRING, PRED2, and ACTION are the usual arguments to completion tables, as described in `try-completion', `all-completions', and `test-completion'. -If STRICT is t, the predicate always applies, if nil it only applies if -it doesn't reduce the set of possible completions to nothing. +If STRICT is t, the predicate always applies; if nil it only applies if +it does not reduce the set of possible completions to nothing. Note: TABLE needs to be a proper completion table which obeys predicates." (cond ((and (not strict) (eq action 'lambda)) @@ -253,21 +256,27 @@ :group 'minibuffer :version "23.1") -(defun minibuffer-try-completion (string table pred) - (if (and (symbolp table) (get table 'no-completion-styles)) - (try-completion string table pred) +(defun completion-try-completion (string table pred) + ;; 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) (completion--some (lambda (style) (funcall (nth 1 (assq style completion-styles-alist)) string table pred)) completion-styles))) -(defun minibuffer-all-completions (string table pred &optional hide-spaces) +(defun completion-all-completions (string table pred) + ;; 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)) - (all-completions string table pred hide-spaces) + (funcall table string pred t) (completion--some (lambda (style) (funcall (nth 2 (assq style completion-styles-alist)) - string table pred hide-spaces)) + string table pred)) completion-styles)))) (defun minibuffer--bitset (modified completions exact) @@ -275,7 +284,7 @@ (if completions 2 0) (if exact 1 0))) -(defun minibuffer--do-completion (&optional try-completion-function) +(defun completion--do-completion (&optional try-completion-function) "Do the completion and return a summary of what happened. M = completion was performed, the text was Modified. C = there were available Completions. @@ -291,9 +300,10 @@ 110 6 some completion happened 111 7 completed to an exact completion" (let* ((beg (field-beginning)) - (string (buffer-substring beg (point))) + (end (point)) + (string (buffer-substring beg end)) (completion (funcall (or try-completion-function - 'minibuffer-try-completion) + 'completion-try-completion) string minibuffer-completion-table minibuffer-completion-predicate))) @@ -307,28 +317,21 @@ ;; for appearance, the string is rewritten if the case changes. (let ((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)))) + (unchanged (eq t (compare-strings completion nil nil + string nil nil nil)))) (unless unchanged - ;; 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)))) - (< (point) (field-end)) - (eq ?/ (char-after))) - (setq completion (substring completion 0 -1))) ;; Insert in minibuffer the chars we got. - (let ((end (point))) - (insert completion) - (delete-region beg end))) + (goto-char end) + (insert completion) + (delete-region beg end)) (if (not (or unchanged completed)) ;; The case of the string changed, but that's all. We're not sure ;; whether this is a unique completion or not, so try again using ;; the real case (this shouldn't recurse again, because the next ;; time try-completion will return either t or the exact string). - (minibuffer--do-completion try-completion-function) + (completion--do-completion try-completion-function) ;; It did find a match. Do we match some possibility exactly now? (let ((exact (test-completion (field-string) @@ -375,7 +378,7 @@ (scroll-other-window)) nil) - (case (minibuffer--do-completion) + (case (completion--do-completion) (0 nil) (1 (goto-char (field-end)) (minibuffer-message "Sole completion") @@ -390,55 +393,66 @@ Otherwise try to complete it. If completion leads to a valid completion, a repetition of this command will exit." (interactive) - (cond - ;; Allow user to specify null string - ((= (field-beginning) (field-end)) (exit-minibuffer)) - ((test-completion (field-string) - minibuffer-completion-table - minibuffer-completion-predicate) - (when completion-ignore-case - ;; Fixup case of the field, if necessary. - (let* ((string (field-string)) - (compl (minibuffer-try-completion - string - minibuffer-completion-table - minibuffer-completion-predicate))) - (when (and (stringp compl) - ;; If it weren't for this piece of paranoia, I'd replace - ;; the whole thing with a call to complete-do-completion. - (= (length string) (length compl))) - (let ((beg (field-beginning)) - (end (field-end))) + (let ((beg (field-beginning)) + (end (field-end))) + (cond + ;; Allow user to specify null string + ((= beg end) (exit-minibuffer)) + ((test-completion (buffer-substring beg end) + minibuffer-completion-table + minibuffer-completion-predicate) + (when completion-ignore-case + ;; Fixup case of the field, if necessary. + (let* ((string (substring beg end)) + (compl (try-completion + string + minibuffer-completion-table + minibuffer-completion-predicate))) + (when (and (stringp compl) + ;; If it weren't for this piece of paranoia, I'd replace + ;; the whole thing with a call to do-completion. + (= (length string) (length compl))) (goto-char end) (insert compl) - (delete-region beg end))))) - (exit-minibuffer)) + (delete-region beg end)))) + (exit-minibuffer)) - ((eq minibuffer-completion-confirm 'confirm-only) - ;; The user is permitted to exit with an input that's rejected - ;; by test-completion, but at the condition to confirm her choice. - (if (eq last-command this-command) - (exit-minibuffer) - (minibuffer-message "Confirm") - nil)) + ((eq minibuffer-completion-confirm 'confirm-only) + ;; The user is permitted to exit with an input that's rejected + ;; by test-completion, but at the condition to confirm her choice. + (if (eq last-command this-command) + (exit-minibuffer) + (minibuffer-message "Confirm") + nil)) - (t - ;; Call do-completion, but ignore errors. - (case (condition-case nil - (minibuffer--do-completion) - (error 1)) - ((1 3) (exit-minibuffer)) - (7 (if (not minibuffer-completion-confirm) - (exit-minibuffer) - (minibuffer-message "Confirm") - nil)) - (t nil))))) + (t + ;; Call do-completion, but ignore errors. + (case (condition-case nil + (completion--do-completion) + (error 1)) + ((1 3) (exit-minibuffer)) + (7 (if (not minibuffer-completion-confirm) + (exit-minibuffer) + (minibuffer-message "Confirm") + nil)) + (t nil)))))) -(defun minibuffer-try-word-completion (string table predicate) - (let ((completion (minibuffer-try-completion string table predicate))) +(defun completion--try-word-completion (string table predicate) + (let ((completion (completion-try-completion string table predicate))) (if (not (stringp completion)) completion + ;; If completion finds next char not unique, + ;; consider adding a space or a hyphen. + (when (= (length string) (length completion)) + (let ((exts '(" " "-")) + tem) + (while (and exts (not (stringp tem))) + (setq tem (completion-try-completion + (concat string (pop exts)) + table predicate))) + (if (stringp tem) (setq completion tem)))) + ;; Completing a single word is actually more difficult than completing ;; as much as possible, because we first have to find the "current ;; position" in `completion' in order to find the end of the word @@ -473,16 +487,6 @@ ;; Now `string' is a prefix of `completion'. - ;; If completion finds next char not unique, - ;; consider adding a space or a hyphen. - (when (= (length string) (length completion)) - (let ((exts '(" " "-")) - tem) - (while (and exts (not (stringp tem))) - (setq tem (minibuffer-try-completion (concat string (pop exts)) - table predicate))) - (if (stringp tem) (setq completion tem)))) - ;; Otherwise cut after the first word. (if (string-match "\\W" completion (length string)) ;; First find first word-break in the stuff found by completion. @@ -497,7 +501,7 @@ is added, provided that matches some possible completion. Return nil if there is no valid completion, else t." (interactive) - (case (minibuffer--do-completion 'minibuffer-try-word-completion) + (case (completion--do-completion 'completion--try-word-completion) (0 nil) (1 (goto-char (field-end)) (minibuffer-message "Sole completion") @@ -507,7 +511,7 @@ t) (t t))) -(defun minibuffer--insert-strings (strings) +(defun completion--insert-strings (strings) "Insert a list of STRINGS into the current buffer. Uses columns to keep the listing readable but compact. It also eliminates runs of equal strings." @@ -606,7 +610,7 @@ ;; Get the base-size from the tail of the list. (set (make-local-variable 'completion-base-size) (or (cdr last) 0)) (setcdr last nil)) ;Make completions a properly nil-terminated list. - (minibuffer--insert-strings completions)))) + (completion--insert-strings completions)))) (let ((completion-common-substring common-substring)) (run-hooks 'completion-setup-hook)) @@ -617,11 +621,10 @@ (interactive) (message "Making completion list...") (let* ((string (field-string)) - (completions (minibuffer-all-completions + (completions (completion-all-completions string minibuffer-completion-table - minibuffer-completion-predicate - t))) + minibuffer-completion-predicate))) (message nil) (if (and completions (or (consp (cdr completions))