[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] trunk r116920: Pass some protocols to Tramp, like ssh and
From: |
Michael Albinus |
Subject: |
[Emacs-diffs] trunk r116920: Pass some protocols to Tramp, like ssh and friends. |
Date: |
Tue, 01 Apr 2014 12:42:06 +0000 |
User-agent: |
Bazaar (2.6b2) |
------------------------------------------------------------
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
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] trunk r116920: Pass some protocols to Tramp, like ssh and friends.,
Michael Albinus <=