From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Lars Hansen Newsgroups: gmane.emacs.devel Subject: Re: file-relative-name and remote files Date: Thu, 27 Feb 2003 21:03:44 +0100 Sender: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Message-ID: <3E5E6F20.6030905@math.ku.dk> NNTP-Posting-Host: main.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=ISO-8859-1; format=flowed Content-Transfer-Encoding: 7bit X-Trace: main.gmane.org 1046376584 4355 80.91.224.249 (27 Feb 2003 20:09:44 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Thu, 27 Feb 2003 20:09:44 +0000 (UTC) Cc: emacs-devel@gnu.org Return-path: Original-Received: from quimby.gnus.org ([80.91.224.244]) by main.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 18oUKo-00015f-00 for ; Thu, 27 Feb 2003 21:08:50 +0100 Original-Received: from monty-python.gnu.org ([199.232.76.173]) by quimby.gnus.org with esmtp (Exim 3.12 #1 (Debian)) id 18oUbs-0001O7-00 for ; Thu, 27 Feb 2003 21:26:28 +0100 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.10.13) id 18oUHm-0004Gx-02 for emacs-devel@quimby.gnus.org; Thu, 27 Feb 2003 15:05:42 -0500 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.10.13) id 18oUGj-0003jv-00 for emacs-devel@gnu.org; Thu, 27 Feb 2003 15:04:37 -0500 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.10.13) id 18oUFc-0002xh-00 for emacs-devel@gnu.org; Thu, 27 Feb 2003 15:03:30 -0500 Original-Received: from [62.84.220.10] (helo=mail.dantel.dk) by monty-python.gnu.org with esmtp (Exim 4.10.13) id 18oUFX-0002n5-00; Thu, 27 Feb 2003 15:03:23 -0500 Original-Received: from math.ku.dk [62.84.221.46] by mail.dantel.dk with ESMTP (SMTPD32-7.13) id A012C0700F2; Thu, 27 Feb 2003 21:07:46 +0100 User-Agent: Mozilla/5.0 (Windows; U; Win 9x 4.90; en-US; rv:1.2.1) Gecko/20021130 X-Accept-Language: en-us, en Original-To: Richard Stallman X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1b5 Precedence: list List-Id: Emacs development discussions. List-Help: List-Post: List-Subscribe: , List-Archive: List-Unsubscribe: , Errors-To: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Xref: main.gmane.org gmane.emacs.devel:12009 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:12009 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))))))