Add Google Drive support to Tramp
* doc/misc/tramp.texi: Add `gdrive' method. * doc/misc/trampver.texi: * lisp/net/trampver.el: Change version to "2.3.1-pre". * etc/NEWS: Add Tramp connection method "gdrive". * lisp/net/tramp-gvfs.el (tramp-gvfs-methods) <gdrive>: Add. (tramp-default-user-alist, tramp-default-host-alist): Add rule for "gdrive". (tramp-gvfs-file-attributes): Add "name", remove "standard::icon". (tramp-gvfs-file-attributes-with-gvfs-ls-regexp): Simplify regexp. (tramp-gvfs-get-directory-attributes): Improve loop. Use "standard::display-name" as file name, if available. (tramp-gvfs-handle-file-name-all-completions): Simplify. (tramp-gvfs-url-file-name, tramp-gvfs-handler-mounted-unmounted) (tramp-gvfs-connection-mounted-p, tramp-gvfs-mount-spec): Map between "gdrive" and "google-drive". * lisp/net/tramp.el (tramp-call-process): Do not signal error. * test/lisp/net/tramp-tests.el (tramp--instrument-test-case): Do not enable `tramp-message-show-message'. (tramp-test13-make-directory, tramp-test14-delete-directory): Do not specify error type.
This commit is contained in:
Michael Albinus
parent
05d76dba66
commit
f24fe30cb8
7 changed files with 92 additions and 54 deletions
|
|
@ -957,6 +957,22 @@ syntax requires a leading volume (share) name, for example:
|
|||
based on standard protocols, such as HTTP@. @option{davs} does the same
|
||||
but with SSL encryption. Both methods support the port numbers.
|
||||
|
||||
@item @option{gdrive}
|
||||
@cindex method gdrive
|
||||
@cindex gdrive method
|
||||
@cindex Google Drive
|
||||
|
||||
Via the @option{gdrive} method it is possible to access your Google
|
||||
Drive online storage. User and host name of the remote file name are
|
||||
your email address of the Google Drive credentials, like
|
||||
@file{@trampfn{gdrive,john.doe@@gmail.com,/}}. These credentials must
|
||||
be populated in your @command{Online Accounts} application outside Emacs.
|
||||
|
||||
Since Google Drive uses cryptic blob file names internally,
|
||||
@value{tramp} works with the @code{display-name} of the files. This
|
||||
could produce unexpected behaviour in case two files in the same
|
||||
directory have the same @code{display-name}, such a situation must be avoided.
|
||||
|
||||
@item @option{obex}
|
||||
@cindex method obex
|
||||
@cindex obex method
|
||||
|
|
@ -986,8 +1002,8 @@ requires the SYNCE-GVFS plugin.
|
|||
@vindex tramp-gvfs-methods
|
||||
This custom option is a list of external methods for GVFS@. By
|
||||
default, this list includes @option{afp}, @option{dav}, @option{davs},
|
||||
@option{obex}, @option{sftp} and @option{synce}. Other methods to
|
||||
include are: @option{ftp} and @option{smb}.
|
||||
@option{gdrive}, @option{obex}, @option{sftp} and @option{synce}.
|
||||
Other methods to include are: @option{ftp} and @option{smb}.
|
||||
@end defopt
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@
|
|||
@c In the Tramp GIT, the version number is auto-frobbed from
|
||||
@c configure.ac, so you should edit that file and run
|
||||
@c "autoconf && ./configure" to change the version number.
|
||||
@set trampver 2.3.0
|
||||
@set trampver 2.3.1-pre
|
||||
|
||||
@c Other flags from configuration
|
||||
@set instprefix /usr/local
|
||||
|
|
|
|||
4
etc/NEWS
4
etc/NEWS
|
|
@ -318,6 +318,10 @@ different group ID.
|
|||
+++
|
||||
*** New connection method "doas" for OpenBSD hosts.
|
||||
|
||||
+++
|
||||
*** New connection method "gdrive", which allows to access Google
|
||||
Drive onsite repositories.
|
||||
|
||||
---
|
||||
** 'auto-revert-use-notify' is set back to t in 'global-auto-revert-mode'.
|
||||
|
||||
|
|
|
|||
|
|
@ -49,10 +49,10 @@
|
|||
|
||||
;; The custom option `tramp-gvfs-methods' contains the list of
|
||||
;; supported connection methods. Per default, these are "afp", "dav",
|
||||
;; "davs", "obex", "sftp" and "synce". Note that with "obex" it might
|
||||
;; be necessary to pair with the other bluetooth device, if it hasn't
|
||||
;; been done already. There might be also some few seconds delay in
|
||||
;; discovering available bluetooth devices.
|
||||
;; "davs", "gdrive", "obex", "sftp" and "synce". Note that with
|
||||
;; "obex" it might be necessary to pair with the other bluetooth
|
||||
;; device, if it hasn't been done already. There might be also some
|
||||
;; few seconds delay in discovering available bluetooth devices.
|
||||
|
||||
;; Other possible connection methods are "ftp" and "smb". When one of
|
||||
;; these methods is added to the list, the remote access for that
|
||||
|
|
@ -110,21 +110,29 @@
|
|||
(require 'custom))
|
||||
|
||||
;;;###tramp-autoload
|
||||
(defcustom tramp-gvfs-methods '("afp" "dav" "davs" "obex" "sftp" "synce")
|
||||
(defcustom tramp-gvfs-methods
|
||||
'("afp" "dav" "davs" "gdrive" "obex" "sftp" "synce")
|
||||
"List of methods for remote files, accessed with GVFS."
|
||||
:group 'tramp
|
||||
:version "25.1"
|
||||
:version "25.2"
|
||||
:type '(repeat (choice (const "afp")
|
||||
(const "dav")
|
||||
(const "davs")
|
||||
(const "ftp")
|
||||
(const "gdrive")
|
||||
(const "obex")
|
||||
(const "sftp")
|
||||
(const "smb")
|
||||
(const "synce"))))
|
||||
|
||||
;; Add a default for `tramp-default-user-alist'. Rule: For the SYNCE
|
||||
;; method, no user is chosen.
|
||||
;; Add defaults for `tramp-default-user-alist' and `tramp-default-host-alist'.
|
||||
;;;###tramp-autoload
|
||||
(when (string-match "\\(.+\\)@\\(\\(?:gmail\\|googlemail\\)\\.com\\)"
|
||||
user-mail-address)
|
||||
(add-to-list 'tramp-default-user-alist
|
||||
`("\\`gdrive\\'" nil ,(match-string 1 user-mail-address)))
|
||||
(add-to-list 'tramp-default-host-alist
|
||||
'("\\`gdrive\\'" nil ,(match-string 2 user-mail-address))))
|
||||
;;;###tramp-autoload
|
||||
(add-to-list 'tramp-default-user-alist '("\\`synce\\'" nil nil))
|
||||
|
||||
|
|
@ -408,11 +416,9 @@ Every entry is a list (NAME ADDRESS).")
|
|||
"The device interface of the HAL daemon.")
|
||||
|
||||
(defconst tramp-gvfs-file-attributes
|
||||
'("type"
|
||||
'("name"
|
||||
"type"
|
||||
"standard::display-name"
|
||||
;; We don't need this one. It is used as delimiter in case the
|
||||
;; display name contains spaces, which is hard to parse.
|
||||
"standard::icon"
|
||||
"standard::symlink-target"
|
||||
"unix::nlink"
|
||||
"unix::uid"
|
||||
|
|
@ -432,9 +438,7 @@ Every entry is a list (NAME ADDRESS).")
|
|||
"GVFS file attributes.")
|
||||
|
||||
(defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp
|
||||
(concat "[[:blank:]]"
|
||||
(regexp-opt tramp-gvfs-file-attributes t)
|
||||
"=\\([^[:blank:]]+\\)")
|
||||
(concat "[[:blank:]]" (regexp-opt tramp-gvfs-file-attributes t) "=\\(.+?\\)")
|
||||
"Regexp to parse GVFS file attributes with `gvfs-ls'.")
|
||||
|
||||
(defconst tramp-gvfs-file-attributes-with-gvfs-info-regexp
|
||||
|
|
@ -834,25 +838,31 @@ file names."
|
|||
v "gvfs-ls" "-h" "-n" "-a"
|
||||
(mapconcat 'identity tramp-gvfs-file-attributes ",")
|
||||
(tramp-gvfs-url-file-name directory))
|
||||
;; Parse output ...
|
||||
;; Parse output.
|
||||
(with-current-buffer (tramp-get-connection-buffer v)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward
|
||||
(while (looking-at
|
||||
(concat "^\\(.+\\)[[:blank:]]"
|
||||
"\\([[:digit:]]+\\)[[:blank:]]"
|
||||
"(\\(.+\\))[[:blank:]]"
|
||||
"standard::display-name=\\(.+\\)[[:blank:]]"
|
||||
"standard::icon=")
|
||||
(point-at-eol) t)
|
||||
(let ((item (list (cons "standard::display-name" (match-string 4))
|
||||
(cons "type" (match-string 3))
|
||||
"(\\(.+?\\))"
|
||||
tramp-gvfs-file-attributes-with-gvfs-ls-regexp))
|
||||
(let ((item (list (cons "type" (match-string 3))
|
||||
(cons "standard::size" (match-string 2))
|
||||
(match-string 1))))
|
||||
(while (re-search-forward
|
||||
tramp-gvfs-file-attributes-with-gvfs-ls-regexp
|
||||
(point-at-eol) t)
|
||||
(push (cons (match-string 1) (match-string 2)) item))
|
||||
(push (nreverse item) result))
|
||||
(cons "name" (match-string 1)))))
|
||||
(goto-char (1+ (match-end 3)))
|
||||
(while (looking-at
|
||||
(concat
|
||||
tramp-gvfs-file-attributes-with-gvfs-ls-regexp
|
||||
"\\(" tramp-gvfs-file-attributes-with-gvfs-ls-regexp
|
||||
"\\|" "$" "\\)"))
|
||||
(push (cons (match-string 1) (match-string 2)) item)
|
||||
(goto-char (match-end 2)))
|
||||
;; Add display name as head.
|
||||
(push
|
||||
(cons (cdr (or (assoc "standard::display-name" item)
|
||||
(assoc "name" item)))
|
||||
(nreverse item))
|
||||
result))
|
||||
(forward-line)))
|
||||
result)))))
|
||||
|
||||
|
|
@ -868,7 +878,7 @@ file names."
|
|||
;; Send command.
|
||||
(tramp-gvfs-send-command
|
||||
v "gvfs-info" (tramp-gvfs-url-file-name filename))
|
||||
;; Parse output ...
|
||||
;; Parse output.
|
||||
(with-current-buffer (tramp-get-connection-buffer v)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward
|
||||
|
|
@ -1024,17 +1034,12 @@ file names."
|
|||
filename
|
||||
(with-parsed-tramp-file-name (expand-file-name directory) nil
|
||||
(with-tramp-file-property v localname "file-name-all-completions"
|
||||
(let ((result '("./" "../"))
|
||||
entry)
|
||||
(let ((result '("./" "../")))
|
||||
;; Get a list of directories and files.
|
||||
(dolist (item (tramp-gvfs-get-directory-attributes directory) result)
|
||||
(setq entry
|
||||
(or ;; Use display-name if available (google-drive).
|
||||
;(cdr (assoc "standard::display-name" item))
|
||||
(car item)))
|
||||
(if (string-equal (cdr (assoc "type" item)) "directory")
|
||||
(push (file-name-as-directory entry) result)
|
||||
(push entry result)))))))))
|
||||
(push (file-name-as-directory (car item)) result)
|
||||
(push (car item) result)))))))))
|
||||
|
||||
(defun tramp-gvfs-handle-file-notify-add-watch (file-name flags _callback)
|
||||
"Like `file-notify-add-watch' for Tramp files."
|
||||
|
|
@ -1220,6 +1225,8 @@ file-notify events."
|
|||
(url-recreate-url
|
||||
(if (tramp-tramp-file-p filename)
|
||||
(with-parsed-tramp-file-name filename nil
|
||||
(when (string-equal "gdrive" method)
|
||||
(setq method "google-drive"))
|
||||
(when (and user (string-match tramp-user-with-domain-regexp user))
|
||||
(setq user
|
||||
(concat (match-string 2 user) ";" (match-string 1 user))))
|
||||
|
|
@ -1389,6 +1396,8 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"."
|
|||
(setq host (tramp-bluez-device host)))
|
||||
(when (and (string-equal "dav" method) (string-equal "true" ssl))
|
||||
(setq method "davs"))
|
||||
(when (string-equal "google-drive" method)
|
||||
(setq method "gdrive"))
|
||||
(unless (zerop (length domain))
|
||||
(setq user (concat user tramp-prefix-domain-format domain)))
|
||||
(unless (zerop (length port))
|
||||
|
|
@ -1474,6 +1483,8 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"."
|
|||
(setq host (tramp-bluez-device host)))
|
||||
(when (and (string-equal "dav" method) (string-equal "true" ssl))
|
||||
(setq method "davs"))
|
||||
(when (string-equal "google-drive" method)
|
||||
(setq method "gdrive"))
|
||||
(when (and (string-equal "synce" method) (zerop (length user)))
|
||||
(setq user (or (tramp-file-name-user vec) "")))
|
||||
(unless (zerop (length domain))
|
||||
|
|
@ -1531,6 +1542,9 @@ It was \"a(say)\", but has changed to \"a{sv})\"."
|
|||
(list (tramp-gvfs-mount-spec-entry "type" "afp-volume")
|
||||
(tramp-gvfs-mount-spec-entry "host" host)
|
||||
(tramp-gvfs-mount-spec-entry "volume" share)))
|
||||
((string-equal "gdrive" method)
|
||||
(list (tramp-gvfs-mount-spec-entry "type" "google-drive")
|
||||
(tramp-gvfs-mount-spec-entry "host" host)))
|
||||
(t
|
||||
(list (tramp-gvfs-mount-spec-entry "type" method)
|
||||
(tramp-gvfs-mount-spec-entry "host" host))))
|
||||
|
|
@ -1896,8 +1910,9 @@ They are retrieved from the hal daemon."
|
|||
|
||||
;;; TODO:
|
||||
|
||||
;; * Host name completion via afp-server, smb-server or smb-network.
|
||||
;; * Check how two shares of the same SMB server can be mounted in
|
||||
;; * Host name completion for existing mount points (afp-server,
|
||||
;; smb-server) or via smb-network.
|
||||
;; * Check, how two shares of the same SMB server can be mounted in
|
||||
;; parallel.
|
||||
;; * Apply SDP on bluetooth devices, in order to filter out obex
|
||||
;; capability.
|
||||
|
|
|
|||
|
|
@ -4012,7 +4012,7 @@ are written with verbosity of 6."
|
|||
(vector tramp-current-method tramp-current-user
|
||||
tramp-current-host nil nil)))
|
||||
(destination (if (eq destination t) (current-buffer) destination))
|
||||
result)
|
||||
output error result)
|
||||
(tramp-message
|
||||
v 6 "`%s %s' %s %s"
|
||||
program (mapconcat 'identity args " ") infile destination)
|
||||
|
|
@ -4023,13 +4023,17 @@ are written with verbosity of 6."
|
|||
'call-process program infile (or destination t) display args))
|
||||
;; `result' could also be an error string.
|
||||
(when (stringp result)
|
||||
(signal 'file-error (list result)))
|
||||
(setq error result
|
||||
result 1))
|
||||
(with-current-buffer
|
||||
(if (bufferp destination) destination (current-buffer))
|
||||
(tramp-message v 6 "%d\n%s" result (buffer-string))))
|
||||
(setq output (buffer-string))))
|
||||
(error
|
||||
(setq result 1)
|
||||
(tramp-message v 6 "%d\n%s" result (error-message-string err))))
|
||||
(setq error (error-message-string err)
|
||||
result 1)))
|
||||
(if (zerop (length error))
|
||||
(tramp-message v 6 "%d\n%s" result output)
|
||||
(tramp-message v 6 "%d\n%s\n%s" result output error))
|
||||
result))
|
||||
|
||||
(defun tramp-call-process-region
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
;; Author: Kai Großjohann <kai.grossjohann@gmx.net>
|
||||
;; Keywords: comm, processes
|
||||
;; Package: tramp
|
||||
;; Version: 2.3.0
|
||||
;; Version: 2.3.1-pre
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
|
|
@ -32,7 +32,7 @@
|
|||
;; should be changed only there.
|
||||
|
||||
;;;###tramp-autoload
|
||||
(defconst tramp-version "2.3.0"
|
||||
(defconst tramp-version "2.3.1-pre"
|
||||
"This version of Tramp.")
|
||||
|
||||
;;;###tramp-autoload
|
||||
|
|
@ -54,7 +54,7 @@
|
|||
;; Check for Emacs version.
|
||||
(let ((x (if (>= emacs-major-version 23)
|
||||
"ok"
|
||||
(format "Tramp 2.3.0 is not fit for %s"
|
||||
(format "Tramp 2.3.1-pre is not fit for %s"
|
||||
(when (string-match "^.*$" (emacs-version))
|
||||
(match-string 0 (emacs-version)))))))
|
||||
(unless (string-match "\\`ok\\'" x) (error "%s" x)))
|
||||
|
|
|
|||
|
|
@ -119,7 +119,6 @@ eval properly in `should', `should-not' or `should-error'. BODY
|
|||
shall not contain a timeout."
|
||||
(declare (indent 1) (debug (natnump body)))
|
||||
`(let ((tramp-verbose ,verbose)
|
||||
(tramp-message-show-message t)
|
||||
(tramp-debug-on-error t)
|
||||
(debug-ignored-errors
|
||||
(cons "^make-symbolic-link not supported$" debug-ignored-errors)))
|
||||
|
|
@ -932,7 +931,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
|
|||
(make-directory tmp-name1)
|
||||
(should (file-directory-p tmp-name1))
|
||||
(should (file-accessible-directory-p tmp-name1))
|
||||
(should-error (make-directory tmp-name2) :type 'file-error)
|
||||
(should-error (make-directory tmp-name2))
|
||||
(make-directory tmp-name2 'parents)
|
||||
(should (file-directory-p tmp-name2))
|
||||
(should (file-accessible-directory-p tmp-name2)))
|
||||
|
|
@ -953,7 +952,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
|
|||
;; Delete non-empty directory.
|
||||
(make-directory tmp-name)
|
||||
(write-region "foo" nil (expand-file-name "bla" tmp-name))
|
||||
(should-error (delete-directory tmp-name) :type 'file-error)
|
||||
(should-error (delete-directory tmp-name))
|
||||
(delete-directory tmp-name 'recursive)
|
||||
(should-not (file-directory-p tmp-name))))
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue