changeset 94181:959a3833d833

* 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.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Sat, 19 Apr 2008 03:33:13 +0000
parents 114d8f4904d0
children 0be1624297ac
files lisp/ChangeLog lisp/emacs-lisp/find-func.el lisp/files.el lisp/info.el
diffstat 4 files changed, 59 insertions(+), 51 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Sat Apr 19 03:23:15 2008 +0000
+++ b/lisp/ChangeLog	Sat Apr 19 03:33:13 2008 +0000
@@ -1,5 +1,14 @@
 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'.
 	(completion-table-with-terminator): Don't use complete-with-action
 	since we have to distinguish all three cases anyway.
--- a/lisp/emacs-lisp/find-func.el	Sat Apr 19 03:23:15 2008 +0000
+++ b/lisp/emacs-lisp/find-func.el	Sat Apr 19 03:33:13 2008 +0000
@@ -197,8 +197,8 @@
 (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 @@
 		     (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)))))
 
--- a/lisp/files.el	Sat Apr 19 03:23:15 2008 +0000
+++ b/lisp/files.el	Sat Apr 19 03:33:13 2008 +0000
@@ -701,15 +701,15 @@
 		  (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 @@
 	    (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 @@
 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)
--- a/lisp/info.el	Sat Apr 19 03:23:15 2008 +0000
+++ b/lisp/info.el	Sat Apr 19 03:33:13 2008 +0000
@@ -449,7 +449,7 @@
     (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 @@
 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 @@
         ;; 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 @@
                                (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 @@
 			    (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 @@
   (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 @@
     ;; 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 @@
 
 (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 @@
 	  (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 @@
    ((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 @@
 	(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 @@
 
   ;; 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 @@
 (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