[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: file-relative-name and remote files
From: |
Lars Hansen |
Subject: |
Re: file-relative-name and remote files |
Date: |
Thu, 27 Feb 2003 21:03:44 +0100 |
User-agent: |
Mozilla/5.0 (Windows; U; Win 9x 4.90; en-US; rv:1.2.1) Gecko/20021130 |
I suggest the following implementation of file-relative-name.
It does not require a new file handler operation, it detects
remote files in the same way as file-remote-p do. Please see
the doc string for further explanation.
(defun file-relative-name (filename &optional directory separate-trees)
"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 SEPARATE-TREES is non-nil and FILENAME and DIRECTORY lie on different
machines or on different drives (DOS/Windows), it returns FILENAME on
expanded form."
(save-match-data
(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
separate-trees
;; 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
(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)) 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 FILENAME's directory equivalent.
ancestor))))))
- Re: file-relative-name and remote files, (continued)
- Re: file-relative-name and remote files, Kai Großjohann, 2003/02/27
- Re: file-relative-name and remote files, Kai Großjohann, 2003/02/27
- Re: file-relative-name and remote files, Andreas Schwab, 2003/02/27
- Re: file-relative-name and remote files, Kai Großjohann, 2003/02/28
- Re: file-relative-name and remote files, Andreas Schwab, 2003/02/28
- Re: file-relative-name and remote files, Miles Bader, 2003/02/28
- Re: file-relative-name and remote files, Stefan Monnier, 2003/02/28
- Re: file-relative-name and remote files, Andreas Schwab, 2003/02/28
Re: file-relative-name and remote files,
Lars Hansen <=