diff options
| author | Richard M. Stallman | 1997-04-11 01:47:41 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1997-04-11 01:47:41 +0000 |
| commit | 2d6562a5725abceef2be246e92cf2316210610e0 (patch) | |
| tree | f62ce28ffc0c01f563a48f7fb2a774baf2fc6814 | |
| parent | f2b7eb26180057ac40455175e782ef92e1059795 (diff) | |
| download | emacs-2d6562a5725abceef2be246e92cf2316210610e0.tar.gz emacs-2d6562a5725abceef2be246e92cf2316210610e0.zip | |
(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." | |||
| 1864 | (car (cdr (file-attributes filename)))) | 1864 | (car (cdr (file-attributes filename)))) |
| 1865 | 1865 | ||
| 1866 | (defun file-relative-name (filename &optional directory) | 1866 | (defun file-relative-name (filename &optional directory) |
| 1867 | "Convert FILENAME to be relative to DIRECTORY (default: default-directory)." | 1867 | "Convert FILENAME to be relative to DIRECTORY (default: default-directory). |
| 1868 | This function returns a relative file name which is equivalent to FILENAME | ||
| 1869 | when used with that default directory as the default. | ||
| 1870 | If this is impossible (which can happen on MSDOS and Windows | ||
| 1871 | when the file name and directory use different drive names) | ||
| 1872 | then it returns FILENAME." | ||
| 1868 | (save-match-data | 1873 | (save-match-data |
| 1869 | (setq filename (expand-file-name filename) | 1874 | (setq fname (expand-file-name filename) |
| 1870 | directory (file-name-as-directory | 1875 | directory (file-name-as-directory |
| 1871 | (expand-file-name (or directory default-directory)))) | 1876 | (expand-file-name (or directory default-directory)))) |
| 1872 | (let ((ancestor "")) | 1877 | ;; On Microsoft OSes, if FILENAME and DIRECTORY have different |
| 1873 | (while (not (string-match (concat "^" (regexp-quote directory)) filename)) | 1878 | ;; drive names, they can't be relative, so return the absolute name. |
| 1874 | (setq directory (file-name-directory (substring directory 0 -1)) | 1879 | (if (and (or (eq system-type 'ms-dos) |
| 1875 | ancestor (concat "../" ancestor))) | 1880 | (eq system-type 'windows-nt)) |
| 1876 | (concat ancestor (substring filename (match-end 0)))))) | 1881 | (not (string-equal (substring fname 0 2) |
| 1882 | (substring directory 0 2)))) | ||
| 1883 | filename | ||
| 1884 | (let ((ancestor "")) | ||
| 1885 | (while (not (string-match (concat "^" (regexp-quote directory)) fname)) | ||
| 1886 | (setq directory (file-name-directory (substring directory 0 -1)) | ||
| 1887 | ancestor (concat "../" ancestor))) | ||
| 1888 | (concat ancestor (substring fname (match-end 0))))))) | ||
| 1877 | 1889 | ||
| 1878 | (defun save-buffer (&optional args) | 1890 | (defun save-buffer (&optional args) |
| 1879 | "Save current buffer in visited file if modified. Versions described below. | 1891 | "Save current buffer in visited file if modified. Versions described below. |