diff options
| -rw-r--r-- | lisp/ChangeLog | 9 | ||||
| -rw-r--r-- | lisp/emacs-lisp/find-func.el | 12 | ||||
| -rw-r--r-- | lisp/files.el | 30 | ||||
| -rw-r--r-- | lisp/info.el | 59 |
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 @@ | |||
| 1 | 2008-04-19 Stefan Monnier <monnier@iro.umontreal.ca> | 1 | 2008-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'." |
| 706 | PATH-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'. |
| 727 | PATH-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'." | |||
| 763 | This is an interface to the function `load'." | 768 | This 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 | |||
| 756 | where the match was found, and MODE is `major-mode' of the buffer in | 756 | where the match was found, and MODE is `major-mode' of the buffer in |
| 757 | which the match was found." | 757 | which 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. |
| 1474 | PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)." | 1470 | PATH-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. |
| 4221 | NODESPEC is a string of the form: (file)node." | 4211 | NODESPEC 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 |