Commit 9695aac6 authored by Richard M. Stallman's avatar Richard M. Stallman
Browse files

(file-chase-links): When handling .., make newname absolute.

Simplify several places.
(file-relative-name): Handle directory names as well as file names.
Don't get fooled by empty directory names, etc.
parent 9b51ba9e
...@@ -537,28 +537,27 @@ Does not examine containing directories for links, ...@@ -537,28 +537,27 @@ Does not examine containing directories for links,
unlike `file-truename'." unlike `file-truename'."
(let (tem (count 100) (newname filename)) (let (tem (count 100) (newname filename))
(while (setq tem (file-symlink-p newname)) (while (setq tem (file-symlink-p newname))
(if (= count 0) (save-match-data
(error "Apparent cycle of symbolic links for %s" filename)) (if (= count 0)
;; In the context of a link, `//' doesn't mean what Emacs thinks. (error "Apparent cycle of symbolic links for %s" filename))
(while (string-match "//+" tem) ;; In the context of a link, `//' doesn't mean what Emacs thinks.
(setq tem (concat (substring tem 0 (1+ (match-beginning 0))) (while (string-match "//+" tem)
(substring tem (match-end 0))))) (setq tem (replace-match "/" nil nil tem)))
;; Handle `..' by hand, since it needs to work in the ;; Handle `..' by hand, since it needs to work in the
;; target of any directory symlink. ;; target of any directory symlink.
;; This code is not quite complete; it does not handle ;; This code is not quite complete; it does not handle
;; embedded .. in some cases such as ./../foo and foo/bar/../../../lose. ;; embedded .. in some cases such as ./../foo and foo/bar/../../../lose.
(while (string-match "\\`\\.\\./" tem) (while (string-match "\\`\\.\\./" tem)
(setq tem (substring tem 3)) (setq tem (substring tem 3))
(setq newname (file-name-as-directory (setq newname (expand-file-name newname))
;; Do the .. by hand. ;; Chase links in the default dir of the symlink.
(directory-file-name (setq newname
(file-name-directory (file-chase-links
;; Chase links in the default dir of the symlink. (directory-file-name (file-name-directory newname))))
(file-chase-links ;; Now find the parent of that dir.
(directory-file-name (setq newname (file-name-directory newname)))
(file-name-directory newname)))))))) (setq newname (expand-file-name tem (file-name-directory newname)))
(setq newname (expand-file-name tem (file-name-directory newname))) (setq count (1- count))))
(setq count (1- count)))
newname)) newname))
(defun switch-to-buffer-other-window (buffer &optional norecord) (defun switch-to-buffer-other-window (buffer &optional norecord)
...@@ -1964,11 +1963,26 @@ then it returns FILENAME." ...@@ -1964,11 +1963,26 @@ then it returns FILENAME."
(not (string-equal (substring fname 0 2) (not (string-equal (substring fname 0 2)
(substring directory 0 2)))) (substring directory 0 2))))
filename filename
(let ((ancestor "")) (let ((ancestor ".")
(while (not (string-match (concat "^" (regexp-quote directory)) fname)) (fname-dir (file-name-as-directory fname)))
(while (and (not (string-match (concat "^" (regexp-quote directory)) fname-dir))
(not (string-match (concat "^" (regexp-quote directory)) fname)))
(setq directory (file-name-directory (substring directory 0 -1)) (setq directory (file-name-directory (substring directory 0 -1))
ancestor (concat "../" ancestor))) ancestor (if (equal ancestor ".")
(concat ancestor (substring fname (match-end 0)))))))) ".."
(concat "../" ancestor))))
;; Now ancestor is empty, or .., or ../.., etc.
(if (string-match (concat "^" (regexp-quote directory)) fname)
;; We matched within FNAME's directory part.
;; Add the rest of FNAME onto ANCESTOR.
(let ((rest (substring fname (match-end 0))))
(if (and (equal ancestor ".")
(not (equal rest "")))
;; But don't bother with ANCESTOR if it would give us `./'.
rest
(concat (file-name-as-directory ancestor) rest)))
;; We matched FNAME's directory equivalent.
ancestor))))))
(defun save-buffer (&optional args) (defun save-buffer (&optional args)
"Save current buffer in visited file if modified. Versions described below. "Save current buffer in visited file if modified. Versions described below.
......
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