From: Michael Albinus Date: Tue, 1 Apr 2014 12:41:56 +0000 (+0200) Subject: Pass some protocols to Tramp, like ssh and friends. X-Git-Tag: emacs-25.0.90~2640^2~287 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=8def287539f38f1f95ef54e866b80f44c9c76b5b;p=emacs.git 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. --- diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index bb7025bf6ae..486c6649c00 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,11 @@ +2014-04-01 Michael Albinus + + * 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 * url-vars.el (url-bug-address): Make into an obsolete alias. diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index ecf56e786b5..9a05746ebff 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -112,7 +112,7 @@ the mode if ARG is omitted or nil." (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 @@ regular expression avoids conflicts with local files that look 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 @@ like URLs \(Gnus is particularly bad at this\)." "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 diff --git a/lisp/url/url-tramp.el b/lisp/url/url-tramp.el new file mode 100644 index 00000000000..83cedd1d62c --- /dev/null +++ b/lisp/url/url-tramp.el @@ -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 +;; 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 . + +;;; 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