diff options
Diffstat (limited to 'lisp/net/tramp-gvfs.el')
| -rw-r--r-- | lisp/net/tramp-gvfs.el | 106 |
1 files changed, 60 insertions, 46 deletions
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 3a5041c4918..fca3988b8d8 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -122,10 +122,7 @@ (autoload 'zeroconf-init "zeroconf") (tramp-compat-funcall 'dbus-get-unique-name :system) (tramp-compat-funcall 'dbus-get-unique-name :session) - (or ;; Until Emacs 25, `process-attributes' could crash Emacs - ;; for some processes. Better we don't check. - (<= emacs-major-version 25) - (tramp-process-running-p "gvfs-fuse-daemon") + (or (tramp-process-running-p "gvfs-fuse-daemon") (tramp-process-running-p "gvfsd-fuse")))) "Non-nil when GVFS is available.") @@ -471,8 +468,7 @@ It has been changed in GVFS 1.14.") ;; </method> ;; </interface> -;; The basic structure for GNOME Online Accounts. We use a list :type, -;; in order to be compatible with Emacs 25. +;; The basic structure for GNOME Online Accounts. (cl-defstruct (tramp-goa-account (:type list) :named) method user host port) ;;;###tramp-autoload @@ -672,8 +668,7 @@ It has been changed in GVFS 1.14.") ;; STRING key (always-call-mount, is-removable, ...) ;; VARIANT value (boolean?) -;; The basic structure for media devices. We use a list :type, in -;; order to be compatible with Emacs 25. +;; The basic structure for media devices. (cl-defstruct (tramp-media-device (:type list) :named) method host port) ;; "gvfs-<command>" utilities have been deprecated in GVFS 1.31.1. We @@ -749,7 +744,8 @@ It has been changed in GVFS 1.14.") ;; New handlers should be added here. ;;;###tramp-autoload (defconst tramp-gvfs-file-name-handler-alist - '((access-file . tramp-handle-access-file) + '((abbreviate-file-name . tramp-handle-abbreviate-file-name) + (access-file . tramp-handle-access-file) (add-name-to-file . tramp-handle-add-name-to-file) ;; `byte-compiler-base-file-name' performed by default handler. (copy-directory . tramp-handle-copy-directory) @@ -800,6 +796,7 @@ It has been changed in GVFS 1.14.") ;; `get-file-buffer' performed by default handler. (insert-directory . tramp-handle-insert-directory) (insert-file-contents . tramp-handle-insert-file-contents) + (list-system-processes . ignore) (load . tramp-handle-load) (lock-file . tramp-handle-lock-file) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) @@ -809,6 +806,7 @@ It has been changed in GVFS 1.14.") (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-process . ignore) (make-symbolic-link . tramp-handle-make-symbolic-link) + (process-attributes . ignore) (process-file . ignore) (rename-file . tramp-gvfs-handle-rename-file) (set-file-acl . ignore) @@ -820,6 +818,7 @@ It has been changed in GVFS 1.14.") (start-file-process . ignore) (substitute-in-file-name . tramp-handle-substitute-in-file-name) (temporary-file-directory . tramp-handle-temporary-file-directory) + (tramp-get-home-directory . tramp-gvfs-handle-get-home-directory) (tramp-get-remote-gid . tramp-gvfs-handle-get-remote-gid) (tramp-get-remote-uid . tramp-gvfs-handle-get-remote-uid) (tramp-set-file-uid-gid . tramp-gvfs-handle-set-file-uid-gid) @@ -834,12 +833,11 @@ Operations not mentioned here will be handled by the default Emacs primitives.") ;; It must be a `defsubst' in order to push the whole code into ;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading. ;;;###tramp-autoload -(defsubst tramp-gvfs-file-name-p (filename) - "Check if it's a FILENAME handled by the GVFS daemon." - (and (tramp-tramp-file-p filename) - (let ((method - (tramp-file-name-method (tramp-dissect-file-name filename)))) - (and (stringp method) (member method tramp-gvfs-methods))))) +(defsubst tramp-gvfs-file-name-p (vec-or-filename) + "Check if it's a VEC-OR-FILENAME handled by the GVFS daemon." + (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename))) + (let ((method (tramp-file-name-method vec))) + (and (stringp method) (member method tramp-gvfs-methods))))) ;;;###tramp-autoload (defun tramp-gvfs-file-name-handler (operation &rest args) @@ -921,8 +919,6 @@ or `dbus-call-method-asynchronously'." ;; when loading. (dbus-ignore-errors (tramp-dbus-function ,vec func args)))) -(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-dbus-call-method\\>")) - (defmacro with-tramp-dbus-get-all-properties (vec bus service path interface) "Return all properties of INTERFACE. @@ -937,8 +933,6 @@ The call will be traced by Tramp with trace level 6." (tramp-dbus-function ,vec #'dbus-get-all-properties (list ,bus ,service ,path ,interface)))) -(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-dbus-get-all-properties\\>")) - (defvar tramp-gvfs-dbus-event-vector nil "Current Tramp file name to be used, as vector. It is needed when D-Bus signals or errors arrive, because there @@ -1002,7 +996,7 @@ file names." (with-parsed-tramp-file-name (if t1 filename newname) nil (unless (file-exists-p filename) - (tramp-compat-file-missing v filename)) + (tramp-error v 'file-missing filename)) (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error v 'file-already-exists newname)) (when (and (file-directory-p newname) @@ -1102,8 +1096,7 @@ file names." (tramp-skeleton-delete-directory directory recursive trash (if (and recursive (not (file-symlink-p directory))) (mapc (lambda (file) - (if (eq t (tramp-compat-file-attribute-type - (file-attributes file))) + (if (eq t (file-attribute-type (file-attributes file))) (delete-directory file recursive) (delete-file file))) (directory-files @@ -1149,16 +1142,14 @@ file names." ;; Dissect NAME. (with-parsed-tramp-file-name name nil ;; If there is a default location, expand tilde. - (when (string-match "\\`\\(~\\)\\(/\\|\\'\\)" localname) - (save-match-data - (tramp-gvfs-maybe-open-connection - (make-tramp-file-name - :method method :user user :domain domain - :host host :port port :localname "/" :hop hop))) - (setq localname - (replace-match - (tramp-get-connection-property v "default-location" "~") - nil t localname 1))) + (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname) + (let ((uname (match-string 1 localname)) + (fname (match-string 2 localname)) + hname) + (when (zerop (length uname)) + (setq uname user)) + (when (setq hname (tramp-get-home-directory v uname)) + (setq localname (concat hname fname))))) ;; Tilde expansion is not possible. (when (and (not tramp-tolerate-tilde) (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)) @@ -1177,8 +1168,8 @@ file names." ;; Do not keep "/..". (when (string-match-p "^/\\.\\.?$" localname) (setq localname "/")) - ;; No tilde characters in file name, do normal - ;; `expand-file-name' (this does "/./" and "/../"). + ;; Do normal `expand-file-name' (this does "/./" and "/../"), + ;; unless there are tilde characters in file name. (tramp-make-tramp-file-name v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) localname @@ -1465,7 +1456,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." `file-notify' events." (let* ((events (process-get proc 'events)) (rest-string (process-get proc 'rest-string)) - (dd (with-current-buffer (process-buffer proc) default-directory)) + (dd (tramp-get-default-directory (process-buffer proc))) (ddu (regexp-quote (tramp-gvfs-url-file-name dd)))) (when rest-string (tramp-message proc 10 "Previous string:\n%s" rest-string)) @@ -1530,11 +1521,13 @@ If FILE-SYSTEM is non-nil, return file system attributes." (size (cdr (assoc "filesystem::size" attr))) (used (cdr (assoc "filesystem::used" attr))) (free (cdr (assoc "filesystem::free" attr)))) - (when (or size used free) - (list (string-to-number (or size "0")) - (string-to-number (or free "0")) - (- (string-to-number (or size "0")) - (string-to-number (or used "0")))))))) + (when (or size free) + (list (and size (string-to-number size)) + (and free (string-to-number free)) + ;; "mtp" connections do not return "filesystem::used". + (or (and size used + (- (string-to-number size) (string-to-number used))) + (and free (string-to-number free)))))))) (defun tramp-gvfs-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." @@ -1604,9 +1597,30 @@ If FILE-SYSTEM is non-nil, return file system attributes." "%s" (if (or (null time) (tramp-compat-time-equal-p time tramp-time-doesnt-exist) (tramp-compat-time-equal-p time tramp-time-dont-know)) - (current-time) + nil time))))) +(defun tramp-gvfs-handle-get-home-directory (vec &optional _user) + "The remote home directory for connection VEC as local file name. +If USER is a string, return its home directory instead of the +user identified by VEC. If there is no user specified in either +VEC or USER, or if there is no home directory, return nil." + (let ((localname + (tramp-get-connection-property vec "default-location" nil)) + result) + (cond + ((zerop (length localname)) + (tramp-get-connection-property (tramp-get-process vec) "share" nil)) + ;; Google-drive. + ((not (string-prefix-p "/" localname)) + (dolist (item + (tramp-gvfs-get-directory-attributes + (tramp-make-tramp-file-name vec "/")) + result) + (when (string-equal (cdr (assoc "name" item)) localname) + (setq result (concat "/" (car item)))))) + (t localname)))) + (defun tramp-gvfs-handle-get-remote-uid (vec id-format) "The uid of the remote connection VEC, in ID-FORMAT. ID-FORMAT valid values are `string' and `integer'." @@ -1615,7 +1629,7 @@ ID-FORMAT valid values are `string' and `integer'." (when-let ((localname (tramp-get-connection-property (tramp-get-process vec) "share" nil))) - (tramp-compat-file-attribute-user-id + (file-attribute-user-id (file-attributes (tramp-make-tramp-file-name vec localname) id-format))))) (defun tramp-gvfs-handle-get-remote-gid (vec id-format) @@ -1624,7 +1638,7 @@ ID-FORMAT valid values are `string' and `integer'." (when-let ((localname (tramp-get-connection-property (tramp-get-process vec) "share" nil))) - (tramp-compat-file-attribute-group-id + (file-attribute-group-id (file-attributes (tramp-make-tramp-file-name vec localname) id-format)))) (defun tramp-gvfs-handle-set-file-uid-gid (filename &optional uid gid) @@ -1867,9 +1881,9 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\" and host (tramp-file-name-host v) port (tramp-file-name-port v))))) (when (member method tramp-gvfs-methods) - (let ((v (make-tramp-file-name - :method method :user user :domain domain - :host host :port port))) + (let ((v (make-tramp-file-name + :method method :user user :domain domain + :host host :port port))) (tramp-message v 6 "%s %s" signal-name (tramp-gvfs-stringify-dbus-message mount-info)) |