diff options
| author | Stefan Monnier | 2011-10-11 01:17:04 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2011-10-11 01:17:04 -0400 |
| commit | af7b60780c53288370c658deb9f79f281991990e (patch) | |
| tree | a65012cad2987fc532c1f1376842f775e7af9718 | |
| parent | 9ac13c31364bd011cc19cabc1715c679be9f8ada (diff) | |
| download | emacs-af7b60780c53288370c658deb9f79f281991990e.tar.gz emacs-af7b60780c53288370c658deb9f79f281991990e.zip | |
* lisp/minibuffer.el (completion-file-name-table): Fix last change,
i.e. ignore normal errors but not the other ones.
| -rw-r--r-- | lisp/ChangeLog | 5 | ||||
| -rw-r--r-- | lisp/minibuffer.el | 103 |
2 files changed, 57 insertions, 51 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ec68012d520..17ea3c29686 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,8 @@ | |||
| 1 | 2011-10-11 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * minibuffer.el (completion-file-name-table): Fix last change, | ||
| 4 | i.e. ignore normal errors but not the other ones. | ||
| 5 | |||
| 1 | 2011-10-10 Martin Rudalics <rudalics@gmx.at> | 6 | 2011-10-10 Martin Rudalics <rudalics@gmx.at> |
| 2 | 7 | ||
| 3 | * window.el (special-display-buffer-names) | 8 | * window.el (special-display-buffer-names) |
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index e2ed07f1ef1..acb71d115d1 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el | |||
| @@ -1789,59 +1789,60 @@ same as `substitute-in-file-name'." | |||
| 1789 | 1789 | ||
| 1790 | (defun completion-file-name-table (string pred action) | 1790 | (defun completion-file-name-table (string pred action) |
| 1791 | "Completion table for file names." | 1791 | "Completion table for file names." |
| 1792 | (with-demoted-errors | 1792 | (condition-case nil |
| 1793 | (cond | 1793 | (cond |
| 1794 | ((eq action 'metadata) '(metadata (category . file))) | 1794 | ((eq action 'metadata) '(metadata (category . file))) |
| 1795 | ((eq (car-safe action) 'boundaries) | 1795 | ((eq (car-safe action) 'boundaries) |
| 1796 | (let ((start (length (file-name-directory string))) | 1796 | (let ((start (length (file-name-directory string))) |
| 1797 | (end (string-match-p "/" (cdr action)))) | 1797 | (end (string-match-p "/" (cdr action)))) |
| 1798 | (list* 'boundaries | 1798 | (list* 'boundaries |
| 1799 | ;; if `string' is "C:" in w32, (file-name-directory string) | 1799 | ;; if `string' is "C:" in w32, (file-name-directory string) |
| 1800 | ;; returns "C:/", so `start' is 3 rather than 2. | 1800 | ;; returns "C:/", so `start' is 3 rather than 2. |
| 1801 | ;; Not quite sure what is The Right Fix, but clipping it | 1801 | ;; Not quite sure what is The Right Fix, but clipping it |
| 1802 | ;; back to 2 will work for this particular case. We'll | 1802 | ;; back to 2 will work for this particular case. We'll |
| 1803 | ;; see if we can come up with a better fix when we bump | 1803 | ;; see if we can come up with a better fix when we bump |
| 1804 | ;; into more such problematic cases. | 1804 | ;; into more such problematic cases. |
| 1805 | (min start (length string)) end))) | 1805 | (min start (length string)) end))) |
| 1806 | |||
| 1807 | ((eq action 'lambda) | ||
| 1808 | (if (zerop (length string)) | ||
| 1809 | nil ;Not sure why it's here, but it probably doesn't harm. | ||
| 1810 | (funcall (or pred 'file-exists-p) string))) | ||
| 1811 | 1806 | ||
| 1812 | (t | 1807 | ((eq action 'lambda) |
| 1813 | (let* ((name (file-name-nondirectory string)) | 1808 | (if (zerop (length string)) |
| 1814 | (specdir (file-name-directory string)) | 1809 | nil ;Not sure why it's here, but it probably doesn't harm. |
| 1815 | (realdir (or specdir default-directory))) | 1810 | (funcall (or pred 'file-exists-p) string))) |
| 1816 | 1811 | ||
| 1817 | (cond | 1812 | (t |
| 1818 | ((null action) | 1813 | (let* ((name (file-name-nondirectory string)) |
| 1819 | (let ((comp (file-name-completion name realdir pred))) | 1814 | (specdir (file-name-directory string)) |
| 1820 | (if (stringp comp) | 1815 | (realdir (or specdir default-directory))) |
| 1821 | (concat specdir comp) | 1816 | |
| 1822 | comp))) | 1817 | (cond |
| 1823 | 1818 | ((null action) | |
| 1824 | ((eq action t) | 1819 | (let ((comp (file-name-completion name realdir pred))) |
| 1825 | (let ((all (file-name-all-completions name realdir))) | 1820 | (if (stringp comp) |
| 1826 | 1821 | (concat specdir comp) | |
| 1827 | ;; Check the predicate, if necessary. | 1822 | comp))) |
| 1828 | (unless (memq pred '(nil file-exists-p)) | 1823 | |
| 1829 | (let ((comp ()) | 1824 | ((eq action t) |
| 1830 | (pred | 1825 | (let ((all (file-name-all-completions name realdir))) |
| 1831 | (if (eq pred 'file-directory-p) | 1826 | |
| 1832 | ;; Brute-force speed up for directory checking: | 1827 | ;; Check the predicate, if necessary. |
| 1833 | ;; Discard strings which don't end in a slash. | 1828 | (unless (memq pred '(nil file-exists-p)) |
| 1834 | (lambda (s) | 1829 | (let ((comp ()) |
| 1835 | (let ((len (length s))) | 1830 | (pred |
| 1836 | (and (> len 0) (eq (aref s (1- len)) ?/)))) | 1831 | (if (eq pred 'file-directory-p) |
| 1837 | ;; Must do it the hard (and slow) way. | 1832 | ;; Brute-force speed up for directory checking: |
| 1838 | pred))) | 1833 | ;; Discard strings which don't end in a slash. |
| 1839 | (let ((default-directory (expand-file-name realdir))) | 1834 | (lambda (s) |
| 1840 | (dolist (tem all) | 1835 | (let ((len (length s))) |
| 1841 | (if (funcall pred tem) (push tem comp)))) | 1836 | (and (> len 0) (eq (aref s (1- len)) ?/)))) |
| 1842 | (setq all (nreverse comp)))) | 1837 | ;; Must do it the hard (and slow) way. |
| 1843 | 1838 | pred))) | |
| 1844 | all)))))))) | 1839 | (let ((default-directory (expand-file-name realdir))) |
| 1840 | (dolist (tem all) | ||
| 1841 | (if (funcall pred tem) (push tem comp)))) | ||
| 1842 | (setq all (nreverse comp)))) | ||
| 1843 | |||
| 1844 | all)))))) | ||
| 1845 | (file-error nil))) ;PCM often calls with invalid directories. | ||
| 1845 | 1846 | ||
| 1846 | (defvar read-file-name-predicate nil | 1847 | (defvar read-file-name-predicate nil |
| 1847 | "Current predicate used by `read-file-name-internal'.") | 1848 | "Current predicate used by `read-file-name-internal'.") |