procyberian/emacs
2
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
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> 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"

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." "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
(substring directory 0 2)))) ;; 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 filename
(let ((ancestor ".") (unless (eq (aref filename 0) ?/)
(fname-dir (file-name-as-directory fname))) (setq filename (concat "/" filename)))
(while (and (not (string-match (concat "^" (regexp-quote directory)) fname-dir)) (unless (eq (aref directory 0) ?/)
(not (string-match (concat "^" (regexp-quote directory)) fname))) (setq directory (concat "/" directory)))
(setq directory (file-name-directory (substring directory 0 -1)) (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 ".") 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)
"Save current buffer in visited file if modified. Versions described below. "Save current buffer in visited file if modified. Versions described below.