[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."
(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))
         ;; Conditions for separate trees
           ;; Test for different drives on DOS/Windows
             (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
             (let ((re (car (rassq hf file-name-handler-alist))))
                     (string-match re filename)
                     (substring filename 0 (match-end 0)))
                     (string-match re directory)
                     (substring directory 0 (match-end 0)))))))))
(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)))
(not (string-match (concat "^" (regexp-quote directory)) filename-dir)) (not (string-match (concat "^" (regexp-quote directory)) filename)))
             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 `./'.
               (concat (file-name-as-directory ancestor) rest)))
           ;; We matched FILENAME's directory equivalent.

reply via email to

[Prev in Thread] Current Thread [Next in Thread]