diff options
| author | Stefan Monnier | 2008-04-21 19:02:54 +0000 |
|---|---|---|
| committer | Stefan Monnier | 2008-04-21 19:02:54 +0000 |
| commit | 3911966be9e48655d2c772a3e52634cd90769124 (patch) | |
| tree | beeb64cde907dc53f23543c4e1d208d4f858db91 | |
| parent | 47302633b2d8234d166d9df2bf88e7ddbae5cd5f (diff) | |
| download | emacs-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/ChangeLog | 13 | ||||
| -rw-r--r-- | lisp/minibuffer.el | 173 |
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 @@ | |||
| 1 | 2008-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 | |||
| 1 | 2008-04-22 Naohiro Aota <nao.aota@gmail.com> (tiny change) | 14 | 2008-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 | |||
| 149 | argument is an element of TABLE which should be considered for completion. | 152 | argument is an element of TABLE which should be considered for completion. |
| 150 | STRING, PRED2, and ACTION are the usual arguments to completion tables, | 153 | STRING, PRED2, and ACTION are the usual arguments to completion tables, |
| 151 | as described in `try-completion', `all-completions', and `test-completion'. | 154 | as described in `try-completion', `all-completions', and `test-completion'. |
| 152 | If STRICT is t, the predicate always applies, if nil it only applies if | 155 | If STRICT is t, the predicate always applies; if nil it only applies if |
| 153 | it doesn't reduce the set of possible completions to nothing. | 156 | it does not reduce the set of possible completions to nothing. |
| 154 | Note: TABLE needs to be a proper completion table which obeys predicates." | 157 | Note: 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. |
| 280 | M = completion was performed, the text was Modified. | 289 | M = completion was performed, the text was Modified. |
| 281 | C = there were available Completions. | 290 | C = 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." | |||
| 390 | Otherwise try to complete it. If completion leads to a valid completion, | 393 | Otherwise try to complete it. If completion leads to a valid completion, |
| 391 | a repetition of this command will exit." | 394 | a 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 | |||
| 497 | is added, provided that matches some possible completion. | 501 | is added, provided that matches some possible completion. |
| 498 | Return nil if there is no valid completion, else t." | 502 | Return 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. |
| 512 | Uses columns to keep the listing readable but compact. | 516 | Uses columns to keep the listing readable but compact. |
| 513 | It also eliminates runs of equal strings." | 517 | It 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)) |