From: Michael Albinus <michael.albinus@gmx.de>
Date: Wed, 6 Feb 2008 20:34:23 +0000 (+0000)
Subject: * url-handlers.el (file-remote-p): Add handler.
X-Git-Tag: emacs-pretest-23.0.90~8135
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=a9f31e3df9023b8ee7447f4a4b7fd53b091ca5aa;p=emacs.git

* url-handlers.el (file-remote-p): Add handler.
(url-handler-file-remote-p): New fun.
---

diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index 11f99ec5280..dca2782b0f5 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,8 @@
+2008-02-06  Michael Albinus  <michael.albinus@gmx.de>
+
+	* url-handlers.el (file-remote-p): Add handler.
+	(url-handler-file-remote-p): New fun.
+
 2008-02-06  Stefan Monnier  <monnier@iro.umontreal.ca>
 
 	* url-handlers.el (url-handler-unhandled-file-name-directory):
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el
index 088e7a6a534..7fa797e121b 100644
--- a/lisp/url/url-handlers.el
+++ b/lisp/url/url-handlers.el
@@ -73,6 +73,7 @@
 ;; file-ownership-preserved-p		No way to know
 ;; file-readable-p			Finished
 ;; file-regular-p			!directory_p
+;; file-remote-p			Finished
 ;; file-symlink-p			Needs DAV bindings
 ;; file-truename			Needs DAV bindings
 ;; file-writable-p			Check for LOCK?
@@ -151,6 +152,7 @@ the arguments that would have been passed to OPERATION."
 (put 'expand-file-name 'url-file-handlers 'url-handler-expand-file-name)
 (put 'directory-file-name 'url-file-handlers 'url-handler-directory-file-name)
 (put 'unhandled-file-name-directory 'url-file-handlers 'url-handler-unhandled-file-name-directory)
+(put 'file-remote-p 'url-file-handlers 'url-handler-file-remote-p)
 ;; (put 'file-name-as-directory 'url-file-handlers 'url-handler-file-name-as-directory)
 
 ;; These are operations that we do not support yet (DAV!!!)
@@ -194,6 +196,25 @@ the arguments that would have been passed to OPERATION."
       ;; a local process.
       nil)))
 
+(defun url-handler-file-remote-p (filename &optional identification connected)
+  (let ((url (url-generic-parse-url filename)))
+    (if (and (url-type url) (not (equal (url-type url) "file")))
+	;; Maybe we can find a suitable check for CONNECTED.  For now,
+	;; we ignore it.
+	(cond
+	 ((eq identification 'method) (url-type url))
+	 ((eq identification 'user) (url-user url))
+	 ((eq identification 'host) (url-host url))
+	 ((eq identification 'localname) (url-filename url))
+	 (t (url-recreate-url
+	     (url-parse-make-urlobj (url-type url) (url-user url) nil
+				    (url-host url) (url-port url)))))
+      ;; If there is no URL type, or it is a "file://" URL, the
+      ;; filename is expected to be non remote.  A more subtle check
+      ;; for "file://" URLs could be applied, as said in
+      ;; `url-handler-unhandled-file-name-directory'.
+      nil)))
+
 ;; The actual implementation
 ;;;###autoload
 (defun url-copy-file (url newname &optional ok-if-already-exists keep-time)