aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/ChangeLog9
-rw-r--r--lisp/emacs-lisp/find-func.el12
-rw-r--r--lisp/files.el30
-rw-r--r--lisp/info.el59
4 files changed, 59 insertions, 51 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 6c4b4a5db0a..9c8e8ccc16b 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,14 @@
12008-04-19 Stefan Monnier <monnier@iro.umontreal.ca> 12008-04-19 Stefan Monnier <monnier@iro.umontreal.ca>
2 2
3 * files.el (locate-file-completion-table): Rename from
4 locate-file-completion and make it use `pred' in the normal way.
5 (locate-file-completion): New compatibility wrapper.
6 (load-library): Use locate-file-completion-table.
7 * emacs-lisp/find-func.el (find-library): Likewise.
8 * info.el: Use with-current-buffer and inhibit-read-only.
9 (Info-read-node-name-2): Change to use `predicate' in the normal way.
10 (Info-read-node-name-1): Adjust uses accordingly.
11
3 * minibuffer.el (completion-table-with-context): Add support for `pred'. 12 * minibuffer.el (completion-table-with-context): Add support for `pred'.
4 (completion-table-with-terminator): Don't use complete-with-action 13 (completion-table-with-terminator): Don't use complete-with-action
5 since we have to distinguish all three cases anyway. 14 since we have to distinguish all three cases anyway.
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index 85f3fe941b7..2a1e659ad92 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -197,8 +197,8 @@ TYPE should be nil to find a function, or `defvar' to find a variable."
197(defun find-library (library) 197(defun find-library (library)
198 "Find the elisp source of LIBRARY." 198 "Find the elisp source of LIBRARY."
199 (interactive 199 (interactive
200 (let* ((path (cons (or find-function-source-path load-path) 200 (let* ((dirs (or find-function-source-path load-path))
201 (find-library-suffixes))) 201 (suffixes (find-library-suffixes))
202 (def (if (eq (function-called-at-point) 'require) 202 (def (if (eq (function-called-at-point) 'require)
203 ;; `function-called-at-point' may return 'require 203 ;; `function-called-at-point' may return 'require
204 ;; with `point' anywhere on this line. So wrap the 204 ;; with `point' anywhere on this line. So wrap the
@@ -213,11 +213,15 @@ TYPE should be nil to find a function, or `defvar' to find a variable."
213 (error nil)) 213 (error nil))
214 (thing-at-point 'symbol)))) 214 (thing-at-point 'symbol))))
215 (when def 215 (when def
216 (setq def (and (locate-file-completion def path 'test) def))) 216 (setq def (and (locate-file-completion-table
217 dirs suffixes def nil 'lambda)
218 def)))
217 (list 219 (list
218 (completing-read (if def (format "Library name (default %s): " def) 220 (completing-read (if def (format "Library name (default %s): " def)
219 "Library name: ") 221 "Library name: ")
220 'locate-file-completion path nil nil nil def)))) 222 (apply-partially 'locate-file-completion-table
223 dirs suffixes)
224 nil nil nil nil def))))
221 (let ((buf (find-file-noselect (find-library-name library)))) 225 (let ((buf (find-file-noselect (find-library-name library))))
222 (condition-case nil (switch-to-buffer buf) (error (pop-to-buffer buf))))) 226 (condition-case nil (switch-to-buffer buf) (error (pop-to-buffer buf)))))
223 227
diff --git a/lisp/files.el b/lisp/files.el
index 07b8a0688ff..8b0952dc382 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -701,15 +701,15 @@ one or more of those symbols."
701 (if (memq 'readable predicate) 4 0)))) 701 (if (memq 'readable predicate) 4 0))))
702 (locate-file-internal filename path suffixes predicate)) 702 (locate-file-internal filename path suffixes predicate))
703 703
704(defun locate-file-completion (string path-and-suffixes action) 704(defun locate-file-completion-table (dirs suffixes string pred action)
705 "Do completion for file names passed to `locate-file'. 705 "Do completion for file names passed to `locate-file'."
706PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
707 (if (file-name-absolute-p string) 706 (if (file-name-absolute-p string)
708 (read-file-name-internal string nil action) 707 (let ((read-file-name-predicate pred))
708 (read-file-name-internal string nil action))
709 (let ((names nil) 709 (let ((names nil)
710 (suffix (concat (regexp-opt (cdr path-and-suffixes) t) "\\'")) 710 (suffix (concat (regexp-opt suffixes t) "\\'"))
711 (string-dir (file-name-directory string))) 711 (string-dir (file-name-directory string)))
712 (dolist (dir (car path-and-suffixes)) 712 (dolist (dir dirs)
713 (unless dir 713 (unless dir
714 (setq dir default-directory)) 714 (setq dir default-directory))
715 (if string-dir (setq dir (expand-file-name string-dir dir))) 715 (if string-dir (setq dir (expand-file-name string-dir dir)))
@@ -720,10 +720,15 @@ PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
720 (when (string-match suffix file) 720 (when (string-match suffix file)
721 (setq file (substring file 0 (match-beginning 0))) 721 (setq file (substring file 0 (match-beginning 0)))
722 (push (if string-dir (concat string-dir file) file) names))))) 722 (push (if string-dir (concat string-dir file) file) names)))))
723 (cond 723 (complete-with-action action names string pred))))
724 ((eq action t) (all-completions string names)) 724
725 ((null action) (try-completion string names)) 725(defun locate-file-completion (string path-and-suffixes action)
726 (t (test-completion string names)))))) 726 "Do completion for file names passed to `locate-file'.
727PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
728 (locate-file-completion-table (car path-and-suffixes)
729 (cdr path-and-suffixes)
730 string nil action))
731(make-obsolete 'locate-file-completion 'locate-file-completion-table "23.1")
727 732
728(defun locate-dominating-file (file regexp) 733(defun locate-dominating-file (file regexp)
729 "Look up the directory hierarchy from FILE for a file matching REGEXP." 734 "Look up the directory hierarchy from FILE for a file matching REGEXP."
@@ -763,8 +768,9 @@ Return nil if COMMAND is not found anywhere in `exec-path'."
763This is an interface to the function `load'." 768This is an interface to the function `load'."
764 (interactive 769 (interactive
765 (list (completing-read "Load library: " 770 (list (completing-read "Load library: "
766 'locate-file-completion 771 (apply-partially 'locate-file-completion-table
767 (cons load-path (get-load-suffixes))))) 772 load-path
773 (get-load-suffixes)))))
768 (load library)) 774 (load library))
769 775
770(defun file-remote-p (file &optional identification connected) 776(defun file-remote-p (file &optional identification connected)
diff --git a/lisp/info.el b/lisp/info.el
index d0c505ba060..7d305c976ea 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -449,7 +449,7 @@ Do the right thing if the file has been compressed or zipped."
449 (if decoder 449 (if decoder
450 (progn 450 (progn
451 (insert-file-contents-literally fullname visit) 451 (insert-file-contents-literally fullname visit)
452 (let ((buffer-read-only nil) 452 (let ((inhibit-read-only t)
453 (coding-system-for-write 'no-conversion) 453 (coding-system-for-write 'no-conversion)
454 (default-directory (or (file-name-directory fullname) 454 (default-directory (or (file-name-directory fullname)
455 default-directory))) 455 default-directory)))
@@ -756,8 +756,7 @@ FOUND-ANCHOR is non-nil if a `Ref:' was matched, POS is the position
756where the match was found, and MODE is `major-mode' of the buffer in 756where the match was found, and MODE is `major-mode' of the buffer in
757which the match was found." 757which the match was found."
758 (let ((case-fold-search case-fold)) 758 (let ((case-fold-search case-fold))
759 (save-excursion 759 (with-current-buffer (marker-buffer marker)
760 (set-buffer (marker-buffer marker))
761 (goto-char marker) 760 (goto-char marker)
762 761
763 ;; Search tag table 762 ;; Search tag table
@@ -826,7 +825,7 @@ a case-insensitive match is tried."
826 ;; Switch files if necessary 825 ;; Switch files if necessary
827 (or (null filename) 826 (or (null filename)
828 (equal Info-current-file filename) 827 (equal Info-current-file filename)
829 (let ((buffer-read-only nil)) 828 (let ((inhibit-read-only t))
830 (setq Info-current-file nil 829 (setq Info-current-file nil
831 Info-current-subfile nil 830 Info-current-subfile nil
832 Info-current-file-completions nil 831 Info-current-file-completions nil
@@ -880,8 +879,7 @@ a case-insensitive match is tried."
880 (or Info-tag-table-buffer 879 (or Info-tag-table-buffer
881 (generate-new-buffer " *info tag table*")))) 880 (generate-new-buffer " *info tag table*"))))
882 (setq Info-tag-table-buffer tagbuf) 881 (setq Info-tag-table-buffer tagbuf)
883 (save-excursion 882 (with-current-buffer tagbuf
884 (set-buffer tagbuf)
885 (buffer-disable-undo (current-buffer)) 883 (buffer-disable-undo (current-buffer))
886 (setq case-fold-search t) 884 (setq case-fold-search t)
887 (erase-buffer) 885 (erase-buffer)
@@ -1059,10 +1057,9 @@ a case-insensitive match is tried."
1059 (cons (directory-file-name truename) 1057 (cons (directory-file-name truename)
1060 dirs-done))) 1058 dirs-done)))
1061 (if attrs 1059 (if attrs
1062 (save-excursion 1060 (with-current-buffer (generate-new-buffer " info dir")
1063 (or buffers 1061 (or buffers
1064 (message "Composing main Info directory...")) 1062 (message "Composing main Info directory..."))
1065 (set-buffer (generate-new-buffer " info dir"))
1066 (condition-case nil 1063 (condition-case nil
1067 (progn 1064 (progn
1068 (insert-file-contents file) 1065 (insert-file-contents file)
@@ -1237,8 +1234,7 @@ a case-insensitive match is tried."
1237 (let (lastfilepos 1234 (let (lastfilepos
1238 lastfilename) 1235 lastfilename)
1239 (if (numberp nodepos) 1236 (if (numberp nodepos)
1240 (save-excursion 1237 (with-current-buffer (marker-buffer Info-tag-table-marker)
1241 (set-buffer (marker-buffer Info-tag-table-marker))
1242 (goto-char (point-min)) 1238 (goto-char (point-min))
1243 (or (looking-at "\^_") 1239 (or (looking-at "\^_")
1244 (search-forward "\n\^_")) 1240 (search-forward "\n\^_"))
@@ -1264,7 +1260,7 @@ a case-insensitive match is tried."
1264 ;; Assume previous buffer is in Info-mode. 1260 ;; Assume previous buffer is in Info-mode.
1265 ;; (set-buffer (get-buffer "*info*")) 1261 ;; (set-buffer (get-buffer "*info*"))
1266 (or (equal Info-current-subfile lastfilename) 1262 (or (equal Info-current-subfile lastfilename)
1267 (let ((buffer-read-only nil)) 1263 (let ((inhibit-read-only t))
1268 (setq buffer-file-name nil) 1264 (setq buffer-file-name nil)
1269 (widen) 1265 (widen)
1270 (erase-buffer) 1266 (erase-buffer)
@@ -1469,17 +1465,15 @@ If FORK is a string, it is the name to use for the new buffer."
1469 1465
1470(defvar Info-read-node-completion-table) 1466(defvar Info-read-node-completion-table)
1471 1467
1472(defun Info-read-node-name-2 (string path-and-suffixes action) 1468(defun Info-read-node-name-2 (dirs suffixes string pred action)
1473 "Virtual completion table for file names input in Info node names. 1469 "Virtual completion table for file names input in Info node names.
1474PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)." 1470PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
1475 (let* ((names nil) 1471 (setq suffixes (remove "" suffixes))
1476 (suffixes (remove "" (cdr path-and-suffixes))) 1472 (when (file-name-absolute-p string)
1477 (suffix (concat (regexp-opt suffixes t) "\\'")) 1473 (setq dirs (list (file-name-directory string))))
1478 (string-dir (file-name-directory string)) 1474 (let ((names nil)
1479 (dirs 1475 (suffix (concat (regexp-opt suffixes t) "\\'"))
1480 (if (file-name-absolute-p string) 1476 (string-dir (file-name-directory string)))
1481 (list (file-name-directory string))
1482 (car path-and-suffixes))))
1483 (dolist (dir dirs) 1477 (dolist (dir dirs)
1484 (unless dir 1478 (unless dir
1485 (setq dir default-directory)) 1479 (setq dir default-directory))
@@ -1501,10 +1495,7 @@ PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
1501 (when (string-match suffix file) 1495 (when (string-match suffix file)
1502 (setq file (substring file 0 (match-beginning 0))) 1496 (setq file (substring file 0 (match-beginning 0)))
1503 (push (if string-dir (concat string-dir file) file) names))))) 1497 (push (if string-dir (concat string-dir file) file) names)))))
1504 (cond 1498 (complete-with-action action names string pred)))
1505 ((eq action t) (all-completions string names))
1506 ((null action) (try-completion string names))
1507 (t (test-completion string names)))))
1508 1499
1509;; This function is used as the "completion table" while reading a node name. 1500;; This function is used as the "completion table" while reading a node name.
1510;; It does completion using the alist in Info-read-node-completion-table 1501;; It does completion using the alist in Info-read-node-completion-table
@@ -1515,11 +1506,12 @@ PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
1515 ((string-match "\\`([^)]*\\'" string) 1506 ((string-match "\\`([^)]*\\'" string)
1516 (completion-table-with-context 1507 (completion-table-with-context
1517 "(" 1508 "("
1518 (apply-partially 'completion-table-with-terminator 1509 (apply-partially 'completion-table-with-terminator ")"
1519 ")" 'Info-read-node-name-2) 1510 (apply-partially 'Info-read-node-name-2
1511 Info-directory-list
1512 (mapcar 'car Info-suffix-list)))
1520 (substring string 1) 1513 (substring string 1)
1521 (cons Info-directory-list 1514 predicate
1522 (mapcar 'car Info-suffix-list))
1523 code)) 1515 code))
1524 1516
1525 ;; If a file name was given, then any node is fair game. 1517 ;; If a file name was given, then any node is fair game.
@@ -1682,8 +1674,7 @@ If DIRECTION is `backward', search in the reverse direction."
1682 (unwind-protect 1674 (unwind-protect
1683 ;; Try other subfiles. 1675 ;; Try other subfiles.
1684 (let ((list ())) 1676 (let ((list ()))
1685 (save-excursion 1677 (with-current-buffer (marker-buffer Info-tag-table-marker)
1686 (set-buffer (marker-buffer Info-tag-table-marker))
1687 (goto-char (point-min)) 1678 (goto-char (point-min))
1688 (search-forward "\n\^_\nIndirect:") 1679 (search-forward "\n\^_\nIndirect:")
1689 (save-restriction 1680 (save-restriction
@@ -2271,8 +2262,7 @@ Because of ambiguities, this should be concatenated with something like
2271 2262
2272 ;; Note that `Info-complete-menu-buffer' could be current already, 2263 ;; Note that `Info-complete-menu-buffer' could be current already,
2273 ;; so we want to save point. 2264 ;; so we want to save point.
2274 (save-excursion 2265 (with-current-buffer Info-complete-menu-buffer
2275 (set-buffer Info-complete-menu-buffer)
2276 (let ((completion-ignore-case t) 2266 (let ((completion-ignore-case t)
2277 (case-fold-search t) 2267 (case-fold-search t)
2278 (orignode Info-current-node) 2268 (orignode Info-current-node)
@@ -4219,9 +4209,8 @@ INDENT is the current indentation depth."
4219(defun Info-speedbar-fetch-file-nodes (nodespec) 4209(defun Info-speedbar-fetch-file-nodes (nodespec)
4220 "Fetch the subnodes from the info NODESPEC. 4210 "Fetch the subnodes from the info NODESPEC.
4221NODESPEC is a string of the form: (file)node." 4211NODESPEC is a string of the form: (file)node."
4222 (save-excursion 4212 ;; Set up a buffer we can use to fake-out Info.
4223 ;; Set up a buffer we can use to fake-out Info. 4213 (with-current-buffer (get-buffer-create " *info-browse-tmp*")
4224 (set-buffer (get-buffer-create " *info-browse-tmp*"))
4225 (if (not (equal major-mode 'Info-mode)) 4214 (if (not (equal major-mode 'Info-mode))
4226 (Info-mode)) 4215 (Info-mode))
4227 ;; Get the node into this buffer 4216 ;; Get the node into this buffer