aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2008-04-21 19:02:54 +0000
committerStefan Monnier2008-04-21 19:02:54 +0000
commit3911966be9e48655d2c772a3e52634cd90769124 (patch)
treebeeb64cde907dc53f23543c4e1d208d4f858db91
parent47302633b2d8234d166d9df2bf88e7ddbae5cd5f (diff)
downloademacs-3911966be9e48655d2c772a3e52634cd90769124.tar.gz
emacs-3911966be9e48655d2c772a3e52634cd90769124.zip
(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.
-rw-r--r--lisp/ChangeLog13
-rw-r--r--lisp/minibuffer.el173
2 files changed, 101 insertions, 85 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index b9a9713273c..cd634e9ff02 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,16 @@
12008-04-21 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * minibuffer.el (completion-try-completion): Change magic symbol
4 property name. Rename from minibuffer-try-completion.
5 (completion-all-completions): Rename from minibuffer-all-completions.
6 Remove hide-spaces argument.
7 (completion--do-completion): Rename from minibuffer--do-completion.
8 (minibuffer-complete-and-exit): Call just try-completion rather than
9 completion-try-completion to fix up the case.
10 (completion--try-word-completion): Try to add space or hyphen before
11 making `string' a prefix of `completion'.
12 (completion--insert-strings): Rename from minibuffer--insert-strings.
13
12008-04-22 Naohiro Aota <nao.aota@gmail.com> (tiny change) 142008-04-22 Naohiro Aota <nao.aota@gmail.com> (tiny change)
2 15
3 * net/tls.el (tls-program): Add -ign_eof argument to call the 16 * net/tls.el (tls-program): Add -ign_eof argument to call the
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index dea94b675d1..65b420bd992 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -24,9 +24,12 @@
24;; Names starting with "minibuffer--" are for functions and variables that 24;; Names starting with "minibuffer--" are for functions and variables that
25;; are meant to be for internal use only. 25;; are meant to be for internal use only.
26 26
27;; TODO: 27;;; Todo:
28
28;; - New command minibuffer-force-complete that chooses one of all-completions. 29;; - New command minibuffer-force-complete that chooses one of all-completions.
29;; - make the `hide-spaces' arg of all-completions obsolete? 30;; - Add vc-file-name-completion-table to read-file-name-internal.
31;; - A feature like completing-help.el.
32;; - Make the `hide-spaces' arg of all-completions obsolete?
30 33
31;;; Code: 34;;; Code:
32 35
@@ -149,8 +152,8 @@ PRED1 is a function of one argument which returns non-nil iff the
149argument is an element of TABLE which should be considered for completion. 152argument is an element of TABLE which should be considered for completion.
150STRING, PRED2, and ACTION are the usual arguments to completion tables, 153STRING, PRED2, and ACTION are the usual arguments to completion tables,
151as described in `try-completion', `all-completions', and `test-completion'. 154as described in `try-completion', `all-completions', and `test-completion'.
152If STRICT is t, the predicate always applies, if nil it only applies if 155If STRICT is t, the predicate always applies; if nil it only applies if
153it doesn't reduce the set of possible completions to nothing. 156it does not reduce the set of possible completions to nothing.
154Note: TABLE needs to be a proper completion table which obeys predicates." 157Note: TABLE needs to be a proper completion table which obeys predicates."
155 (cond 158 (cond
156 ((and (not strict) (eq action 'lambda)) 159 ((and (not strict) (eq action 'lambda))
@@ -253,21 +256,27 @@ ALL-COMPLETIONS is the function that lists the completions.")
253 :group 'minibuffer 256 :group 'minibuffer
254 :version "23.1") 257 :version "23.1")
255 258
256(defun minibuffer-try-completion (string table pred) 259(defun completion-try-completion (string table pred)
257 (if (and (symbolp table) (get table 'no-completion-styles)) 260 ;; The property `completion-styles' indicates that this functional
258 (try-completion string table pred) 261 ;; completion-table claims to take care of completion styles itself.
262 ;; [I.e. It will most likely call us back at some point. ]
263 (if (and (symbolp table) (get table 'completion-styles))
264 (funcall table string pred nil)
259 (completion--some (lambda (style) 265 (completion--some (lambda (style)
260 (funcall (nth 1 (assq style completion-styles-alist)) 266 (funcall (nth 1 (assq style completion-styles-alist))
261 string table pred)) 267 string table pred))
262 completion-styles))) 268 completion-styles)))
263 269
264(defun minibuffer-all-completions (string table pred &optional hide-spaces) 270(defun completion-all-completions (string table pred)
271 ;; The property `completion-styles' indicates that this functional
272 ;; completion-table claims to take care of completion styles itself.
273 ;; [I.e. It will most likely call us back at some point. ]
265 (let ((completion-all-completions-with-base-size t)) 274 (let ((completion-all-completions-with-base-size t))
266 (if (and (symbolp table) (get table 'no-completion-styles)) 275 (if (and (symbolp table) (get table 'no-completion-styles))
267 (all-completions string table pred hide-spaces) 276 (funcall table string pred t)
268 (completion--some (lambda (style) 277 (completion--some (lambda (style)
269 (funcall (nth 2 (assq style completion-styles-alist)) 278 (funcall (nth 2 (assq style completion-styles-alist))
270 string table pred hide-spaces)) 279 string table pred))
271 completion-styles)))) 280 completion-styles))))
272 281
273(defun minibuffer--bitset (modified completions exact) 282(defun minibuffer--bitset (modified completions exact)
@@ -275,7 +284,7 @@ ALL-COMPLETIONS is the function that lists the completions.")
275 (if completions 2 0) 284 (if completions 2 0)
276 (if exact 1 0))) 285 (if exact 1 0)))
277 286
278(defun minibuffer--do-completion (&optional try-completion-function) 287(defun completion--do-completion (&optional try-completion-function)
279 "Do the completion and return a summary of what happened. 288 "Do the completion and return a summary of what happened.
280M = completion was performed, the text was Modified. 289M = completion was performed, the text was Modified.
281C = there were available Completions. 290C = there were available Completions.
@@ -291,9 +300,10 @@ E = after completion we now have an Exact match.
291 110 6 some completion happened 300 110 6 some completion happened
292 111 7 completed to an exact completion" 301 111 7 completed to an exact completion"
293 (let* ((beg (field-beginning)) 302 (let* ((beg (field-beginning))
294 (string (buffer-substring beg (point))) 303 (end (point))
304 (string (buffer-substring beg end))
295 (completion (funcall (or try-completion-function 305 (completion (funcall (or try-completion-function
296 'minibuffer-try-completion) 306 'completion-try-completion)
297 string 307 string
298 minibuffer-completion-table 308 minibuffer-completion-table
299 minibuffer-completion-predicate))) 309 minibuffer-completion-predicate)))
@@ -307,28 +317,21 @@ E = after completion we now have an Exact match.
307 ;; for appearance, the string is rewritten if the case changes. 317 ;; for appearance, the string is rewritten if the case changes.
308 (let ((completed (not (eq t (compare-strings completion nil nil 318 (let ((completed (not (eq t (compare-strings completion nil nil
309 string nil nil t)))) 319 string nil nil t))))
310 (unchanged (eq t (compare-strings completion nil nil 320 (unchanged (eq t (compare-strings completion nil nil
311 string nil nil nil)))) 321 string nil nil nil))))
312 (unless unchanged 322 (unless unchanged
313 ;; Merge a trailing / in completion with a / after point.
314 ;; We used to only do it for word completion, but it seems to make
315 ;; sense for all completions.
316 (if (and (eq ?/ (aref completion (1- (length completion))))
317 (< (point) (field-end))
318 (eq ?/ (char-after)))
319 (setq completion (substring completion 0 -1)))
320 323
321 ;; Insert in minibuffer the chars we got. 324 ;; Insert in minibuffer the chars we got.
322 (let ((end (point))) 325 (goto-char end)
323 (insert completion) 326 (insert completion)
324 (delete-region beg end))) 327 (delete-region beg end))
325 328
326 (if (not (or unchanged completed)) 329 (if (not (or unchanged completed))
327 ;; The case of the string changed, but that's all. We're not sure 330 ;; The case of the string changed, but that's all. We're not sure
328 ;; whether this is a unique completion or not, so try again using 331 ;; whether this is a unique completion or not, so try again using
329 ;; the real case (this shouldn't recurse again, because the next 332 ;; the real case (this shouldn't recurse again, because the next
330 ;; time try-completion will return either t or the exact string). 333 ;; time try-completion will return either t or the exact string).
331 (minibuffer--do-completion try-completion-function) 334 (completion--do-completion try-completion-function)
332 335
333 ;; It did find a match. Do we match some possibility exactly now? 336 ;; It did find a match. Do we match some possibility exactly now?
334 (let ((exact (test-completion (field-string) 337 (let ((exact (test-completion (field-string)
@@ -375,7 +378,7 @@ scroll the window of possible completions."
375 (scroll-other-window)) 378 (scroll-other-window))
376 nil) 379 nil)
377 380
378 (case (minibuffer--do-completion) 381 (case (completion--do-completion)
379 (0 nil) 382 (0 nil)
380 (1 (goto-char (field-end)) 383 (1 (goto-char (field-end))
381 (minibuffer-message "Sole completion") 384 (minibuffer-message "Sole completion")
@@ -390,55 +393,66 @@ scroll the window of possible completions."
390Otherwise try to complete it. If completion leads to a valid completion, 393Otherwise try to complete it. If completion leads to a valid completion,
391a repetition of this command will exit." 394a repetition of this command will exit."
392 (interactive) 395 (interactive)
393 (cond 396 (let ((beg (field-beginning))
394 ;; Allow user to specify null string 397 (end (field-end)))
395 ((= (field-beginning) (field-end)) (exit-minibuffer)) 398 (cond
396 ((test-completion (field-string) 399 ;; Allow user to specify null string
397 minibuffer-completion-table 400 ((= beg end) (exit-minibuffer))
398 minibuffer-completion-predicate) 401 ((test-completion (buffer-substring beg end)
399 (when completion-ignore-case 402 minibuffer-completion-table
400 ;; Fixup case of the field, if necessary. 403 minibuffer-completion-predicate)
401 (let* ((string (field-string)) 404 (when completion-ignore-case
402 (compl (minibuffer-try-completion 405 ;; Fixup case of the field, if necessary.
403 string 406 (let* ((string (substring beg end))
404 minibuffer-completion-table 407 (compl (try-completion
405 minibuffer-completion-predicate))) 408 string
406 (when (and (stringp compl) 409 minibuffer-completion-table
407 ;; If it weren't for this piece of paranoia, I'd replace 410 minibuffer-completion-predicate)))
408 ;; the whole thing with a call to complete-do-completion. 411 (when (and (stringp compl)
409 (= (length string) (length compl))) 412 ;; If it weren't for this piece of paranoia, I'd replace
410 (let ((beg (field-beginning)) 413 ;; the whole thing with a call to do-completion.
411 (end (field-end))) 414 (= (length string) (length compl)))
412 (goto-char end) 415 (goto-char end)
413 (insert compl) 416 (insert compl)
414 (delete-region beg end))))) 417 (delete-region beg end))))
415 (exit-minibuffer)) 418 (exit-minibuffer))
416 419
417 ((eq minibuffer-completion-confirm 'confirm-only) 420 ((eq minibuffer-completion-confirm 'confirm-only)
418 ;; The user is permitted to exit with an input that's rejected 421 ;; The user is permitted to exit with an input that's rejected
419 ;; by test-completion, but at the condition to confirm her choice. 422 ;; by test-completion, but at the condition to confirm her choice.
420 (if (eq last-command this-command) 423 (if (eq last-command this-command)
421 (exit-minibuffer) 424 (exit-minibuffer)
422 (minibuffer-message "Confirm") 425 (minibuffer-message "Confirm")
423 nil)) 426 nil))
424 427
425 (t 428 (t
426 ;; Call do-completion, but ignore errors. 429 ;; Call do-completion, but ignore errors.
427 (case (condition-case nil 430 (case (condition-case nil
428 (minibuffer--do-completion) 431 (completion--do-completion)
429 (error 1)) 432 (error 1))
430 ((1 3) (exit-minibuffer)) 433 ((1 3) (exit-minibuffer))
431 (7 (if (not minibuffer-completion-confirm) 434 (7 (if (not minibuffer-completion-confirm)
432 (exit-minibuffer) 435 (exit-minibuffer)
433 (minibuffer-message "Confirm") 436 (minibuffer-message "Confirm")
434 nil)) 437 nil))
435 (t nil))))) 438 (t nil))))))
436 439
437(defun minibuffer-try-word-completion (string table predicate) 440(defun completion--try-word-completion (string table predicate)
438 (let ((completion (minibuffer-try-completion string table predicate))) 441 (let ((completion (completion-try-completion string table predicate)))
439 (if (not (stringp completion)) 442 (if (not (stringp completion))
440 completion 443 completion
441 444
445 ;; If completion finds next char not unique,
446 ;; consider adding a space or a hyphen.
447 (when (= (length string) (length completion))
448 (let ((exts '(" " "-"))
449 tem)
450 (while (and exts (not (stringp tem)))
451 (setq tem (completion-try-completion
452 (concat string (pop exts))
453 table predicate)))
454 (if (stringp tem) (setq completion tem))))
455
442 ;; Completing a single word is actually more difficult than completing 456 ;; Completing a single word is actually more difficult than completing
443 ;; as much as possible, because we first have to find the "current 457 ;; as much as possible, because we first have to find the "current
444 ;; position" in `completion' in order to find the end of the word 458 ;; position" in `completion' in order to find the end of the word
@@ -473,16 +487,6 @@ a repetition of this command will exit."
473 487
474 ;; Now `string' is a prefix of `completion'. 488 ;; Now `string' is a prefix of `completion'.
475 489
476 ;; If completion finds next char not unique,
477 ;; consider adding a space or a hyphen.
478 (when (= (length string) (length completion))
479 (let ((exts '(" " "-"))
480 tem)
481 (while (and exts (not (stringp tem)))
482 (setq tem (minibuffer-try-completion (concat string (pop exts))
483 table predicate)))
484 (if (stringp tem) (setq completion tem))))
485
486 ;; Otherwise cut after the first word. 490 ;; Otherwise cut after the first word.
487 (if (string-match "\\W" completion (length string)) 491 (if (string-match "\\W" completion (length string))
488 ;; First find first word-break in the stuff found by completion. 492 ;; First find first word-break in the stuff found by completion.
@@ -497,7 +501,7 @@ After one word is completed as much as possible, a space or hyphen
497is added, provided that matches some possible completion. 501is added, provided that matches some possible completion.
498Return nil if there is no valid completion, else t." 502Return nil if there is no valid completion, else t."
499 (interactive) 503 (interactive)
500 (case (minibuffer--do-completion 'minibuffer-try-word-completion) 504 (case (completion--do-completion 'completion--try-word-completion)
501 (0 nil) 505 (0 nil)
502 (1 (goto-char (field-end)) 506 (1 (goto-char (field-end))
503 (minibuffer-message "Sole completion") 507 (minibuffer-message "Sole completion")
@@ -507,7 +511,7 @@ Return nil if there is no valid completion, else t."
507 t) 511 t)
508 (t t))) 512 (t t)))
509 513
510(defun minibuffer--insert-strings (strings) 514(defun completion--insert-strings (strings)
511 "Insert a list of STRINGS into the current buffer. 515 "Insert a list of STRINGS into the current buffer.
512Uses columns to keep the listing readable but compact. 516Uses columns to keep the listing readable but compact.
513It also eliminates runs of equal strings." 517It also eliminates runs of equal strings."
@@ -606,7 +610,7 @@ during running `completion-setup-hook'."
606 ;; Get the base-size from the tail of the list. 610 ;; Get the base-size from the tail of the list.
607 (set (make-local-variable 'completion-base-size) (or (cdr last) 0)) 611 (set (make-local-variable 'completion-base-size) (or (cdr last) 0))
608 (setcdr last nil)) ;Make completions a properly nil-terminated list. 612 (setcdr last nil)) ;Make completions a properly nil-terminated list.
609 (minibuffer--insert-strings completions)))) 613 (completion--insert-strings completions))))
610 614
611 (let ((completion-common-substring common-substring)) 615 (let ((completion-common-substring common-substring))
612 (run-hooks 'completion-setup-hook)) 616 (run-hooks 'completion-setup-hook))
@@ -617,11 +621,10 @@ during running `completion-setup-hook'."
617 (interactive) 621 (interactive)
618 (message "Making completion list...") 622 (message "Making completion list...")
619 (let* ((string (field-string)) 623 (let* ((string (field-string))
620 (completions (minibuffer-all-completions 624 (completions (completion-all-completions
621 string 625 string
622 minibuffer-completion-table 626 minibuffer-completion-table
623 minibuffer-completion-predicate 627 minibuffer-completion-predicate)))
624 t)))
625 (message nil) 628 (message nil)
626 (if (and completions 629 (if (and completions
627 (or (consp (cdr completions)) 630 (or (consp (cdr completions))