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.

7 files changed, 92 insertions, 54 deletions

diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 894ccbe9c9c..dc3ef23c455 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -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
 
 
diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi
index 6f67f35902a..3101dc0de82 100644
--- a/doc/misc/trampver.texi
+++ b/doc/misc/trampver.texi
@@ -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
diff --git a/etc/NEWS b/etc/NEWS
index 7e11f622f14..2f2ae65da8d 100644
--- a/etc/NEWS
+++ b/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'.
 
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 0e874d6c586..8e7ef0f4079 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -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.
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index b02760bff80..d80006abbca 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -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
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index aea260541e9..fad7e7f77c1 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -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)))
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index b9562c1befc..fe927bb25fd 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -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))))