Mercurial > emacs

changeset 17379:3147024a8918

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(file-relative-name): Expand both args before checking for device mismatch. (file-relative-name): Handle differing drive letters on Microsoft systems.
author Richard M. Stallman <rms@gnu.org>
date Fri, 11 Apr 1997 01:47:41 +0000
parents 30a3a2b1260a
children ba0844956fde
files lisp/files.el
diffstat 1 files changed, 21 insertions(+), 9 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/files.el	Fri Apr 11 01:37:50 1997 +0000
+++ b/lisp/files.el	Fri Apr 11 01:47:41 1997 +0000
@@ -1864,16 +1864,28 @@
   (car (cdr (file-attributes filename))))
 
 (defun file-relative-name (filename &optional directory)
-  "Convert FILENAME to be relative to DIRECTORY (default: default-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
-   (setq filename (expand-file-name filename)
-	 directory (file-name-as-directory
-		    (expand-file-name (or directory default-directory))))
-   (let ((ancestor ""))
-     (while (not (string-match (concat "^" (regexp-quote directory)) filename))
-       (setq directory (file-name-directory (substring directory 0 -1))
-	     ancestor (concat "../" ancestor)))
-     (concat ancestor (substring filename (match-end 0))))))
+    (setq fname (expand-file-name filename)
+	  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 'windows-nt))
+	     (not (string-equal (substring fname  0 2)
+				(substring directory 0 2))))
+	filename
+      (let ((ancestor ""))
+	(while (not (string-match (concat "^" (regexp-quote directory)) fname))
+	  (setq directory (file-name-directory (substring directory 0 -1))
+		ancestor (concat "../" ancestor)))
+	(concat ancestor (substring fname (match-end 0)))))))
 
 (defun save-buffer (&optional args)
   "Save current buffer in visited file if modified.  Versions described below.