procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

(file-relative-name): If FILENAME and DIRECTORY are on

Browse source 
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:
Kai Großjohann 2003-03-29 15:31:07 +00:00
parent b1a2b924ce
commit 753ad98890
2 changed files with 98 additions and 27 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
lisp/ChangeLog
View file

@ -1,5 +1,10 @@
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-handle-expand-file-name): Do not allow ".." to
cross file handler boundaries, so that "/user@host:/../foo"

120
lisp/files.el
View file

@ -2781,45 +2781,111 @@ Uses `backup-directory-alist' in the same way as does
"Return number of names file FILENAME has."
(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)
"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."
If FILENAME and DIRECTORY lie on different machines or on different drives
\(DOS/Windows), it returns FILENAME in expanded form."
(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))))
(setq directory
(file-name-as-directory (expand-file-name (or directory
default-directory))))
(setq filename (expand-file-name filename))
(let ((hf (find-file-name-handler filename 'file-local-copy))
(hd (find-file-name-handler directory 'file-local-copy)))
(when (and hf (not (get hf 'file-remote-p))) (setq hf nil))
(when (and hd (not (get hd 'file-remote-p))) (setq hd nil))
(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))))
;; 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
(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))
(unless (eq (aref filename 0) ?/)
(setq filename (concat "/" filename)))
(unless (eq (aref directory 0) ?/)
(setq directory (concat "/" directory)))
(let ((ancestor ".")
(filename-dir (file-name-as-directory filename)))
(while
(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))
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 "")))
;; Now ancestor is empty, or .., or ../.., etc.
(if (string-match (concat "^" (regexp-quote directory)) filename)
;; We matched within FILENAME's directory part.
;; Add the rest of FILENAME onto ANCESTOR.
(let ((rest (substring filename (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))))))
;; We matched FILENAME's directory equivalent.
ancestor))))))
(defun save-buffer (&optional args)
"Save current buffer in visited file if modified. Versions described below.