diff options
| author | Michael Albinus | 2020-01-23 14:09:35 +0100 |
|---|---|---|
| committer | Michael Albinus | 2020-01-23 14:09:35 +0100 |
| commit | 8fbc2fd492b714c612a96add0b9572d87eb4e785 (patch) | |
| tree | 2477bd8d187b62dff11a351c5afd5c249477c4db | |
| parent | 72011f23c3135690f65262f01ea92a53ff84b4e1 (diff) | |
| download | emacs-8fbc2fd492b714c612a96add0b9572d87eb4e785.tar.gz emacs-8fbc2fd492b714c612a96add0b9572d87eb4e785.zip | |
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'.
| -rw-r--r-- | doc/misc/tramp.texi | 13 | ||||
| -rw-r--r-- | lisp/net/tramp-cache.el | 4 | ||||
| -rw-r--r-- | 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 75b14d8613f..61cf373024f 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. | |||
| 1254 | 1254 | ||
| 1255 | Media devices, like cell phones, tablets, cameras, can be accessed via | 1255 | Media devices, like cell phones, tablets, cameras, can be accessed via |
| 1256 | the @option{media} method. Just the device name is needed in order to | 1256 | the @option{media} method. Just the device name is needed in order to |
| 1257 | specify the remote part of file name. However, the device must | 1257 | specify the host in the file name. However, the device must already |
| 1258 | already be connected via USB, before accessing it. | 1258 | be connected via USB, before accessing it. Possible device names are |
| 1259 | visible via host name completion, @ref{File name completion}. | ||
| 1259 | 1260 | ||
| 1260 | Depending on the device type, the access could be read-only. Some | 1261 | Depending on the device type, the access could be read-only. Some |
| 1261 | devices are accessible under different names in parallel, offering | 1262 | devices are accessible under different names in parallel, offering |
| 1262 | different parts of their file system. | 1263 | different parts of their file system. |
| 1263 | 1264 | ||
| 1264 | @c @value{tramp} does not require a device name as part of the remote | 1265 | @value{tramp} does not require a host name as part of the remote file |
| 1265 | @c file name when a single media device is connected. @value{tramp} | 1266 | name when a single media device is connected. @value{tramp} instead |
| 1266 | @c instead uses @file{@trampfn{media,,}} as the default name. | 1267 | uses @file{@trampfn{media,,}} as the default name. |
| 1267 | @c @c @command{adb devices}, run in a shell outside Emacs, shows available | ||
| 1268 | @c @c host names. | ||
| 1269 | 1268 | ||
| 1270 | @item @option{nextcloud} | 1269 | @item @option{nextcloud} |
| 1271 | @cindex method @option{nextcloud} | 1270 | @cindex method @option{nextcloud} |
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index f8325a16892..6ce86b4b65d 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el | |||
| @@ -141,7 +141,7 @@ Returns DEFAULT if not set." | |||
| 141 | (tramp-message key 8 "%s %s %s" file property value) | 141 | (tramp-message key 8 "%s %s %s" file property value) |
| 142 | (when (>= tramp-verbose 10) | 142 | (when (>= tramp-verbose 10) |
| 143 | (let* ((var (intern (concat "tramp-cache-get-count-" property))) | 143 | (let* ((var (intern (concat "tramp-cache-get-count-" property))) |
| 144 | (val (or (bound-and-true-p var) | 144 | (val (or (numberp (bound-and-true-p var)) |
| 145 | (progn | 145 | (progn |
| 146 | (add-hook 'tramp-cache-unload-hook | 146 | (add-hook 'tramp-cache-unload-hook |
| 147 | (lambda () (makunbound var))) | 147 | (lambda () (makunbound var))) |
| @@ -165,7 +165,7 @@ Returns VALUE." | |||
| 165 | (tramp-message key 8 "%s %s %s" file property value) | 165 | (tramp-message key 8 "%s %s %s" file property value) |
| 166 | (when (>= tramp-verbose 10) | 166 | (when (>= tramp-verbose 10) |
| 167 | (let* ((var (intern (concat "tramp-cache-set-count-" property))) | 167 | (let* ((var (intern (concat "tramp-cache-set-count-" property))) |
| 168 | (val (or (bound-and-true-p var) | 168 | (val (or (numberp (bound-and-true-p var)) |
| 169 | (progn | 169 | (progn |
| 170 | (add-hook 'tramp-cache-unload-hook | 170 | (add-hook 'tramp-cache-unload-hook |
| 171 | (lambda () (makunbound var))) | 171 | (lambda () (makunbound var))) |
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 3811c6767ac..ffcdafcb317 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el | |||
| @@ -190,7 +190,7 @@ They are checked during start up via | |||
| 190 | (dolist (method tramp-gvfs-methods) | 190 | (dolist (method tramp-gvfs-methods) |
| 191 | (unless (assoc method tramp-methods) | 191 | (unless (assoc method tramp-methods) |
| 192 | (add-to-list 'tramp-methods `(,method))) | 192 | (add-to-list 'tramp-methods `(,method))) |
| 193 | (when (member method (cons "media" tramp-goa-methods)) | 193 | (when (member method tramp-goa-methods) |
| 194 | (add-to-list 'tramp-default-host-alist `(,method nil "")))))) | 194 | (add-to-list 'tramp-default-host-alist `(,method nil "")))))) |
| 195 | 195 | ||
| 196 | (defconst tramp-gvfs-path-tramp (concat dbus-path-emacs "/Tramp") | 196 | (defconst tramp-gvfs-path-tramp (concat dbus-path-emacs "/Tramp") |
| @@ -2002,6 +2002,38 @@ It was \"a(say)\", but has changed to \"a{sv})\"." | |||
| 2002 | ;; Return. | 2002 | ;; Return. |
| 2003 | `(:struct ,(tramp-gvfs-dbus-string-to-byte-array mount-pref) ,mount-spec))) | 2003 | `(:struct ,(tramp-gvfs-dbus-string-to-byte-array mount-pref) ,mount-spec))) |
| 2004 | 2004 | ||
| 2005 | (defun tramp-gvfs-handler-volumeadded-volumeremoved (_dbus-name _id volume) | ||
| 2006 | "Signal handler for the \"org.gtk.Private.RemoteVolumeMonitor.VolumeAdded\" \ | ||
| 2007 | and \"org.gtk.Private.RemoteVolumeMonitor.VolumeRemoved\" signals." | ||
| 2008 | (ignore-errors | ||
| 2009 | (let* ((signal-name (dbus-event-member-name last-input-event)) | ||
| 2010 | (uri (url-generic-parse-url (nth 5 volume))) | ||
| 2011 | (method (url-type uri)) | ||
| 2012 | (vec (make-tramp-file-name | ||
| 2013 | :method "media" | ||
| 2014 | ;; A host name cannot contain spaces. | ||
| 2015 | :host (replace-regexp-in-string " " "_" (nth 1 volume)))) | ||
| 2016 | (media (make-tramp-media-device | ||
| 2017 | :method method | ||
| 2018 | :host (url-host uri) | ||
| 2019 | :port (and (url-portspec uri))))) | ||
| 2020 | (when (member method tramp-media-methods) | ||
| 2021 | (tramp-message | ||
| 2022 | vec 6 "%s %s" signal-name (tramp-gvfs-stringify-dbus-message volume)) | ||
| 2023 | (tramp-flush-connection-properties vec) | ||
| 2024 | (tramp-flush-connection-properties media) | ||
| 2025 | (tramp-get-media-devices nil))))) | ||
| 2026 | |||
| 2027 | (when tramp-gvfs-enabled | ||
| 2028 | (dbus-register-signal | ||
| 2029 | :session nil tramp-gvfs-path-remotevolumemonitor | ||
| 2030 | tramp-gvfs-interface-remotevolumemonitor "VolumeAdded" | ||
| 2031 | #'tramp-gvfs-handler-volumeadded-volumeremoved) | ||
| 2032 | (dbus-register-signal | ||
| 2033 | :session nil tramp-gvfs-path-remotevolumemonitor | ||
| 2034 | tramp-gvfs-interface-remotevolumemonitor "VolumeRemoved" | ||
| 2035 | #'tramp-gvfs-handler-volumeadded-volumeremoved)) | ||
| 2036 | |||
| 2005 | 2037 | ||
| 2006 | ;; Connection functions. | 2038 | ;; Connection functions. |
| 2007 | 2039 | ||
| @@ -2320,7 +2352,7 @@ Check, that respective cache values do exist." | |||
| 2320 | "Retrieve media devices, and cache them. | 2352 | "Retrieve media devices, and cache them. |
| 2321 | The hash key is a `tramp-media-device' structure. | 2353 | The hash key is a `tramp-media-device' structure. |
| 2322 | VEC is used only for traces." | 2354 | VEC is used only for traces." |
| 2323 | ; (with-tramp-connection-property nil "media-devices" | 2355 | (let (devices) |
| 2324 | (dolist (method tramp-media-methods) | 2356 | (dolist (method tramp-media-methods) |
| 2325 | (dolist (volume (cadr (with-tramp-dbus-call-method vec t | 2357 | (dolist (volume (cadr (with-tramp-dbus-call-method vec t |
| 2326 | :session (tramp-gvfs-service-volumemonitor method) | 2358 | :session (tramp-gvfs-service-volumemonitor method) |
| @@ -2336,11 +2368,18 @@ VEC is used only for traces." | |||
| 2336 | :host (url-host uri) | 2368 | :host (url-host uri) |
| 2337 | :port (and (url-portspec uri) | 2369 | :port (and (url-portspec uri) |
| 2338 | (number-to-string (url-portspec uri)))))) | 2370 | (number-to-string (url-portspec uri)))))) |
| 2371 | (push (tramp-file-name-host vec) devices) | ||
| 2339 | (tramp-set-connection-property vec "activation-uri" (nth 5 volume)) | 2372 | (tramp-set-connection-property vec "activation-uri" (nth 5 volume)) |
| 2340 | (tramp-set-connection-property vec "media-device" media) | 2373 | (tramp-set-connection-property vec "media-device" media) |
| 2341 | (tramp-set-connection-property media "vector" vec)))) | 2374 | (tramp-set-connection-property media "vector" vec)))) |
| 2342 | ;; Mark, that media devices have been cached. | 2375 | |
| 2343 | ); "cached")) | 2376 | ;; Adapt default host name, supporting /media:: when possible. |
| 2377 | (setq tramp-default-host-alist | ||
| 2378 | (append | ||
| 2379 | `(("media" nil ,(if (= (length devices) 1) (car devices) ""))) | ||
| 2380 | (delete | ||
| 2381 | (assoc "media" tramp-default-host-alist) | ||
| 2382 | tramp-default-host-alist))))) | ||
| 2344 | 2383 | ||
| 2345 | (defun tramp-parse-media-names (service) | 2384 | (defun tramp-parse-media-names (service) |
| 2346 | "Return a list of (user host) tuples allowed to access. | 2385 | "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." | |||
| 2469 | 2508 | ||
| 2470 | ;;; TODO: | 2509 | ;;; TODO: |
| 2471 | 2510 | ||
| 2472 | ;; * Support /media::. | ||
| 2473 | ;; | ||
| 2474 | ;; * React on media mount/unmount. | ||
| 2475 | ;; | ||
| 2476 | ;; * (Customizable) unmount when exiting Emacs. See tramp-archive.el. | 2511 | ;; * (Customizable) unmount when exiting Emacs. See tramp-archive.el. |
| 2477 | ;; | 2512 | ;; |
| 2478 | ;; * Host name completion for existing mount points (afp-server, | 2513 | ;; * Host name completion for existing mount points (afp-server, |