\f
;; New handlers should be added here.
(defconst tramp-gvfs-file-name-handler-alist
- '(
- (access-file . ignore)
+ '((access-file . ignore)
(add-name-to-file . tramp-gvfs-handle-copy-file)
;; `byte-compiler-base-file-name' performed by default handler.
+ ;; `copy-directory' performed by default handler.
(copy-file . tramp-gvfs-handle-copy-file)
(delete-directory . tramp-gvfs-handle-delete-directory)
(delete-file . tramp-gvfs-handle-delete-file)
(dired-call-process . ignore)
(dired-compress-file . ignore)
(dired-uncache . tramp-handle-dired-uncache)
- ;; `executable-find' is not official yet. performed by default handler.
(expand-file-name . tramp-gvfs-handle-expand-file-name)
(file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
(file-acl . ignore)
(file-attributes . tramp-gvfs-handle-file-attributes)
(file-directory-p . tramp-gvfs-handle-file-directory-p)
+ ;; `file-equal-p' performed by default handler.
(file-executable-p . tramp-gvfs-handle-file-executable-p)
(file-exists-p . tramp-handle-file-exists-p)
+ ;; `file-in-directory-p' performed by default handler.
(file-local-copy . tramp-gvfs-handle-file-local-copy)
(file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-gvfs-handle-file-name-all-completions)
(file-name-nondirectory . tramp-handle-file-name-nondirectory)
;; `file-name-sans-versions' performed by default handler.
(file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
- (file-notify-add-watch . tramp-handle-file-notify-add-watch)
- (file-notify-rm-watch . ignore)
+ (file-notify-add-watch . tramp-gvfs-handle-file-notify-add-watch)
+ (file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
(file-ownership-preserved-p . ignore)
(file-readable-p . tramp-gvfs-handle-file-readable-p)
(file-regular-p . tramp-handle-file-regular-p)
(insert-directory . tramp-gvfs-handle-insert-directory)
(insert-file-contents . tramp-gvfs-handle-insert-file-contents)
(load . tramp-handle-load)
+ ;; `make-auto-save-file-name' performed by default handler.
(make-directory . tramp-gvfs-handle-make-directory)
(make-directory-internal . ignore)
(make-symbolic-link . ignore)
(set-file-acl . ignore)
(set-file-modes . ignore)
(set-file-selinux-context . ignore)
- (set-visited-file-modtime . tramp-gvfs-handle-set-visited-file-modtime)
+ (set-file-times . ignore)
+ (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
(shell-command . ignore)
(start-file-process . ignore)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
(vc-registered . ignore)
- ;; `verify-visited-file-modtime' performed by default handler.
- (write-region . tramp-gvfs-handle-write-region)
-)
+ (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
+ (write-region . tramp-gvfs-handle-write-region))
"Alist of handler functions for Tramp GVFS method.
Operations not mentioned here will be handled by the default Emacs primitives.")
(tramp-compat-font-lock-add-keywords
'emacs-lisp-mode '("\\<with-tramp-dbus-call-method\\>"))
-(defmacro with-tramp-gvfs-error-message (filename handler &rest args)
- "Apply a Tramp GVFS `handler'.
-In case of an error, modify the error message by replacing
-`filename' with its GVFS mounted name."
- `(let ((fuse-file-name (regexp-quote (tramp-gvfs-fuse-file-name ,filename)))
- elt)
- (condition-case err
- (tramp-compat-funcall ,handler ,@args)
- (error
- (setq elt (cdr err))
- (while elt
- (when (and (stringp (car elt))
- (string-match fuse-file-name (car elt)))
- (setcar elt (replace-match ,filename t t (car elt))))
- (setq elt (cdr elt)))
- (signal (car err) (cdr err))))))
-
-(put 'with-tramp-gvfs-error-message 'lisp-indent-function 2)
-(put 'with-tramp-gvfs-error-message 'edebug-form-spec '(form symbolp body))
-(tramp-compat-font-lock-add-keywords
- 'emacs-lisp-mode '("\\<with-tramp-gvfs-error-message\\>"))
-
(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
v (concat localname filename)
"file-name-all-completions" result))))))))
+(defun tramp-gvfs-handle-file-notify-add-watch (file-name flags callback)
+ "Like `file-notify-add-watch' for Tramp files."
+ (setq file-name (expand-file-name file-name))
+ (with-parsed-tramp-file-name file-name nil
+ (let ((p (start-process
+ "gvfs-monitor-file" (generate-new-buffer " *gvfs-monitor-file*")
+ "gvfs-monitor-file" (tramp-gvfs-url-file-name file-name))))
+ (if (not (processp p))
+ (tramp-error
+ v 'file-notify-error "gvfs-monitor-file failed to start")
+ (tramp-compat-set-process-query-on-exit-flag p nil)
+ (set-process-filter p 'tramp-gvfs-file-gvfs-monitor-file-process-filter)
+ (with-current-buffer (process-buffer p)
+ (setq default-directory (file-name-directory file-name)))
+ p))))
+
+(defun tramp-gvfs-file-gvfs-monitor-file-process-filter (proc string)
+ "Read output from \"gvfs-monitor-file\" and add corresponding file-notify events."
+ (let* ((rest-string (tramp-compat-process-get proc 'rest-string))
+ (dd (with-current-buffer (process-buffer proc) default-directory))
+ (ddu (regexp-quote (tramp-gvfs-url-file-name dd))))
+ (when rest-string
+ (tramp-message proc 10 "Previous string:\n%s" rest-string))
+ (tramp-message proc 6 "%S\n%s" proc string)
+ (setq string (concat rest-string string)
+ ;; Attribute change is returned in unused wording.
+ string (replace-regexp-in-string
+ "ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string))
+
+ (while (string-match
+ (concat "^[\n\r]*"
+ "File Monitor Event:[\n\r]+"
+ "File = \\([^\n\r]+\\)[\n\r]+"
+ "Event = \\([^[:blank:]]+\\)[\n\r]+")
+ string)
+ (let ((action (intern-soft
+ (replace-regexp-in-string
+ "_" "-" (downcase (match-string 2 string)))))
+ (file (match-string 1 string)))
+ (setq string (replace-match "" nil nil string))
+ ;; File names are returned as URL paths. We must convert them.
+ (when (string-match ddu file)
+ (setq file (replace-match dd nil nil file)))
+ (while (string-match "%\\([0-9A-F]\\{2\\}\\)" file)
+ (setq file
+ (replace-match
+ (char-to-string (string-to-number (match-string 1 file) 16))
+ nil nil file)))
+ ;; Usually, we would add an Emacs event now. Unfortunately,
+ ;; `unread-command-events' does not accept several events at
+ ;; once. Therefore, we apply the callback directly.
+ (tramp-compat-funcall 'file-notify-callback (list proc action file))))
+
+ ;; Save rest of the string.
+ (when (zerop (length string)) (setq string nil))
+ (when string (tramp-message proc 10 "Rest string:\n%s" string))
+ (tramp-compat-process-put proc 'rest-string string)))
+
(defun tramp-gvfs-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-property v (file-name-directory localname))
(tramp-flush-file-property v localname))))))
-(defun tramp-gvfs-handle-set-visited-file-modtime (&optional time-list)
- "Like `set-visited-file-modtime' for Tramp files."
- (unless (buffer-file-name)
- (error "Can't set-visited-file-modtime: buffer `%s' not visiting a file"
- (buffer-name)))
- (unless time-list
- (let ((f (buffer-file-name)))
- (with-parsed-tramp-file-name f nil
- (let ((remote-file-name-inhibit-cache t)
- (attr (file-attributes f)))
- ;; '(-1 65535) means file doesn't exists yet.
- (setq time-list (or (nth 5 attr) '(-1 65535)))))))
- ;; We use '(0 0) as a don't-know value.
- (unless (not (equal time-list '(0 0)))
- (tramp-run-real-handler 'set-visited-file-modtime (list time-list))))
-
(defun tramp-gvfs-handle-write-region
(start end filename &optional append visit lockname confirm)
"Like `write-region' for Tramp files."
(let ((tmpfile (tramp-compat-make-temp-file filename)))
(write-region start end tmpfile)
(condition-case nil
- (rename-file tmpfile filename)
+ (rename-file tmpfile filename 'ok-if-already-exists)
(error
(delete-file tmpfile)
(tramp-error
(dbus-unescape-from-identifier
(replace-regexp-in-string "^.*/\\([^/]+\\)$" "\\1" object-path)))
-(defun tramp-gvfs-fuse-file-name (filename)
- "Return FUSE file name, which is directly accessible."
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (tramp-gvfs-maybe-open-connection v)
- (let ((prefix (tramp-get-file-property v "/" "prefix" ""))
- (fuse-mountpoint
- (tramp-get-file-property v "/" "fuse-mountpoint" nil)))
- (unless fuse-mountpoint
- (tramp-error
- v 'file-error "There is no FUSE mount point for `%s'" filename))
- ;; We must hide the prefix, if any.
- (when (string-match (concat "^" (regexp-quote prefix)) localname)
- (setq localname (replace-match "" t t localname)))
- (tramp-message
- v 10 "remote file `%s' is local file `%s'"
- filename (concat fuse-mountpoint localname))
- (concat fuse-mountpoint localname))))
-
(defun tramp-bluez-address (device)
"Return bluetooth device address from a given bluetooth DEVICE name."
(when (stringp device)