From: Michael Albinus Date: Sun, 11 Feb 2018 09:26:57 +0000 (+0100) Subject: Fix handling of file notifications in tramp-gvfs.el X-Git-Tag: emacs-27.0.90~5705 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=13f4b518d0bb7cb4536d341a2a2c8d0b76f75f6b;p=emacs.git Fix handling of file notifications in tramp-gvfs.el * lisp/net/tramp-archive.el (tramp-archive-dissect-file-name): Fix docstring. * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-notify-add-watch): Use consequently "gio monitor". (tramp-gvfs-monitor-process-filter): Rename from `tramp-gvfs-monitor-file-process-filter'. Adapt implementation. * lisp/net/tramp-sh.el (tramp-gio-events): Move this ... * lisp/net/tramp.el (tramp-gio-events): ... here. --- diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 5f28756d753..c859ca147e7 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -387,7 +387,7 @@ name of a local copy, if any.") (defun tramp-archive-dissect-file-name (name) "Return a `tramp-file-name' structure. The structure consists of the `tramp-archive-method' method, the -hexlified archive name as host, and the localname. The archive +hexified archive name as host, and the localname. The archive name is kept in slot `hop'" (save-match-data (unless (tramp-archive-file-name-p name) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 70ac077a7c5..eb3dddcd6c5 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1286,9 +1286,10 @@ If FILE-SYSTEM is non-nil, return file system attributes." "Like `file-notify-add-watch' for Tramp files." (setq file-name (expand-file-name file-name)) (with-parsed-tramp-file-name file-name nil - ;; We cannot watch directories, because `gvfs-monitor-dir' is not - ;; supported for gvfs-mounted directories. - (when (file-directory-p file-name) + ;; TODO: We cannot watch directories, because `gio monitor' is not + ;; supported for gvfs-mounted directories. However, + ;; `file-notify-add-watch' uses directories. + (when (or (not (tramp-gvfs-gio-tool-p v)) (file-directory-p file-name)) (tramp-error v 'file-notify-error "Monitoring not supported for `%s'" file-name)) (let* ((default-directory (file-name-directory file-name)) @@ -1303,9 +1304,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." (p (apply 'start-process "gvfs-monitor" (generate-new-buffer " *gvfs-monitor*") - (if (tramp-gvfs-gio-tool-p v) - `("gio" "monitor" ,(tramp-gvfs-url-file-name file-name)) - `("gvfs-monitor-file" (tramp-gvfs-url-file-name file-name)))))) + `("gio" "monitor" ,(tramp-gvfs-url-file-name file-name))))) (if (not (processp p)) (tramp-error v 'file-notify-error "Monitoring not supported for `%s'" file-name) @@ -1316,7 +1315,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." (process-put p 'watch-name localname) (process-put p 'adjust-window-size-function 'ignore) (set-process-query-on-exit-flag p nil) - (set-process-filter p 'tramp-gvfs-monitor-file-process-filter) + (set-process-filter p 'tramp-gvfs-monitor-process-filter) ;; There might be an error if the monitor is not supported. ;; Give the filter a chance to read the output. (tramp-accept-process-output p 1) @@ -1325,45 +1324,58 @@ If FILE-SYSTEM is non-nil, return file system attributes." p 'file-notify-error "Monitoring not supported for `%s'" file-name)) p)))) -(defun tramp-gvfs-monitor-file-process-filter (proc string) +(defun tramp-gvfs-monitor-process-filter (proc string) "Read output from \"gvfs-monitor-file\" and add corresponding \ file-notify events." - (let* ((rest-string (process-get proc 'rest-string)) + (let* ((events (process-get proc 'events)) + (rest-string (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)) - (when (string-match "Monitoring not supported" string) + ;; Fix action names. + string (replace-regexp-in-string + "attributes changed" "attribute-changed" string) + string (replace-regexp-in-string + "changes done" "changes-done-hint" string) + string (replace-regexp-in-string + "renamed to" "moved" string)) + ;; https://bugs.launchpad.net/bugs/1742946 + (when (string-match "Monitoring not supported\\|No locations given" string) (delete-process proc)) (while (string-match - (concat "^[\n\r]*" - "File Monitor Event:[\n\r]+" - "File = \\([^\n\r]+\\)[\n\r]+" - "Event = \\([^[:blank:]]+\\)[\n\r]+") + (concat "^.+:" + "[[:space:]]\\(.+\\):" + "[[:space:]]" (regexp-opt tramp-gio-events t) + "\\([[:space:]]\\(.+\\)\\)?$") string) + (let ((file (match-string 1 string)) - (action (intern-soft - (replace-regexp-in-string - "_" "-" (downcase (match-string 2 string)))))) + (file1 (match-string 4 string)) + (action (intern-soft (match-string 2 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))) + (setq file (url-unhex-string file))) + (when (string-match ddu (or file1 "")) + (setq file1 (replace-match dd nil nil file1))) + (while (string-match "%\\([0-9A-F]\\{2\\}\\)" (or file1 "")) + (setq file1 (url-unhex-string file1))) + ;; Remove watch when file or directory to be watched is deleted. + (when (and (member action '(moved deleted)) + (string-equal file (process-get proc 'watch-name))) + (delete-process proc)) ;; 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)))) + (when (member action events) + (tramp-compat-funcall + 'file-notify-callback (list proc action file file1))))) ;; Save rest of the string. (when (zerop (length string)) (setq string nil)) @@ -1483,7 +1495,7 @@ file-notify events." (defun tramp-gvfs-url-file-name (filename) "Return FILENAME in URL syntax." - ;; "/" must NOT be hexlified. + ;; "/" must NOT be hexified. (setq filename (tramp-compat-file-name-unquote filename)) (let ((url-unreserved-chars (cons ?/ url-unreserved-chars)) result) @@ -2352,7 +2364,7 @@ They are retrieved from the hal daemon." ;; * (Customizable) unmount when exiting Emacs. See tramp-archive.el. ;; * Host name completion for existing mount points (afp-server, -;; smb-server) or via smb-network. +;; smb-server, google-drive, owncloud) or via smb-network. ;; ;; * Check, how two shares of the same SMB server can be mounted in ;; parallel. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 25c00d180bb..ff5d404aaac 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3556,11 +3556,6 @@ Fall back to normal file name handler if no Tramp handler exists." ;; Default file name handlers, we don't care. (t (tramp-run-real-handler operation args))))))) -(defconst tramp-gio-events - '("attribute-changed" "changed" "changes-done-hint" - "created" "deleted" "moved" "pre-unmount" "unmounted") - "List of events \"gio monitor\" could send.") - (defun tramp-sh-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)) @@ -3665,13 +3660,12 @@ Fall back to normal file name handler if no Tramp handler exists." (when (string-match "Monitoring not supported\\|No locations given" string) (delete-process proc)) - (while - (string-match - (concat "^[^:]+:" - "[[:space:]]\\([^:]+\\):" - "[[:space:]]" (regexp-opt tramp-gio-events t) - "\\([[:space:]]\\([^:]+\\)\\)?$") - string) + (while (string-match + (concat "^[^:]+:" + "[[:space:]]\\([^:]+\\):" + "[[:space:]]" (regexp-opt tramp-gio-events t) + "\\([[:space:]]\\([^:]+\\)\\)?$") + string) (let* ((file (match-string 1 string)) (file1 (match-string 4 string)) @@ -3762,12 +3756,11 @@ file-notify events." (tramp-message proc 6 "%S\n%s" proc string) (dolist (line (split-string string "[\n\r]+" 'omit)) ;; Check, whether there is a problem. - (unless - (string-match - (concat "^[^[:blank:]]+" - "[[:blank:]]+\\([^[:blank:]]+\\)+" - "\\([[:blank:]]+\\([^\n\r]+\\)\\)?") - line) + (unless (string-match + (concat "^[^[:blank:]]+" + "[[:blank:]]+\\([^[:blank:]]+\\)+" + "\\([[:blank:]]+\\([^\n\r]+\\)\\)?") + line) (tramp-error proc 'file-notify-error "%s" line)) (let ((object diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index b2e20000d3f..618d026abde 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3623,10 +3623,16 @@ of." ;; only if that agrees with the buffer's record. (t (equal mt '(-1 65535))))))))) +;; This is used in tramp-gvfs.el and tramp-sh.el. +(defconst tramp-gio-events + '("attribute-changed" "changed" "changes-done-hint" + "created" "deleted" "moved" "pre-unmount" "unmounted") + "List of events \"gio monitor\" could send.") + +;; This is the default handler. tramp-gvfs.el and tramp-sh.el have +;; their own one. (defun tramp-handle-file-notify-add-watch (filename _flags _callback) "Like `file-notify-add-watch' for Tramp files." - ;; This is the default handler. tramp-gvfs.el and tramp-sh.el have - ;; their own one. (setq filename (expand-file-name filename)) (with-parsed-tramp-file-name filename nil (tramp-error