aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2011-10-11 01:17:04 -0400
committerStefan Monnier2011-10-11 01:17:04 -0400
commitaf7b60780c53288370c658deb9f79f281991990e (patch)
treea65012cad2987fc532c1f1376842f775e7af9718
parent9ac13c31364bd011cc19cabc1715c679be9f8ada (diff)
downloademacs-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/ChangeLog5
-rw-r--r--lisp/minibuffer.el103
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 @@
12011-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
12011-10-10 Martin Rudalics <rudalics@gmx.at> 62011-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'.")