From e8dab975990b1e7bcab9263d02c60d1fb51397ad Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 19 Apr 2008 03:33:13 +0000 Subject: [PATCH] * files.el (locate-file-completion-table): Rename from locate-file-completion and make it use `pred' in the normal way. (locate-file-completion): New compatibility wrapper. (load-library): Use locate-file-completion-table. * emacs-lisp/find-func.el (find-library): Likewise. * info.el: Use with-current-buffer and inhibit-read-only. (Info-read-node-name-2): Change to use `predicate' in the normal way. (Info-read-node-name-1): Adjust uses accordingly. --- lisp/ChangeLog | 9 ++++++ lisp/emacs-lisp/find-func.el | 12 +++++--- lisp/files.el | 30 ++++++++++-------- 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 @@ 2008-04-19 Stefan Monnier + * files.el (locate-file-completion-table): Rename from + locate-file-completion and make it use `pred' in the normal way. + (locate-file-completion): New compatibility wrapper. + (load-library): Use locate-file-completion-table. + * emacs-lisp/find-func.el (find-library): Likewise. + * info.el: Use with-current-buffer and inhibit-read-only. + (Info-read-node-name-2): Change to use `predicate' in the normal way. + (Info-read-node-name-1): Adjust uses accordingly. + * minibuffer.el (completion-table-with-context): Add support for `pred'. (completion-table-with-terminator): Don't use complete-with-action 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." (defun find-library (library) "Find the elisp source of LIBRARY." (interactive - (let* ((path (cons (or find-function-source-path load-path) - (find-library-suffixes))) + (let* ((dirs (or find-function-source-path load-path)) + (suffixes (find-library-suffixes)) (def (if (eq (function-called-at-point) 'require) ;; `function-called-at-point' may return 'require ;; 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." (error nil)) (thing-at-point 'symbol)))) (when def - (setq def (and (locate-file-completion def path 'test) def))) + (setq def (and (locate-file-completion-table + dirs suffixes def nil 'lambda) + def))) (list (completing-read (if def (format "Library name (default %s): " def) "Library name: ") - 'locate-file-completion path nil nil nil def)))) + (apply-partially 'locate-file-completion-table + dirs suffixes) + nil nil nil nil def)))) (let ((buf (find-file-noselect (find-library-name library)))) (condition-case nil (switch-to-buffer buf) (error (pop-to-buffer buf))))) 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." (if (memq 'readable predicate) 4 0)))) (locate-file-internal filename path suffixes predicate)) -(defun locate-file-completion (string path-and-suffixes action) - "Do completion for file names passed to `locate-file'. -PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)." +(defun locate-file-completion-table (dirs suffixes string pred action) + "Do completion for file names passed to `locate-file'." (if (file-name-absolute-p string) - (read-file-name-internal string nil action) + (let ((read-file-name-predicate pred)) + (read-file-name-internal string nil action)) (let ((names nil) - (suffix (concat (regexp-opt (cdr path-and-suffixes) t) "\\'")) + (suffix (concat (regexp-opt suffixes t) "\\'")) (string-dir (file-name-directory string))) - (dolist (dir (car path-and-suffixes)) + (dolist (dir dirs) (unless dir (setq dir default-directory)) (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)." (when (string-match suffix file) (setq file (substring file 0 (match-beginning 0))) (push (if string-dir (concat string-dir file) file) names))))) - (cond - ((eq action t) (all-completions string names)) - ((null action) (try-completion string names)) - (t (test-completion string names)))))) + (complete-with-action action names string pred)))) + +(defun locate-file-completion (string path-and-suffixes action) + "Do completion for file names passed to `locate-file'. +PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)." + (locate-file-completion-table (car path-and-suffixes) + (cdr path-and-suffixes) + string nil action)) +(make-obsolete 'locate-file-completion 'locate-file-completion-table "23.1") (defun locate-dominating-file (file regexp) "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'." This is an interface to the function `load'." (interactive (list (completing-read "Load library: " - 'locate-file-completion - (cons load-path (get-load-suffixes))))) + (apply-partially 'locate-file-completion-table + load-path + (get-load-suffixes))))) (load library)) (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." (if decoder (progn (insert-file-contents-literally fullname visit) - (let ((buffer-read-only nil) + (let ((inhibit-read-only t) (coding-system-for-write 'no-conversion) (default-directory (or (file-name-directory fullname) default-directory))) @@ -756,8 +756,7 @@ FOUND-ANCHOR is non-nil if a `Ref:' was matched, POS is the position where the match was found, and MODE is `major-mode' of the buffer in which the match was found." (let ((case-fold-search case-fold)) - (save-excursion - (set-buffer (marker-buffer marker)) + (with-current-buffer (marker-buffer marker) (goto-char marker) ;; Search tag table @@ -826,7 +825,7 @@ a case-insensitive match is tried." ;; Switch files if necessary (or (null filename) (equal Info-current-file filename) - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (setq Info-current-file nil Info-current-subfile nil Info-current-file-completions nil @@ -880,8 +879,7 @@ a case-insensitive match is tried." (or Info-tag-table-buffer (generate-new-buffer " *info tag table*")))) (setq Info-tag-table-buffer tagbuf) - (save-excursion - (set-buffer tagbuf) + (with-current-buffer tagbuf (buffer-disable-undo (current-buffer)) (setq case-fold-search t) (erase-buffer) @@ -1059,10 +1057,9 @@ a case-insensitive match is tried." (cons (directory-file-name truename) dirs-done))) (if attrs - (save-excursion + (with-current-buffer (generate-new-buffer " info dir") (or buffers (message "Composing main Info directory...")) - (set-buffer (generate-new-buffer " info dir")) (condition-case nil (progn (insert-file-contents file) @@ -1237,8 +1234,7 @@ a case-insensitive match is tried." (let (lastfilepos lastfilename) (if (numberp nodepos) - (save-excursion - (set-buffer (marker-buffer Info-tag-table-marker)) + (with-current-buffer (marker-buffer Info-tag-table-marker) (goto-char (point-min)) (or (looking-at "\^_") (search-forward "\n\^_")) @@ -1264,7 +1260,7 @@ a case-insensitive match is tried." ;; Assume previous buffer is in Info-mode. ;; (set-buffer (get-buffer "*info*")) (or (equal Info-current-subfile lastfilename) - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (setq buffer-file-name nil) (widen) (erase-buffer) @@ -1469,17 +1465,15 @@ If FORK is a string, it is the name to use for the new buffer." (defvar Info-read-node-completion-table) -(defun Info-read-node-name-2 (string path-and-suffixes action) +(defun Info-read-node-name-2 (dirs suffixes string pred action) "Virtual completion table for file names input in Info node names. PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)." - (let* ((names nil) - (suffixes (remove "" (cdr path-and-suffixes))) - (suffix (concat (regexp-opt suffixes t) "\\'")) - (string-dir (file-name-directory string)) - (dirs - (if (file-name-absolute-p string) - (list (file-name-directory string)) - (car path-and-suffixes)))) + (setq suffixes (remove "" suffixes)) + (when (file-name-absolute-p string) + (setq dirs (list (file-name-directory string)))) + (let ((names nil) + (suffix (concat (regexp-opt suffixes t) "\\'")) + (string-dir (file-name-directory string))) (dolist (dir dirs) (unless dir (setq dir default-directory)) @@ -1501,10 +1495,7 @@ PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)." (when (string-match suffix file) (setq file (substring file 0 (match-beginning 0))) (push (if string-dir (concat string-dir file) file) names))))) - (cond - ((eq action t) (all-completions string names)) - ((null action) (try-completion string names)) - (t (test-completion string names))))) + (complete-with-action action names string pred))) ;; This function is used as the "completion table" while reading a node name. ;; 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)." ((string-match "\\`([^)]*\\'" string) (completion-table-with-context "(" - (apply-partially 'completion-table-with-terminator - ")" 'Info-read-node-name-2) + (apply-partially 'completion-table-with-terminator ")" + (apply-partially 'Info-read-node-name-2 + Info-directory-list + (mapcar 'car Info-suffix-list))) (substring string 1) - (cons Info-directory-list - (mapcar 'car Info-suffix-list)) + predicate code)) ;; 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." (unwind-protect ;; Try other subfiles. (let ((list ())) - (save-excursion - (set-buffer (marker-buffer Info-tag-table-marker)) + (with-current-buffer (marker-buffer Info-tag-table-marker) (goto-char (point-min)) (search-forward "\n\^_\nIndirect:") (save-restriction @@ -2271,8 +2262,7 @@ Because of ambiguities, this should be concatenated with something like ;; Note that `Info-complete-menu-buffer' could be current already, ;; so we want to save point. - (save-excursion - (set-buffer Info-complete-menu-buffer) + (with-current-buffer Info-complete-menu-buffer (let ((completion-ignore-case t) (case-fold-search t) (orignode Info-current-node) @@ -4219,9 +4209,8 @@ INDENT is the current indentation depth." (defun Info-speedbar-fetch-file-nodes (nodespec) "Fetch the subnodes from the info NODESPEC. NODESPEC is a string of the form: (file)node." - (save-excursion - ;; Set up a buffer we can use to fake-out Info. - (set-buffer (get-buffer-create " *info-browse-tmp*")) + ;; Set up a buffer we can use to fake-out Info. + (with-current-buffer (get-buffer-create " *info-browse-tmp*") (if (not (equal major-mode 'Info-mode)) (Info-mode)) ;; Get the node into this buffer -- 2.39.5