Commit e8dab975 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

* 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.
parent 25c0d999
2008-04-19 Stefan Monnier <monnier@iro.umontreal.ca> 2008-04-19 Stefan Monnier <monnier@iro.umontreal.ca>
   
* 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'. * minibuffer.el (completion-table-with-context): Add support for `pred'.
(completion-table-with-terminator): Don't use complete-with-action (completion-table-with-terminator): Don't use complete-with-action
since we have to distinguish all three cases anyway. since we have to distinguish all three cases anyway.
......
...@@ -197,8 +197,8 @@ TYPE should be nil to find a function, or `defvar' to find a variable." ...@@ -197,8 +197,8 @@ TYPE should be nil to find a function, or `defvar' to find a variable."
(defun find-library (library) (defun find-library (library)
"Find the elisp source of LIBRARY." "Find the elisp source of LIBRARY."
(interactive (interactive
(let* ((path (cons (or find-function-source-path load-path) (let* ((dirs (or find-function-source-path load-path))
(find-library-suffixes))) (suffixes (find-library-suffixes))
(def (if (eq (function-called-at-point) 'require) (def (if (eq (function-called-at-point) 'require)
;; `function-called-at-point' may return 'require ;; `function-called-at-point' may return 'require
;; with `point' anywhere on this line. So wrap the ;; 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,11 +213,15 @@ TYPE should be nil to find a function, or `defvar' to find a variable."
(error nil)) (error nil))
(thing-at-point 'symbol)))) (thing-at-point 'symbol))))
(when def (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 (list
(completing-read (if def (format "Library name (default %s): " def) (completing-read (if def (format "Library name (default %s): " def)
"Library name: ") "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)))) (let ((buf (find-file-noselect (find-library-name library))))
(condition-case nil (switch-to-buffer buf) (error (pop-to-buffer buf))))) (condition-case nil (switch-to-buffer buf) (error (pop-to-buffer buf)))))
......
...@@ -701,15 +701,15 @@ one or more of those symbols." ...@@ -701,15 +701,15 @@ one or more of those symbols."
(if (memq 'readable predicate) 4 0)))) (if (memq 'readable predicate) 4 0))))
(locate-file-internal filename path suffixes predicate)) (locate-file-internal filename path suffixes predicate))
(defun locate-file-completion (string path-and-suffixes action) (defun locate-file-completion-table (dirs suffixes string pred action)
"Do completion for file names passed to `locate-file'. "Do completion for file names passed to `locate-file'."
PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
(if (file-name-absolute-p string) (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) (let ((names nil)
(suffix (concat (regexp-opt (cdr path-and-suffixes) t) "\\'")) (suffix (concat (regexp-opt suffixes t) "\\'"))
(string-dir (file-name-directory string))) (string-dir (file-name-directory string)))
(dolist (dir (car path-and-suffixes)) (dolist (dir dirs)
(unless dir (unless dir
(setq dir default-directory)) (setq dir default-directory))
(if string-dir (setq dir (expand-file-name string-dir dir))) (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,10 +720,15 @@ PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
(when (string-match suffix file) (when (string-match suffix file)
(setq file (substring file 0 (match-beginning 0))) (setq file (substring file 0 (match-beginning 0)))
(push (if string-dir (concat string-dir file) file) names))))) (push (if string-dir (concat string-dir file) file) names)))))
(cond (complete-with-action action names string pred))))
((eq action t) (all-completions string names))
((null action) (try-completion string names)) (defun locate-file-completion (string path-and-suffixes action)
(t (test-completion string names)))))) "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) (defun locate-dominating-file (file regexp)
"Look up the directory hierarchy from FILE for a file matching 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'." ...@@ -763,8 +768,9 @@ Return nil if COMMAND is not found anywhere in `exec-path'."
This is an interface to the function `load'." This is an interface to the function `load'."
(interactive (interactive
(list (completing-read "Load library: " (list (completing-read "Load library: "
'locate-file-completion (apply-partially 'locate-file-completion-table
(cons load-path (get-load-suffixes))))) load-path
(get-load-suffixes)))))
(load library)) (load library))
(defun file-remote-p (file &optional identification connected) (defun file-remote-p (file &optional identification connected)
......
...@@ -449,7 +449,7 @@ Do the right thing if the file has been compressed or zipped." ...@@ -449,7 +449,7 @@ Do the right thing if the file has been compressed or zipped."
(if decoder (if decoder
(progn (progn
(insert-file-contents-literally fullname visit) (insert-file-contents-literally fullname visit)
(let ((buffer-read-only nil) (let ((inhibit-read-only t)
(coding-system-for-write 'no-conversion) (coding-system-for-write 'no-conversion)
(default-directory (or (file-name-directory fullname) (default-directory (or (file-name-directory fullname)
default-directory))) default-directory)))
...@@ -756,8 +756,7 @@ FOUND-ANCHOR is non-nil if a `Ref:' was matched, POS is the position ...@@ -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 where the match was found, and MODE is `major-mode' of the buffer in
which the match was found." which the match was found."
(let ((case-fold-search case-fold)) (let ((case-fold-search case-fold))
(save-excursion (with-current-buffer (marker-buffer marker)
(set-buffer (marker-buffer marker))
(goto-char marker) (goto-char marker)
;; Search tag table ;; Search tag table
...@@ -826,7 +825,7 @@ a case-insensitive match is tried." ...@@ -826,7 +825,7 @@ a case-insensitive match is tried."
;; Switch files if necessary ;; Switch files if necessary
(or (null filename) (or (null filename)
(equal Info-current-file filename) (equal Info-current-file filename)
(let ((buffer-read-only nil)) (let ((inhibit-read-only t))
(setq Info-current-file nil (setq Info-current-file nil
Info-current-subfile nil Info-current-subfile nil
Info-current-file-completions nil Info-current-file-completions nil
...@@ -880,8 +879,7 @@ a case-insensitive match is tried." ...@@ -880,8 +879,7 @@ a case-insensitive match is tried."
(or Info-tag-table-buffer (or Info-tag-table-buffer
(generate-new-buffer " *info tag table*")))) (generate-new-buffer " *info tag table*"))))
(setq Info-tag-table-buffer tagbuf) (setq Info-tag-table-buffer tagbuf)
(save-excursion (with-current-buffer tagbuf
(set-buffer tagbuf)
(buffer-disable-undo (current-buffer)) (buffer-disable-undo (current-buffer))
(setq case-fold-search t) (setq case-fold-search t)
(erase-buffer) (erase-buffer)
...@@ -1059,10 +1057,9 @@ a case-insensitive match is tried." ...@@ -1059,10 +1057,9 @@ a case-insensitive match is tried."
(cons (directory-file-name truename) (cons (directory-file-name truename)
dirs-done))) dirs-done)))
(if attrs (if attrs
(save-excursion (with-current-buffer (generate-new-buffer " info dir")
(or buffers (or buffers
(message "Composing main Info directory...")) (message "Composing main Info directory..."))
(set-buffer (generate-new-buffer " info dir"))
(condition-case nil (condition-case nil
(progn (progn
(insert-file-contents file) (insert-file-contents file)
...@@ -1237,8 +1234,7 @@ a case-insensitive match is tried." ...@@ -1237,8 +1234,7 @@ a case-insensitive match is tried."
(let (lastfilepos (let (lastfilepos
lastfilename) lastfilename)
(if (numberp nodepos) (if (numberp nodepos)
(save-excursion (with-current-buffer (marker-buffer Info-tag-table-marker)
(set-buffer (marker-buffer Info-tag-table-marker))
(goto-char (point-min)) (goto-char (point-min))
(or (looking-at "\^_") (or (looking-at "\^_")
(search-forward "\n\^_")) (search-forward "\n\^_"))
...@@ -1264,7 +1260,7 @@ a case-insensitive match is tried." ...@@ -1264,7 +1260,7 @@ a case-insensitive match is tried."
;; Assume previous buffer is in Info-mode. ;; Assume previous buffer is in Info-mode.
;; (set-buffer (get-buffer "*info*")) ;; (set-buffer (get-buffer "*info*"))
(or (equal Info-current-subfile lastfilename) (or (equal Info-current-subfile lastfilename)
(let ((buffer-read-only nil)) (let ((inhibit-read-only t))
(setq buffer-file-name nil) (setq buffer-file-name nil)
(widen) (widen)
(erase-buffer) (erase-buffer)
...@@ -1469,17 +1465,15 @@ If FORK is a string, it is the name to use for the new 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) (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. "Virtual completion table for file names input in Info node names.
PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)." PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
(let* ((names nil) (setq suffixes (remove "" suffixes))
(suffixes (remove "" (cdr path-and-suffixes))) (when (file-name-absolute-p string)
(suffix (concat (regexp-opt suffixes t) "\\'")) (setq dirs (list (file-name-directory string))))
(string-dir (file-name-directory string)) (let ((names nil)
(dirs (suffix (concat (regexp-opt suffixes t) "\\'"))
(if (file-name-absolute-p string) (string-dir (file-name-directory string)))
(list (file-name-directory string))
(car path-and-suffixes))))
(dolist (dir dirs) (dolist (dir dirs)
(unless dir (unless dir
(setq dir default-directory)) (setq dir default-directory))
...@@ -1501,10 +1495,7 @@ PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)." ...@@ -1501,10 +1495,7 @@ PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
(when (string-match suffix file) (when (string-match suffix file)
(setq file (substring file 0 (match-beginning 0))) (setq file (substring file 0 (match-beginning 0)))
(push (if string-dir (concat string-dir file) file) names))))) (push (if string-dir (concat string-dir file) file) names)))))
(cond (complete-with-action action names string pred)))
((eq action t) (all-completions string names))
((null action) (try-completion string names))
(t (test-completion string names)))))
;; This function is used as the "completion table" while reading a node name. ;; 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 ;; 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,11 +1506,12 @@ PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
((string-match "\\`([^)]*\\'" string) ((string-match "\\`([^)]*\\'" string)
(completion-table-with-context (completion-table-with-context
"(" "("
(apply-partially 'completion-table-with-terminator (apply-partially 'completion-table-with-terminator ")"
")" 'Info-read-node-name-2) (apply-partially 'Info-read-node-name-2
Info-directory-list
(mapcar 'car Info-suffix-list)))
(substring string 1) (substring string 1)
(cons Info-directory-list predicate
(mapcar 'car Info-suffix-list))
code)) code))
;; If a file name was given, then any node is fair game. ;; 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,8 +1674,7 @@ If DIRECTION is `backward', search in the reverse direction."
(unwind-protect (unwind-protect
;; Try other subfiles. ;; Try other subfiles.
(let ((list ())) (let ((list ()))
(save-excursion (with-current-buffer (marker-buffer Info-tag-table-marker)
(set-buffer (marker-buffer Info-tag-table-marker))
(goto-char (point-min)) (goto-char (point-min))
(search-forward "\n\^_\nIndirect:") (search-forward "\n\^_\nIndirect:")
(save-restriction (save-restriction
...@@ -2271,8 +2262,7 @@ Because of ambiguities, this should be concatenated with something like ...@@ -2271,8 +2262,7 @@ Because of ambiguities, this should be concatenated with something like
;; Note that `Info-complete-menu-buffer' could be current already, ;; Note that `Info-complete-menu-buffer' could be current already,
;; so we want to save point. ;; so we want to save point.
(save-excursion (with-current-buffer Info-complete-menu-buffer
(set-buffer Info-complete-menu-buffer)
(let ((completion-ignore-case t) (let ((completion-ignore-case t)
(case-fold-search t) (case-fold-search t)
(orignode Info-current-node) (orignode Info-current-node)
...@@ -4219,9 +4209,8 @@ INDENT is the current indentation depth." ...@@ -4219,9 +4209,8 @@ INDENT is the current indentation depth."
(defun Info-speedbar-fetch-file-nodes (nodespec) (defun Info-speedbar-fetch-file-nodes (nodespec)
"Fetch the subnodes from the info NODESPEC. "Fetch the subnodes from the info NODESPEC.
NODESPEC is a string of the form: (file)node." NODESPEC is a string of the form: (file)node."
(save-excursion ;; Set up a buffer we can use to fake-out Info.
;; Set up a buffer we can use to fake-out Info. (with-current-buffer (get-buffer-create " *info-browse-tmp*")
(set-buffer (get-buffer-create " *info-browse-tmp*"))
(if (not (equal major-mode 'Info-mode)) (if (not (equal major-mode 'Info-mode))
(Info-mode)) (Info-mode))
;; Get the node into this buffer ;; Get the node into this buffer
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment