(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 <larsh@math.ku.dk>.
This commit is contained in:
parent
b1a2b924ce
commit
753ad98890
2 changed files with 98 additions and 27 deletions
|
@ -1,5 +1,10 @@
|
||||||
2003-03-29 Kai Gro,A_(Bjohann <kai.grossjohann@gmx.net>
|
2003-03-29 Kai Gro,A_(Bjohann <kai.grossjohann@gmx.net>
|
||||||
|
|
||||||
|
* 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 <larsh@math.ku.dk>.
|
||||||
|
|
||||||
* tramp.el: Version 2.0.31 released.
|
* tramp.el: Version 2.0.31 released.
|
||||||
(tramp-handle-expand-file-name): Do not allow ".." to
|
(tramp-handle-expand-file-name): Do not allow ".." to
|
||||||
cross file handler boundaries, so that "/user@host:/../foo"
|
cross file handler boundaries, so that "/user@host:/../foo"
|
||||||
|
|
110
lisp/files.el
110
lisp/files.el
|
@ -2781,44 +2781,110 @@ Uses `backup-directory-alist' in the same way as does
|
||||||
"Return number of names file FILENAME has."
|
"Return number of names file FILENAME has."
|
||||||
(car (cdr (file-attributes filename))))
|
(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)
|
(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
|
This function returns a relative file name which is equivalent to FILENAME
|
||||||
when used with that default directory as the default.
|
when used with that default directory as the default.
|
||||||
If this is impossible (which can happen on MSDOS and Windows
|
If FILENAME and DIRECTORY lie on different machines or on different drives
|
||||||
when the file name and directory use different drive names)
|
\(DOS/Windows), it returns FILENAME in expanded form."
|
||||||
then it returns FILENAME."
|
|
||||||
(save-match-data
|
(save-match-data
|
||||||
(let ((fname (expand-file-name filename)))
|
(setq directory
|
||||||
(setq directory (file-name-as-directory
|
(file-name-as-directory (expand-file-name (or directory
|
||||||
(expand-file-name (or directory default-directory))))
|
default-directory))))
|
||||||
;; On Microsoft OSes, if FILENAME and DIRECTORY have different
|
(setq filename (expand-file-name filename))
|
||||||
;; drive names, they can't be relative, so return the absolute name.
|
(let ((hf (find-file-name-handler filename 'file-local-copy))
|
||||||
(if (and (or (eq system-type 'ms-dos)
|
(hd (find-file-name-handler directory 'file-local-copy)))
|
||||||
(eq system-type 'cygwin)
|
(when (and hf (not (get hf 'file-remote-p))) (setq hf nil))
|
||||||
(eq system-type 'windows-nt))
|
(when (and hd (not (get hd 'file-remote-p))) (setq hd nil))
|
||||||
(not (string-equal (substring fname 0 2)
|
(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))))
|
(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
|
filename
|
||||||
|
(unless (eq (aref filename 0) ?/)
|
||||||
|
(setq filename (concat "/" filename)))
|
||||||
|
(unless (eq (aref directory 0) ?/)
|
||||||
|
(setq directory (concat "/" directory)))
|
||||||
(let ((ancestor ".")
|
(let ((ancestor ".")
|
||||||
(fname-dir (file-name-as-directory fname)))
|
(filename-dir (file-name-as-directory filename)))
|
||||||
(while (and (not (string-match (concat "^" (regexp-quote directory)) fname-dir))
|
(while
|
||||||
(not (string-match (concat "^" (regexp-quote directory)) fname)))
|
(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))
|
(setq directory (file-name-directory (substring directory 0 -1))
|
||||||
ancestor (if (equal ancestor ".")
|
ancestor (if (equal ancestor ".")
|
||||||
".."
|
".."
|
||||||
(concat "../" ancestor))))
|
(concat "../" ancestor))))
|
||||||
;; Now ancestor is empty, or .., or ../.., etc.
|
;; Now ancestor is empty, or .., or ../.., etc.
|
||||||
(if (string-match (concat "^" (regexp-quote directory)) fname)
|
(if (string-match (concat "^" (regexp-quote directory)) filename)
|
||||||
;; We matched within FNAME's directory part.
|
;; We matched within FILENAME's directory part.
|
||||||
;; Add the rest of FNAME onto ANCESTOR.
|
;; Add the rest of FILENAME onto ANCESTOR.
|
||||||
(let ((rest (substring fname (match-end 0))))
|
(let ((rest (substring filename (match-end 0))))
|
||||||
(if (and (equal ancestor ".")
|
(if (and (equal ancestor ".") (not (equal rest "")))
|
||||||
(not (equal rest "")))
|
|
||||||
;; But don't bother with ANCESTOR if it would give us `./'.
|
;; But don't bother with ANCESTOR if it would give us `./'.
|
||||||
rest
|
rest
|
||||||
(concat (file-name-as-directory ancestor) rest)))
|
(concat (file-name-as-directory ancestor) rest)))
|
||||||
;; We matched FNAME's directory equivalent.
|
;; We matched FILENAME's directory equivalent.
|
||||||
ancestor))))))
|
ancestor))))))
|
||||||
|
|
||||||
(defun save-buffer (&optional args)
|
(defun save-buffer (&optional args)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue