Re: file-relative-name and remote files

[Lars Hansen]

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))))))