(file-truename): Use iteration when possible.

Avoid recalculating the same truename twice in one invocation.
Error check for infinite link loop.

(debugger): Make it a risky-local-variable.

diff --git a/lisp/files.el b/lisp/files.el
index 66f3ac21721874c6b2c63e511e66a39617e383ce..5cf294ab54c18a9ed9ea7ded9ac233320bf8c1e1 100644 (file)
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -329,11 +329,18 @@ accessible."
        (funcall handler 'file-local-copy file)
       nil)))
 
-(defun file-truename (filename)
+(defun file-truename (filename &optional counter prev-dirs)
   "Return the truename of FILENAME, which should be absolute.
 The truename of a file name is found by chasing symbolic links
 both at the level of the file and at the level of the directories
-containing it, until no links are left at any level."
+containing it, until no links are left at any level.
+
+The arguments COUNTER and PREV-DIRS are used only in recursive calls.
+Do not specify them in other calls."
+  ;; COUNTER can be a cons cell whose car is the count of how many more links
+  ;; to chase before getting an error.
+  ;; PREV-DIRS can be a cons cell whose car is an alist
+  ;; of truenames we've just recently computed.
   (if (or (string= filename "~")
          (and (string= (substring filename 0 1) "~")
               (string-match "~[^/]*" filename)))
@@ -341,37 +348,60 @@ containing it, until no links are left at any level."
        (setq filename (expand-file-name filename))
        (if (string= filename "")
            (setq filename "/"))))
-  (let ((handler (find-file-name-handler filename 'file-truename)))
-    ;; 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
-       (funcall handler 'file-truename filename)
-      (let ((dir (file-name-directory filename))
-           target dirfile)
-       ;; Get the truename of the directory.
-       (setq dirfile (directory-file-name dir))
-       ;; If these are equal, we have the (or a) root directory.
-       (or (string= dir dirfile)
-           (setq dir (file-name-as-directory (file-truename dirfile))))
-       (if (equal ".." (file-name-nondirectory filename))
-           (directory-file-name (file-name-directory (directory-file-name dir)))
-         (if (equal "." (file-name-nondirectory filename))
-             (directory-file-name dir)
-           ;; Put it back on the file name.
-           (setq filename (concat dir (file-name-nondirectory filename)))
-           ;; Is the file name the name of a link?
-           (setq target (file-symlink-p filename))
-           (if target
-               ;; Yes => chase that link, then start all over
-               ;; since the link may point to a directory name that uses links.
-               ;; We can't safely use expand-file-name here
-               ;; since target might look like foo/../bar where foo
-               ;; is itself a link.  Instead, we handle . and .. above.
-               (if (file-name-absolute-p target)
-                   (file-truename target)
-                 (file-truename (concat dir target)))
-             ;; No, we are done!
-             filename)))))))
+  (or counter (setq counter (list 100)))
+  (or prev-dirs (setq prev-dirs (list nil)))
+  (let (done)
+    ;; If this file directly leads to a link, process that iteratively
+    ;; so that we don't use lots of stack.
+    (while (not done)
+      (setcar counter (1- (car counter)))
+      (if (< (car counter) 0)
+         (error "Apparent cycle of symbolic links for %s" filename))
+      (let ((handler (find-file-name-handler filename 'file-truename)))
+       ;; 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
+           (setq filename (funcall handler 'file-truename filename)
+                 done t)
+         (let ((dir (file-name-directory filename))
+               target dirfile)
+           ;; Get the truename of the directory.
+           (setq dirfile (directory-file-name dir))
+           ;; If these are equal, we have the (or a) root directory.
+           (or (string= dir dirfile)
+               ;; If this is the same dir we last got the truename for,
+               ;; save time--don't recalculate.
+               (if (assoc dir (car prev-dirs))
+                   (setq dir (cdr (assoc dir (car prev-dirs))))
+                 (let ((old dir)
+                       (new (file-name-as-directory (file-truename dirfile counter prev-dirs))))
+                   (setcar prev-dirs (cons (cons old new) (car prev-dirs)))
+                   (setq dir new))))
+           (if (equal ".." (file-name-nondirectory filename))
+               (setq filename
+                     (directory-file-name (file-name-directory (directory-file-name dir)))
+                     done t)
+             (if (equal "." (file-name-nondirectory filename))
+                 (setq filename (directory-file-name dir)
+                       done t)
+               ;; Put it back on the file name.
+               (setq filename (concat dir (file-name-nondirectory filename)))
+               ;; Is the file name the name of a link?
+               (setq target (file-symlink-p filename))
+               (if target
+                   ;; Yes => chase that link, then start all over
+                   ;; since the link may point to a directory name that uses links.
+                   ;; We can't safely use expand-file-name here
+                   ;; since target might look like foo/../bar where foo
+                   ;; is itself a link.  Instead, we handle . and .. above.
+                   (setq filename
+                         (if (file-name-absolute-p target)
+                             target
+                           (concat dir target))
+                         done nil)
+                 ;; No, we are done!
+                 (setq done t))))))))
+    filename))
 
 (defun file-chase-links (filename)
   "Chase links in FILENAME until a name that is not a link.
@@ -1105,6 +1135,7 @@ If `enable-local-variables' is nil, this function does not check for a
   "Variables to be ignored in a file's local variable spec.")
 
 ;; Get confirmation before setting these variables as locals in a file.
+(put 'debugger 'risky-local-variable t)
 (put 'enable-local-eval 'risky-local-variable t)
 (put 'eval 'risky-local-variable t)
 (put 'file-name-handler-alist 'risky-local-variable t)