entered into RCS

[bpt/emacs.git] / lisp / files.el

diff --git a/lisp/files.el b/lisp/files.el
index 9fd2052..31ce9ac 100644 (file)
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -251,14 +251,7 @@ This is an interface to the function `load'."
   "Copy the file FILE into a temporary file on this machine.
 Returns the name of the local copy, or nil, if FILE is directly
 accessible."
-  (let (handler (handlers file-name-handler-alist))
-    (save-match-data
-     (while (and (consp handlers) (null handler))
-       (if (and (consp (car handlers))
-               (stringp (car (car handlers)))
-               (string-match (car (car handlers)) file))
-          (setq handler (cdr (car handlers))))
-       (setq handlers (cdr handlers))))
+  (let ((handler (find-file-name-handler file)))
     (if handler
        (funcall handler 'file-local-copy file)
       nil)))
@@ -270,14 +263,7 @@ both at the level of the file and at the level of the directories
 containing it, until no links are left at any level."
   (if (string= filename "~")
       (setq filename (expand-file-name filename)))
-  (let (handler (handlers file-name-handler-alist))
-    (save-match-data
-     (while (and (consp handlers) (null handler))
-       (if (and (consp (car handlers))
-               (stringp (car (car handlers)))
-               (string-match (car (car handlers)) filename))
-          (setq handler (cdr (car handlers))))
-       (setq handlers (cdr handlers))))
+  (let ((handler (find-file-name-handler filename)))
     ;; For file name that has a special handler, call handler.
     ;; This is so that ange-ftp can save time by doing a no-op.
     (if handler
@@ -299,6 +285,7 @@ containing it, until no links are left at any level."
            (file-truename (expand-file-name target dir))
          ;; No, we are done!
          filename)))))
+
 \f
 (defun switch-to-buffer-other-window (buffer)
   "Select buffer BUFFER in another window."
@@ -408,6 +395,9 @@ Choose the buffer's name using `generate-new-buffer-name'."
 (defconst automount-dir-prefix "^/tmp_mnt/"
   "Regexp to match the automounter prefix in a directory name.")
 
+(defvar abbreviated-home-dir nil
+  "The the user's homedir abbreviated according to `directory-abbrev-list'.")
+
 (defun abbreviate-file-name (filename)
   "Return a version of FILENAME shortened using `directory-abbrev-alist'.
 This also substitutes \"~\" for the user's home directory.
@@ -418,12 +408,23 @@ Type \\[describe-variable] directory-abbrev-alist RET for more information."
                           (substring filename (1- (match-end 0))))))
       (setq filename (substring filename (1- (match-end 0)))))
   (let ((tail directory-abbrev-alist))
+    ;; If any elt of directory-abbrev-alist matches this name,
+    ;; abbreviate accordingly.
     (while tail
       (if (string-match (car (car tail)) filename)
          (setq filename
                (concat (cdr (car tail)) (substring filename (match-end 0)))))
       (setq tail (cdr tail)))
-    (if (string-match (concat "^" (expand-file-name "~")) filename)
+    ;; Compute and save the abbreviated homedir name.
+    ;; We defer computing this until the first time it's needed, to
+    ;; give time for directory-abbrev-alist to be set properly.
+    (or abbreviated-home-dir
+       (setq abbreviated-home-dir
+             (let ((abbreviated-home-dir "$foo"))
+               (concat "^" (abbreviate-file-name (expand-file-name "~"))))))
+    ;; If FILENAME starts with the abbreviated homedir,
+    ;; make it start with `~' instead.
+    (if (string-match abbreviated-home-dir filename)
        (setq filename
              (concat "~" (substring filename (match-end 0)))))
     filename))
@@ -1037,14 +1038,7 @@ This is a separate procedure so your site-init or startup file can
 redefine it.
 If the optional argument KEEP-BACKUP-VERSION is non-nil,
 we do not remove backup version numbers, only true file version numbers."
-  (let (handler (handlers file-name-handler-alist))
-    (save-match-data
-     (while (and (consp handlers) (null handler))
-       (if (and (consp (car handlers))
-               (stringp (car (car handlers)))
-               (string-match (car (car handlers)) name))
-          (setq handler (cdr (car handlers))))
-       (setq handlers (cdr handlers))))
+  (let ((handler (find-file-name-handler name)))
     (if handler
        (funcall handler 'file-name-sans-versions name keep-backup-version)
       (substring name 0
@@ -1407,14 +1401,7 @@ or multiple mail buffers, etc."
 (defun make-directory (dir &optional parents)
   "Create the directory DIR and any nonexistent parent dirs."
   (interactive "FMake directory: \nP")
-  (let (handler (handlers file-name-handler-alist))
-    (save-match-data
-     (while (and (consp handlers) (null handler))
-       (if (and (consp (car handlers))
-               (stringp (car (car handlers)))
-               (string-match (car (car handlers)) file))
-          (setq handler (cdr (car handlers))))
-       (setq handlers (cdr handlers))))
+  (let ((handler (find-file-name-handler dir)))
     (if handler
        (funcall handler 'make-directory dir parents)
       (if (not parents)
@@ -1655,14 +1642,7 @@ switches do not contain `d', so that a full listing is expected.
 This works by running a directory listing program
 whose name is in the variable `ls-program'.
 If WILDCARD, it also runs the shell specified by `shell-file-name'."
-  (let (handler (handlers file-name-handler-alist))
-    (save-match-data
-     (while (and (consp handlers) (null handler))
-       (if (and (consp (car handlers))
-               (stringp (car (car handlers)))
-               (string-match (car (car handlers)) file))
-          (setq handler (cdr (car handlers))))
-       (setq handlers (cdr handlers))))
+  (let ((handler (find-file-name-handler file)))
     (if handler
        (funcall handler 'insert-directory file switches
                 wildcard full-directory-p)