Mercurial > emacs
comparison lisp/minibuffer.el @ 94304:bc48ced5cf89
(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.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Wed, 23 Apr 2008 21:01:31 +0000 |
parents | 9060af7294b9 |
children | 755dd4bba830 |
comparison
equal
deleted
inserted
replaced
94303:e0b01f455de0 | 94304:bc48ced5cf89 |
---|---|
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 |
29 ;; - Make read-file-name-predicate obsolete. | |
29 ;; - New command minibuffer-force-complete that chooses one of all-completions. | 30 ;; - New command minibuffer-force-complete that chooses one of all-completions. |
30 ;; - Add vc-file-name-completion-table to read-file-name-internal. | 31 ;; - Add vc-file-name-completion-table to read-file-name-internal. |
31 ;; - A feature like completing-help.el. | 32 ;; - A feature like completing-help.el. |
32 ;; - Make the `hide-spaces' arg of all-completions obsolete? | 33 ;; - Make the `hide-spaces' arg of all-completions obsolete? |
33 | 34 |
237 the second failed attempt to complete." | 238 the second failed attempt to complete." |
238 :type '(choice (const nil) (const t) (const lazy)) | 239 :type '(choice (const nil) (const t) (const lazy)) |
239 :group 'minibuffer) | 240 :group 'minibuffer) |
240 | 241 |
241 (defvar completion-styles-alist | 242 (defvar completion-styles-alist |
242 '((basic try-completion all-completions) | 243 '((basic completion-basic-try-completion completion-basic-all-completions) |
244 (emacs22 completion-emacs22-try-completion completion-emacs22-all-completions) | |
245 (emacs21 completion-emacs21-try-completion completion-emacs21-all-completions) | |
243 ;; (partial-completion | 246 ;; (partial-completion |
244 ;; completion-pcm--try-completion completion-pcm--all-completions) | 247 ;; completion-pcm--try-completion completion-pcm--all-completions) |
245 ) | 248 ) |
246 "List of available completion styles. | 249 "List of available completion styles. |
247 Each element has the form (NAME TRY-COMPLETION ALL-COMPLETIONS) | 250 Each element has the form (NAME TRY-COMPLETION ALL-COMPLETIONS) |
254 :type `(repeat (choice ,@(mapcar (lambda (x) (list 'const (car x))) | 257 :type `(repeat (choice ,@(mapcar (lambda (x) (list 'const (car x))) |
255 completion-styles-alist))) | 258 completion-styles-alist))) |
256 :group 'minibuffer | 259 :group 'minibuffer |
257 :version "23.1") | 260 :version "23.1") |
258 | 261 |
259 (defun completion-try-completion (string table pred) | 262 (defun completion-try-completion (string table pred point) |
263 "Try to complete STRING using completion table TABLE. | |
264 Only the elements of table that satisfy predicate PRED are considered. | |
265 POINT is the position of point within STRING. | |
266 The return value can be either nil to indicate that there is no completion, | |
267 t to indicate that STRING is the only possible completion, | |
268 or a pair (STRING . NEWPOINT) of the completed result string together with | |
269 a new position for point." | |
260 ;; The property `completion-styles' indicates that this functional | 270 ;; The property `completion-styles' indicates that this functional |
261 ;; completion-table claims to take care of completion styles itself. | 271 ;; completion-table claims to take care of completion styles itself. |
262 ;; [I.e. It will most likely call us back at some point. ] | 272 ;; [I.e. It will most likely call us back at some point. ] |
263 (if (and (symbolp table) (get table 'completion-styles)) | 273 (if (and (symbolp table) (get table 'completion-styles)) |
264 (funcall table string pred nil) | 274 ;; Extended semantics for functional completion-tables: |
275 ;; They accept a 4th argument `point' and when called with action=nil | |
276 ;; and this 4th argument (a position inside `string'), they should | |
277 ;; return instead of a string a pair (STRING . NEWPOINT). | |
278 (funcall table string pred nil point) | |
265 (completion--some (lambda (style) | 279 (completion--some (lambda (style) |
266 (funcall (nth 1 (assq style completion-styles-alist)) | 280 (funcall (nth 1 (assq style completion-styles-alist)) |
267 string table pred)) | 281 string table pred point)) |
268 completion-styles))) | 282 completion-styles))) |
269 | 283 |
270 (defun completion-all-completions (string table pred) | 284 (defun completion-all-completions (string table pred point) |
285 "List the possible completions of STRING in completion table TABLE. | |
286 Only the elements of table that satisfy predicate PRED are considered. | |
287 POINT is the position of point within STRING. | |
288 The return value is a list of completions and may contain the BASE-SIZE | |
289 in the last `cdr'." | |
271 ;; The property `completion-styles' indicates that this functional | 290 ;; The property `completion-styles' indicates that this functional |
272 ;; completion-table claims to take care of completion styles itself. | 291 ;; completion-table claims to take care of completion styles itself. |
273 ;; [I.e. It will most likely call us back at some point. ] | 292 ;; [I.e. It will most likely call us back at some point. ] |
274 (let ((completion-all-completions-with-base-size t)) | 293 (let ((completion-all-completions-with-base-size t)) |
275 (if (and (symbolp table) (get table 'no-completion-styles)) | 294 (if (and (symbolp table) (get table 'completion-styles)) |
276 (funcall table string pred t) | 295 ;; Extended semantics for functional completion-tables: |
296 ;; They accept a 4th argument `point' and when called with action=t | |
297 ;; and this 4th argument (a position inside `string'), they may | |
298 ;; return BASE-SIZE in the last `cdr'. | |
299 (funcall table string pred t point) | |
277 (completion--some (lambda (style) | 300 (completion--some (lambda (style) |
278 (funcall (nth 2 (assq style completion-styles-alist)) | 301 (funcall (nth 2 (assq style completion-styles-alist)) |
279 string table pred)) | 302 string table pred point)) |
280 completion-styles)))) | 303 completion-styles)))) |
281 | 304 |
282 (defun minibuffer--bitset (modified completions exact) | 305 (defun minibuffer--bitset (modified completions exact) |
283 (logior (if modified 4 0) | 306 (logior (if modified 4 0) |
284 (if completions 2 0) | 307 (if completions 2 0) |
298 100 4 ??? impossible | 321 100 4 ??? impossible |
299 101 5 ??? impossible | 322 101 5 ??? impossible |
300 110 6 some completion happened | 323 110 6 some completion happened |
301 111 7 completed to an exact completion" | 324 111 7 completed to an exact completion" |
302 (let* ((beg (field-beginning)) | 325 (let* ((beg (field-beginning)) |
303 (end (point)) | 326 (end (field-end)) |
304 (string (buffer-substring beg end)) | 327 (string (buffer-substring beg end)) |
305 (completion (funcall (or try-completion-function | 328 (comp (funcall (or try-completion-function |
306 'completion-try-completion) | 329 'completion-try-completion) |
307 string | 330 string |
308 minibuffer-completion-table | 331 minibuffer-completion-table |
309 minibuffer-completion-predicate))) | 332 minibuffer-completion-predicate |
333 (- (point) beg)))) | |
310 (cond | 334 (cond |
311 ((null completion) | 335 ((null comp) |
312 (ding) (minibuffer-message "No match") (minibuffer--bitset nil nil nil)) | 336 (ding) (minibuffer-message "No match") (minibuffer--bitset nil nil nil)) |
313 ((eq t completion) (minibuffer--bitset nil nil t)) ;Exact and unique match. | 337 ((eq t comp) (minibuffer--bitset nil nil t)) ;Exact and unique match. |
314 (t | 338 (t |
315 ;; `completed' should be t if some completion was done, which doesn't | 339 ;; `completed' should be t if some completion was done, which doesn't |
316 ;; include simply changing the case of the entered string. However, | 340 ;; include simply changing the case of the entered string. However, |
317 ;; for appearance, the string is rewritten if the case changes. | 341 ;; for appearance, the string is rewritten if the case changes. |
318 (let ((completed (not (eq t (compare-strings completion nil nil | 342 (let* ((comp-pos (cdr comp)) |
319 string nil nil t)))) | 343 (completion (car comp)) |
344 (completed (not (eq t (compare-strings completion nil nil | |
345 string nil nil t)))) | |
320 (unchanged (eq t (compare-strings completion nil nil | 346 (unchanged (eq t (compare-strings completion nil nil |
321 string nil nil nil)))) | 347 string nil nil nil)))) |
322 (unless unchanged | 348 (unless unchanged |
323 | 349 |
324 ;; Insert in minibuffer the chars we got. | 350 ;; Insert in minibuffer the chars we got. |
325 (goto-char end) | 351 (goto-char end) |
326 (insert completion) | 352 (insert completion) |
327 (delete-region beg end)) | 353 (delete-region beg end) |
354 (goto-char (+ beg comp-pos))) | |
328 | 355 |
329 (if (not (or unchanged completed)) | 356 (if (not (or unchanged completed)) |
330 ;; The case of the string changed, but that's all. We're not sure | 357 ;; The case of the string changed, but that's all. We're not sure |
331 ;; whether this is a unique completion or not, so try again using | 358 ;; whether this is a unique completion or not, so try again using |
332 ;; the real case (this shouldn't recurse again, because the next | 359 ;; the real case (this shouldn't recurse again, because the next |
333 ;; time try-completion will return either t or the exact string). | 360 ;; time try-completion will return either t or the exact string). |
334 (completion--do-completion try-completion-function) | 361 (completion--do-completion try-completion-function) |
335 | 362 |
336 ;; It did find a match. Do we match some possibility exactly now? | 363 ;; It did find a match. Do we match some possibility exactly now? |
337 (let ((exact (test-completion (field-string) | 364 (let ((exact (test-completion completion |
338 minibuffer-completion-table | 365 minibuffer-completion-table |
339 minibuffer-completion-predicate))) | 366 minibuffer-completion-predicate))) |
340 (unless completed | 367 (unless completed |
341 ;; Show the completion table, if requested. | 368 ;; Show the completion table, if requested. |
342 (cond | 369 (cond |
435 (exit-minibuffer) | 462 (exit-minibuffer) |
436 (minibuffer-message "Confirm") | 463 (minibuffer-message "Confirm") |
437 nil)) | 464 nil)) |
438 (t nil)))))) | 465 (t nil)))))) |
439 | 466 |
440 (defun completion--try-word-completion (string table predicate) | 467 (defun completion--try-word-completion (string table predicate point) |
441 (let ((completion (completion-try-completion string table predicate))) | 468 (let ((comp (completion-try-completion string table predicate point))) |
442 (if (not (stringp completion)) | 469 (if (not (consp comp)) |
443 completion | 470 comp |
444 | 471 |
445 ;; If completion finds next char not unique, | 472 ;; If completion finds next char not unique, |
446 ;; consider adding a space or a hyphen. | 473 ;; consider adding a space or a hyphen. |
447 (when (= (length string) (length completion)) | 474 (when (= (length string) (length (car comp))) |
448 (let ((exts '(" " "-")) | 475 (let ((exts '(" " "-")) |
449 tem) | 476 (before (substring string 0 point)) |
450 (while (and exts (not (stringp tem))) | 477 (after (substring string point)) |
478 tem) | |
479 (while (and exts (not (consp tem))) | |
451 (setq tem (completion-try-completion | 480 (setq tem (completion-try-completion |
452 (concat string (pop exts)) | 481 (concat before (pop exts) after) |
453 table predicate))) | 482 table predicate (1+ point)))) |
454 (if (stringp tem) (setq completion tem)))) | 483 (if (consp tem) (setq comp tem)))) |
455 | 484 |
456 ;; Completing a single word is actually more difficult than completing | 485 ;; Completing a single word is actually more difficult than completing |
457 ;; as much as possible, because we first have to find the "current | 486 ;; as much as possible, because we first have to find the "current |
458 ;; position" in `completion' in order to find the end of the word | 487 ;; position" in `completion' in order to find the end of the word |
459 ;; we're completing. Normally, `string' is a prefix of `completion', | 488 ;; we're completing. Normally, `string' is a prefix of `completion', |
460 ;; which makes it trivial to find the position, but with fancier | 489 ;; which makes it trivial to find the position, but with fancier |
461 ;; completion (plus env-var expansion, ...) `completion' might not | 490 ;; completion (plus env-var expansion, ...) `completion' might not |
462 ;; look anything like `string' at all. | 491 ;; look anything like `string' at all. |
463 | 492 (let* ((comppoint (cdr comp)) |
464 (when minibuffer-completing-file-name | 493 (completion (car comp)) |
465 ;; In order to minimize the problem mentioned above, let's try to | 494 (before (substring string 0 point)) |
466 ;; reduce the different between `string' and `completion' by | 495 (combined (concat before "\n" completion))) |
467 ;; mirroring some of the work done in read-file-name-internal. | 496 ;; Find in completion the longest text that was right before point. |
468 (let ((substituted (condition-case nil | 497 (when (string-match "\\(.+\\)\n.*?\\1" combined) |
469 ;; Might fail when completing an env-var. | 498 (let* ((prefix (match-string 1 before)) |
470 (substitute-in-file-name string) | 499 ;; We used non-greedy match to make `rem' as long as possible. |
471 (error string)))) | 500 (rem (substring combined (match-end 0))) |
472 (unless (eq string substituted) | 501 ;; Find in the remainder of completion the longest text |
473 (setq string substituted)))) | 502 ;; that was right after point. |
474 | 503 (after (substring string point)) |
475 ;; Make buffer (before point) contain the longest match | 504 (suffix (if (string-match "\\`\\(.+\\).*\n.*\\1" |
476 ;; of `string's tail and `completion's head. | 505 (concat after "\n" rem)) |
477 (let* ((startpos (max 0 (- (length string) (length completion)))) | 506 (match-string 1 after)))) |
478 (length (- (length string) startpos))) | 507 ;; The general idea is to try and guess what text was inserted |
479 (while (and (> length 0) | 508 ;; at point by the completion. Problem is: if we guess wrong, |
480 (not (eq t (compare-strings string startpos nil | 509 ;; we may end up treating as "added by completion" text that was |
481 completion 0 length | 510 ;; actually painfully typed by the user. So if we then cut |
482 completion-ignore-case)))) | 511 ;; after the first word, we may throw away things the |
483 (setq startpos (1+ startpos)) | 512 ;; user wrote. So let's try to be as conservative as possible: |
484 (setq length (1- length))) | 513 ;; only cut after the first word, if we're reasonably sure that |
485 | 514 ;; our guess is correct. |
486 (setq string (substring string startpos))) | 515 ;; Note: a quick survey on emacs-devel seemed to indicate that |
487 | 516 ;; nobody actually cares about the "word-at-a-time" feature of |
488 ;; Now `string' is a prefix of `completion'. | 517 ;; minibuffer-complete-word, whose real raison-d'ĂȘtre is that it |
489 | 518 ;; tries to add "-" or " ". One more reason to only cut after |
490 ;; Otherwise cut after the first word. | 519 ;; the first word, if we're really sure we're right. |
491 (if (string-match "\\W" completion (length string)) | 520 (when (and (or suffix (zerop (length after))) |
492 ;; First find first word-break in the stuff found by completion. | 521 (string-match (concat |
493 ;; i gets index in string of where to stop completing. | 522 ;; Make submatch 1 as small as possible |
494 (substring completion 0 (match-end 0)) | 523 ;; to reduce the risk of cutting |
495 completion)))) | 524 ;; valuable text. |
525 ".*" (regexp-quote prefix) "\\(.*?\\)" | |
526 (if suffix (regexp-quote suffix) "\\'")) | |
527 completion) | |
528 ;; The new point in `completion' should also be just | |
529 ;; before the suffix, otherwise something more complex | |
530 ;; is going on, and we're not sure where we are. | |
531 (eq (match-end 1) comppoint) | |
532 ;; (match-beginning 1)..comppoint is now the stretch | |
533 ;; of text in `completion' that was completed at point. | |
534 (string-match "\\W" completion (match-beginning 1)) | |
535 ;; Is there really something to cut? | |
536 (> comppoint (match-end 0))) | |
537 ;; Cut after the first word. | |
538 (let ((cutpos (match-end 0))) | |
539 (setq completion (concat (substring completion 0 cutpos) | |
540 (substring completion comppoint))) | |
541 (setq comppoint cutpos))))) | |
542 | |
543 (cons completion comppoint))))) | |
496 | 544 |
497 | 545 |
498 (defun minibuffer-complete-word () | 546 (defun minibuffer-complete-word () |
499 "Complete the minibuffer contents at most a single word. | 547 "Complete the minibuffer contents at most a single word. |
500 After one word is completed as much as possible, a space or hyphen | 548 After one word is completed as much as possible, a space or hyphen |
622 (message "Making completion list...") | 670 (message "Making completion list...") |
623 (let* ((string (field-string)) | 671 (let* ((string (field-string)) |
624 (completions (completion-all-completions | 672 (completions (completion-all-completions |
625 string | 673 string |
626 minibuffer-completion-table | 674 minibuffer-completion-table |
627 minibuffer-completion-predicate))) | 675 minibuffer-completion-predicate |
676 (- (point) (field-beginning))))) | |
628 (message nil) | 677 (message nil) |
629 (if (and completions | 678 (if (and completions |
630 (or (consp (cdr completions)) | 679 (or (consp (cdr completions)) |
631 (not (equal (car completions) string)))) | 680 (not (equal (car completions) string)))) |
632 (with-output-to-temp-buffer "*Completions*" | 681 (with-output-to-temp-buffer "*Completions*" |
926 'internal-complete-buffer | 975 'internal-complete-buffer |
927 (lambda (name) | 976 (lambda (name) |
928 (not (equal (if (consp name) (car name) name) except))) | 977 (not (equal (if (consp name) (car name) name) except))) |
929 nil))) | 978 nil))) |
930 | 979 |
980 ;;; Old-style completion, used in Emacs-21. | |
981 | |
982 (defun completion-emacs21-try-completion (string table pred point) | |
983 (let ((completion (try-completion string table pred))) | |
984 (if (stringp completion) | |
985 (cons completion (length completion)) | |
986 completion))) | |
987 | |
988 (defun completion-emacs21-all-completions (string table pred point) | |
989 (all-completions string table pred t)) | |
990 | |
991 ;;; Basic completion, used in Emacs-22. | |
992 | |
993 (defun completion-emacs22-try-completion (string table pred point) | |
994 (let ((suffix (substring string point)) | |
995 (completion (try-completion (substring string 0 point) table pred))) | |
996 (if (not (stringp completion)) | |
997 completion | |
998 ;; Merge a trailing / in completion with a / after point. | |
999 ;; We used to only do it for word completion, but it seems to make | |
1000 ;; sense for all completions. | |
1001 (if (and (eq ?/ (aref completion (1- (length completion)))) | |
1002 (not (zerop (length suffix))) | |
1003 (eq ?/ (aref suffix 0))) | |
1004 ;; This leaves point before the / . | |
1005 ;; Should we maybe put it after the / ? --Stef | |
1006 (setq completion (substring completion 0 -1))) | |
1007 (cons (concat completion suffix) (length completion))))) | |
1008 | |
1009 (defun completion-emacs22-all-completions (string table pred point) | |
1010 (all-completions (substring string 0 point) table pred t)) | |
1011 | |
1012 (defalias 'completion-basic-try-completion 'completion-emacs22-try-completion) | |
1013 (defalias 'completion-basic-all-completions 'completion-emacs22-all-completions) | |
1014 | |
931 (provide 'minibuffer) | 1015 (provide 'minibuffer) |
932 | 1016 |
933 ;; arch-tag: ef8a0a15-1080-4790-a754-04017c02f08f | 1017 ;; arch-tag: ef8a0a15-1080-4790-a754-04017c02f08f |
934 ;;; minibuffer.el ends here | 1018 ;;; minibuffer.el ends here |