diff options
author | Richard M. Stallman <rms@gnu.org> | 1997-04-11 01:47:41 +0000 |
---|---|---|
committer | Richard M. Stallman <rms@gnu.org> | 1997-04-11 01:47:41 +0000 |
commit | a7256dfdf02b9c304ef7913cd089d225aefdae63 (patch) | |
tree | 916cb13380f9e727f78275a5588b88423f45fa9a | |
parent | 2abb79a10bbd310968bc0c0ec06d2a37414dff32 (diff) | |
download | emacs-a7256dfdf02b9c304ef7913cd089d225aefdae63.tar.gz |
(file-relative-name): Expand both args before
checking for device mismatch.
(file-relative-name): Handle differing drive letters on Microsoft systems.
-rw-r--r-- | lisp/files.el | 30 |
1 files changed, 21 insertions, 9 deletions
diff --git a/lisp/files.el b/lisp/files.el index 6d36275e365..a54d258190f 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1864,16 +1864,28 @@ If the value is nil, don't make a backup." (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. |