Re: file-relative-name and remote files

[Lars Hansen <larsh@math.ku.dk>]

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