From 753ad988908d6178893e5647cc227621b0eee8a9 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Kai=20Gro=C3=9Fjohann?= Date: Sat, 29 Mar 2003 15:31:07 +0000 Subject: [PATCH] (file-relative-name): If FILENAME and DIRECTORY are on different drives (on DOS/Windows) or use different handlers, do like `expand-file-name' on FILENAME and return an absolute name. From Lars Hansen . --- lisp/ChangeLog | 5 +++ lisp/files.el | 120 ++++++++++++++++++++++++++++++++++++++----------- 2 files changed, 98 insertions(+), 27 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 492b33ed134..17f47abc20c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,10 @@ 2003-03-29 Kai Gro,A_(Bjohann + * files.el (file-relative-name): If FILENAME and DIRECTORY are on + different drives (on DOS/Windows) or use different handlers, do + like `expand-file-name' on FILENAME and return an absolute name. + From Lars Hansen . + * tramp.el: Version 2.0.31 released. (tramp-handle-expand-file-name): Do not allow ".." to cross file handler boundaries, so that "/user@host:/../foo" diff --git a/lisp/files.el b/lisp/files.el index 9216a6b2bf1..cb3da5717b9 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2781,45 +2781,111 @@ Uses `backup-directory-alist' in the same way as does "Return number of names file FILENAME has." (car (cdr (file-attributes filename)))) +;; (defun file-relative-name (filename &optional directory) +;; "Convert FILENAME to be relative to DIRECTORY (default: `default-directory'). +;; This function returns a relative file name which is equivalent to FILENAME +;; when used with that default directory as the default. +;; If this is impossible (which can happen on MSDOS and Windows +;; when the file name and directory use different drive names) +;; then it returns FILENAME." +;; (save-match-data +;; (let ((fname (expand-file-name filename))) +;; (setq directory (file-name-as-directory +;; (expand-file-name (or directory default-directory)))) +;; ;; On Microsoft OSes, if FILENAME and DIRECTORY have different +;; ;; drive names, they can't be relative, so return the absolute name. +;; (if (and (or (eq system-type 'ms-dos) +;; (eq system-type 'cygwin) +;; (eq system-type 'windows-nt)) +;; (not (string-equal (substring fname 0 2) +;; (substring directory 0 2)))) +;; filename +;; (let ((ancestor ".") +;; (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)) +;; ancestor (if (equal ancestor ".") +;; ".." +;; (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 file-relative-name (filename &optional directory) "Convert FILENAME to be relative to DIRECTORY (default: `default-directory'). This function returns a relative file name which is equivalent to FILENAME when used with that default directory as the default. -If this is impossible (which can happen on MSDOS and Windows -when the file name and directory use different drive names) -then it returns FILENAME." +If FILENAME and DIRECTORY lie on different machines or on different drives +\(DOS/Windows), it returns FILENAME in expanded form." (save-match-data - (let ((fname (expand-file-name filename))) - (setq directory (file-name-as-directory - (expand-file-name (or directory default-directory)))) - ;; On Microsoft OSes, if FILENAME and DIRECTORY have different - ;; drive names, they can't be relative, so return the absolute name. - (if (and (or (eq system-type 'ms-dos) - (eq system-type 'cygwin) - (eq system-type 'windows-nt)) - (not (string-equal (substring fname 0 2) - (substring directory 0 2)))) + (setq directory + (file-name-as-directory (expand-file-name (or directory + default-directory)))) + (setq filename (expand-file-name filename)) + (let ((hf (find-file-name-handler filename 'file-local-copy)) + (hd (find-file-name-handler directory 'file-local-copy))) + (when (and hf (not (get hf 'file-remote-p))) (setq hf nil)) + (when (and hd (not (get hd 'file-remote-p))) (setq hd nil)) + (if (and + ;; Conditions for separate trees + (or + ;; Test for different drives on DOS/Windows + (and + (memq system-type '(ms-dos cygwin windows-nt)) + (not (string-equal (substring filename 0 2) + (substring directory 0 2)))) + ;; Test for different remote file handlers + (not (eq hf hd)) + ;; Test for different remote file system identification + (and + hf + (let ((re (car (rassq hf file-name-handler-alist)))) + (not + (equal + (and + (string-match re filename) + (substring filename 0 (match-end 0))) + (and + (string-match re directory) + (substring directory 0 (match-end 0))))))))) filename - (let ((ancestor ".") - (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)) + (unless (eq (aref filename 0) ?/) + (setq filename (concat "/" filename))) + (unless (eq (aref directory 0) ?/) + (setq directory (concat "/" directory))) + (let ((ancestor ".") + (filename-dir (file-name-as-directory filename))) + (while + (and + (not (string-match (concat "^" (regexp-quote directory)) + filename-dir)) + (not (string-match (concat "^" (regexp-quote directory)) + filename))) + (setq directory (file-name-directory (substring directory 0 -1)) ancestor (if (equal ancestor ".") ".." (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 ""))) + ;; Now ancestor is empty, or .., or ../.., etc. + (if (string-match (concat "^" (regexp-quote directory)) filename) + ;; We matched within FILENAME's directory part. + ;; Add the rest of FILENAME onto ANCESTOR. + (let ((rest (substring filename (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)))))) + ;; We matched FILENAME's directory equivalent. + ancestor)))))) (defun save-buffer (&optional args) "Save current buffer in visited file if modified. Versions described below. -- 2.39.2