master 8fbc2fd: Implement "/media::" default host name in Tramp

[Michael Albinus]

branch: master
commit 8fbc2fd492b714c612a96add0b9572d87eb4e785
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    Implement "/media::" default host name in Tramp
    
    * doc/misc/tramp.texi (GVFS-based methods): Describe default
    /media:: file name.
    
    * lisp/net/tramp-cache.el (tramp-get-file-property)
    (tramp-set-file-property): Check, whether
    `tramp-cache-{g,s}et-count-*' objects are numbers.
    
    * lisp/net/tramp-gvfs.el (top): Don't set global default for
    "media" in `tramp-default-host-alist'.
    (tramp-gvfs-handler-volumeadded-volumeremoved): New defun.
    (top): Register "org.gtk.Private.RemoteVolumeMonitor.VolumeAdded"
    and "org.gtk.Private.RemoteVolumeMonitor.VolumeRemoved" signals.
    (tramp-get-media-devices): Set defaults for "media" in
    `tramp-default-host-alist'.
---
 doc/misc/tramp.texi     | 13 ++++++-------
 lisp/net/tramp-cache.el |  4 ++--
 lisp/net/tramp-gvfs.el  | 51 +++++++++++++++++++++++++++++++++++++++++--------
 3 files changed, 51 insertions(+), 17 deletions(-)

diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 75b14d8..61cf373 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -1254,18 +1254,17 @@ directory have the same @code{display-name}, such a 
situation must be avoided.
 
 Media devices, like cell phones, tablets, cameras, can be accessed via
 the @option{media} method.  Just the device name is needed in order to
-specify the remote part of file name.  However, the device must
-already be connected via USB, before accessing it.
+specify the host in the file name.  However, the device must already
+be connected via USB, before accessing it.  Possible device names are
+visible via host name completion, @ref{File name completion}.
 
 Depending on the device type, the access could be read-only.  Some
 devices are accessible under different names in parallel, offering
 different parts of their file system.
 
-@c @value{tramp} does not require a device name as part of the remote
-@c file name when a single media device is connected.  @value{tramp}
-@c instead uses @file{@trampfn{media,,}} as the default name.
-@c @c @command{adb devices}, run in a shell outside Emacs, shows available
-@c @c host names.
+@value{tramp} does not require a host name as part of the remote file
+name when a single media device is connected.  @value{tramp} instead
+uses @file{@trampfn{media,,}} as the default name.
 
 @item @option{nextcloud}
 @cindex method @option{nextcloud}
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index f8325a1..6ce86b4 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -141,7 +141,7 @@ Returns DEFAULT if not set."
     (tramp-message key 8 "%s %s %s" file property value)
     (when (>= tramp-verbose 10)
       (let* ((var (intern (concat "tramp-cache-get-count-" property)))
-            (val (or (bound-and-true-p var)
+            (val (or (numberp (bound-and-true-p var))
                      (progn
                        (add-hook 'tramp-cache-unload-hook
                                  (lambda () (makunbound var)))
@@ -165,7 +165,7 @@ Returns VALUE."
     (tramp-message key 8 "%s %s %s" file property value)
     (when (>= tramp-verbose 10)
       (let* ((var (intern (concat "tramp-cache-set-count-" property)))
-            (val (or (bound-and-true-p var)
+            (val (or (numberp (bound-and-true-p var))
                      (progn
                        (add-hook 'tramp-cache-unload-hook
                                  (lambda () (makunbound var)))
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 3811c67..ffcdafc 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -190,7 +190,7 @@ They are checked during start up via
    (dolist (method tramp-gvfs-methods)
      (unless (assoc method tramp-methods)
        (add-to-list 'tramp-methods `(,method)))
-     (when (member method (cons "media" tramp-goa-methods))
+     (when (member method tramp-goa-methods)
        (add-to-list 'tramp-default-host-alist `(,method nil ""))))))
 
 (defconst tramp-gvfs-path-tramp (concat dbus-path-emacs "/Tramp")
@@ -2002,6 +2002,38 @@ It was \"a(say)\", but has changed to \"a{sv})\"."
     ;; Return.
     `(:struct ,(tramp-gvfs-dbus-string-to-byte-array mount-pref) ,mount-spec)))
 
+(defun tramp-gvfs-handler-volumeadded-volumeremoved (_dbus-name _id volume)
+  "Signal handler for the \"org.gtk.Private.RemoteVolumeMonitor.VolumeAdded\" \
+and \"org.gtk.Private.RemoteVolumeMonitor.VolumeRemoved\" signals."
+  (ignore-errors
+    (let* ((signal-name (dbus-event-member-name last-input-event))
+          (uri (url-generic-parse-url (nth 5 volume)))
+          (method (url-type uri))
+          (vec (make-tramp-file-name
+                :method "media"
+                ;; A host name cannot contain spaces.
+                :host (replace-regexp-in-string " " "_" (nth 1 volume))))
+          (media (make-tramp-media-device
+                  :method method
+                  :host (url-host uri)
+                  :port (and (url-portspec uri)))))
+      (when (member method tramp-media-methods)
+       (tramp-message
+        vec 6 "%s %s" signal-name (tramp-gvfs-stringify-dbus-message volume))
+       (tramp-flush-connection-properties vec)
+       (tramp-flush-connection-properties media)
+       (tramp-get-media-devices nil)))))
+
+(when tramp-gvfs-enabled
+  (dbus-register-signal
+   :session nil tramp-gvfs-path-remotevolumemonitor
+   tramp-gvfs-interface-remotevolumemonitor "VolumeAdded"
+   #'tramp-gvfs-handler-volumeadded-volumeremoved)
+  (dbus-register-signal
+   :session nil tramp-gvfs-path-remotevolumemonitor
+   tramp-gvfs-interface-remotevolumemonitor "VolumeRemoved"
+   #'tramp-gvfs-handler-volumeadded-volumeremoved))
+
 
 ;; Connection functions.
 
@@ -2320,7 +2352,7 @@ Check, that respective cache values do exist."
   "Retrieve media devices, and cache them.
 The hash key is a `tramp-media-device' structure.
 VEC is used only for traces."
-;  (with-tramp-connection-property nil "media-devices"
+  (let (devices)
     (dolist (method tramp-media-methods)
       (dolist (volume (cadr (with-tramp-dbus-call-method vec t
                              :session (tramp-gvfs-service-volumemonitor method)
@@ -2336,11 +2368,18 @@ VEC is used only for traces."
                       :host (url-host uri)
                       :port (and (url-portspec uri)
                                  (number-to-string (url-portspec uri))))))
+         (push (tramp-file-name-host vec) devices)
          (tramp-set-connection-property vec "activation-uri" (nth 5 volume))
          (tramp-set-connection-property vec "media-device" media)
          (tramp-set-connection-property media "vector" vec))))
-    ;; Mark, that media devices have been cached.
-);    "cached"))
+
+    ;; Adapt default host name, supporting /media:: when possible.
+    (setq tramp-default-host-alist
+         (append
+          `(("media" nil ,(if (= (length devices) 1) (car devices) "")))
+          (delete
+           (assoc "media" tramp-default-host-alist)
+           tramp-default-host-alist)))))
 
 (defun tramp-parse-media-names (service)
   "Return a list of (user host) tuples allowed to access.
@@ -2469,10 +2508,6 @@ This uses \"avahi-browse\" in case D-Bus is not enabled 
in Avahi."
 
 ;;; TODO:
 
-;; * Support /media::.
-;;
-;; * React on media mount/unmount.
-;;
 ;; * (Customizable) unmount when exiting Emacs.  See tramp-archive.el.
 ;;
 ;; * Host name completion for existing mount points (afp-server,