mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-02-08 20:58:58 +00:00
Code Issues Releases Activity

(file-relative-name): Expand both args before

Browse Source 
checking for device mismatch.

(file-relative-name): Handle differing drive letters on Microsoft systems.
This commit is contained in:
Richard M. Stallman 1997-04-11 01:47:41 +00:00
parent f2b7eb2618
commit 2d6562a572
1 changed files with 21 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
lisp/files.el
View File

@ -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.