[Emacs-diffs] trunk r116920: Pass some protocols to Tramp, like ssh and friends.

[Michael Albinus]

------------------------------------------------------------
revno: 116920
revision-id: address@hidden
parent: address@hidden
committer: Michael Albinus <address@hidden>
branch nick: trunk
timestamp: Tue 2014-04-01 14:41:56 +0200
message:
  Pass some protocols to Tramp, like ssh and friends.
  
  * url-tramp.el: New file.
  
  * url-handlers.el (url-handler-regexp): Add ssh, scp, rsync and telnet.
  Add :version.
  (url-file-handler): Call `url-tramp-file-handler' if appropriate.
added:
  lisp/url/url-tramp.el          urltramp.el-20140401122733-ht2y2sklgoew0qqo-1
modified:
  lisp/url/ChangeLog             changelog-20091113204419-o5vbwnq5f7feedwu-3116
  lisp/url/url-handlers.el       
urlhandlers.el-20091113204419-o5vbwnq5f7feedwu-2987

=== modified file 'lisp/url/ChangeLog'
--- a/lisp/url/ChangeLog        2014-03-28 23:02:02 +0000
+++ b/lisp/url/ChangeLog        2014-04-01 12:41:56 +0000
@@ -1,3 +1,11 @@
+2014-04-01  Michael Albinus  <address@hidden>
+
+       * url-tramp.el: New file.
+
+       * url-handlers.el (url-handler-regexp): Add ssh, scp, rsync and telnet.
+       Add :version.
+       (url-file-handler): Call `url-tramp-file-handler' if appropriate.
+
 2014-03-28  Glenn Morris  <address@hidden>
 
        * url-vars.el (url-bug-address): Make into an obsolete alias.

=== modified file 'lisp/url/url-handlers.el'
--- a/lisp/url/url-handlers.el  2014-03-26 15:21:17 +0000
+++ b/lisp/url/url-handlers.el  2014-04-01 12:41:56 +0000
@@ -112,7 +112,7 @@
       (push (cons url-handler-regexp 'url-file-handler)
            file-name-handler-alist)))
 
-(defcustom url-handler-regexp "\\`\\(https?\\|ftp\\|file\\|nfs\\)://"
+(defcustom url-handler-regexp 
"\\`\\(https?\\|ftp\\|file\\|nfs\\|ssh\\|scp\\|rsync\\|telnet\\)://"
   "Regular expression for URLs handled by `url-handler-mode'.
 When URL Handler mode is enabled, this regular expression is
 added to `file-name-handler-alist'.
@@ -123,6 +123,7 @@
 like URLs \(Gnus is particularly bad at this\)."
   :group 'url
   :type 'regexp
+  :version "24.5"
   :set (lambda (symbol value)
         (let ((enable url-handler-mode))
           (url-handler-mode 0)
@@ -142,20 +143,29 @@
   "Function called from the `file-name-handler-alist' routines.
 OPERATION is what needs to be done (`file-exists-p', etc).  ARGS are
 the arguments that would have been passed to OPERATION."
-  (let ((fn (get operation 'url-file-handlers))
-       (val nil)
-       (hooked nil))
-    (if (and (not fn) (intern-soft (format "url-%s" operation))
-             (fboundp (intern-soft (format "url-%s" operation))))
-        (error "Missing URL handler mapping for %s" operation))
-    (if fn
-       (setq hooked t
-             val (save-match-data (apply fn args)))
-      (setq hooked nil
-           val (url-run-real-handler operation args)))
-    (url-debug 'handlers "%s %S%S => %S" (if hooked "Hooked" "Real")
-              operation args val)
-    val))
+  ;; Check, whether there are arguments we want pass to Tramp.
+  (if (catch :do
+       (dolist (url (cons default-directory args))
+         (and (member
+               (url-type (url-generic-parse-url (and (stringp url) url)))
+               url-tramp-protocols)
+              (throw :do t))))
+      (apply 'url-tramp-file-handler operation args)
+    ;; Otherwise, let's do the job.
+    (let ((fn (get operation 'url-file-handlers))
+         (val nil)
+         (hooked nil))
+      (if (and (not fn) (intern-soft (format "url-%s" operation))
+              (fboundp (intern-soft (format "url-%s" operation))))
+         (error "Missing URL handler mapping for %s" operation))
+      (if fn
+         (setq hooked t
+               val (save-match-data (apply fn args)))
+       (setq hooked nil
+             val (url-run-real-handler operation args)))
+      (url-debug 'handlers "%s %S%S => %S" (if hooked "Hooked" "Real")
+                operation args val)
+      val)))
 
 (defun url-file-handler-identity (&rest args)
   ;; Identity function

=== added file 'lisp/url/url-tramp.el'
--- a/lisp/url/url-tramp.el     1970-01-01 00:00:00 +0000
+++ b/lisp/url/url-tramp.el     2014-04-01 12:41:56 +0000
@@ -0,0 +1,79 @@
+;;; url-tramp.el --- file-name-handler magic invoking Tramp for some protocols
+
+;; Copyright (C) 2014 Free Software Foundation, Inc.
+
+;; Author: Michael Albinus <address@hidden>
+;; Keywords: comm, data, processes, hypermedia
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'url-parse)
+(require 'tramp)
+(require 'password-cache)
+
+;;;###autoload
+(defcustom url-tramp-protocols '("ftp" "ssh" "scp" "rsync" "telnet")
+  "List of URL protocols the work is handled by Tramp.
+They must also be covered by `url-handler-regexp'."
+  :group 'url
+  :version "24.5"
+  :type '(list string))
+
+(defun url-tramp-convert-url-to-tramp (url)
+  "Convert URL to a Tramp file name."
+  (let ((obj (url-generic-parse-url (and (stringp url) url))))
+    (if (member (url-type obj) url-tramp-protocols)
+       (progn
+         (if (url-password obj)
+             (password-cache-add
+              (tramp-make-tramp-file-name
+               (url-type obj) (url-user obj) (url-host obj) "")
+              (url-password obj))
+           (tramp-make-tramp-file-name
+            (url-type obj) (url-user obj) (url-host obj) (url-filename obj))))
+      url)))
+
+(defun url-tramp-convert-tramp-to-url (file)
+  "Convert FILE, a Tramp file name, to a URL."
+  (let ((obj (ignore-errors (tramp-dissect-file-name file))))
+    (if (member (tramp-file-name-method obj) url-tramp-protocols)
+       (url-recreate-url
+        (url-parse-make-urlobj
+         (tramp-file-name-method obj)
+         (tramp-file-name-user obj)
+         nil ; password.
+         (tramp-file-name-host obj)
+         nil ; port.
+         (tramp-file-name-localname obj)
+         nil nil t)) ; target attributes fullness.
+      file)))
+
+;;;###autoload
+(defun url-tramp-file-handler (operation &rest args)
+  "Function called from the `file-name-handler-alist' routines.
+OPERATION is what needs to be done.  ARGS are the arguments that
+would have been passed to OPERATION."
+  (let ((default-directory (url-tramp-convert-url-to-tramp default-directory))
+       (args (mapcar 'url-tramp-convert-url-to-tramp args)))
+    (url-tramp-convert-tramp-to-url (apply operation args))))
+
+(provide 'url-tramp)
+
+;;; url-tramp.el ends here