Mercurial > emacs
comparison lisp/files.el @ 104841:02b4657a3268
(locate-file-completion-table): Make it provide boundary
information, so partial-completion works better.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Fri, 04 Sep 2009 03:18:08 +0000 |
| parents | 2362371c57c2 |
| children | ea5c49fab49a |
comparison
equal
deleted
inserted
replaced
| 104840:b255a4a2d4f5 | 104841:02b4657a3268 |
|---|---|
| 714 (if (memq 'readable predicate) 4 0)))) | 714 (if (memq 'readable predicate) 4 0)))) |
| 715 (locate-file-internal filename path suffixes predicate)) | 715 (locate-file-internal filename path suffixes predicate)) |
| 716 | 716 |
| 717 (defun locate-file-completion-table (dirs suffixes string pred action) | 717 (defun locate-file-completion-table (dirs suffixes string pred action) |
| 718 "Do completion for file names passed to `locate-file'." | 718 "Do completion for file names passed to `locate-file'." |
| 719 (if (file-name-absolute-p string) | 719 (cond |
| 720 (let ((read-file-name-predicate pred)) | 720 ((file-name-absolute-p string) |
| 721 (read-file-name-internal string nil action)) | 721 (let ((read-file-name-predicate pred)) |
| 722 (read-file-name-internal string nil action))) | |
| 723 ((eq (car-safe action) 'boundaries) | |
| 724 (let ((suffix (cdr action))) | |
| 725 (list* 'boundaries | |
| 726 (length (file-name-directory string)) | |
| 727 (let ((x (file-name-directory suffix))) | |
| 728 (if x (1- (length x)) (length suffix)))))) | |
| 729 (t | |
| 722 (let ((names nil) | 730 (let ((names nil) |
| 723 (suffix (concat (regexp-opt suffixes t) "\\'")) | 731 (suffix (concat (regexp-opt suffixes t) "\\'")) |
| 724 (string-dir (file-name-directory string))) | 732 (string-dir (file-name-directory string)) |
| 733 (string-file (file-name-nondirectory string))) | |
| 725 (dolist (dir dirs) | 734 (dolist (dir dirs) |
| 726 (unless dir | 735 (unless dir |
| 727 (setq dir default-directory)) | 736 (setq dir default-directory)) |
| 728 (if string-dir (setq dir (expand-file-name string-dir dir))) | 737 (if string-dir (setq dir (expand-file-name string-dir dir))) |
| 729 (when (file-directory-p dir) | 738 (when (file-directory-p dir) |
| 730 (dolist (file (file-name-all-completions | 739 (dolist (file (file-name-all-completions |
| 731 (file-name-nondirectory string) dir)) | 740 string-file dir)) |
| 732 (add-to-list 'names (if string-dir (concat string-dir file) file)) | 741 (push file names) |
| 733 (when (string-match suffix file) | 742 (when (string-match suffix file) |
| 734 (setq file (substring file 0 (match-beginning 0))) | 743 (setq file (substring file 0 (match-beginning 0))) |
| 735 (push (if string-dir (concat string-dir file) file) names))))) | 744 (push file names))))) |
| 736 (complete-with-action action names string pred)))) | 745 (completion-table-with-context |
| 746 string-dir names string-file pred action))))) | |
| 737 | 747 |
| 738 (defun locate-file-completion (string path-and-suffixes action) | 748 (defun locate-file-completion (string path-and-suffixes action) |
| 739 "Do completion for file names passed to `locate-file'. | 749 "Do completion for file names passed to `locate-file'. |
| 740 PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)." | 750 PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)." |
| 741 (locate-file-completion-table (car path-and-suffixes) | 751 (locate-file-completion-table (car path-and-suffixes) |