diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/net/tramp-gvfs.el | 49 | ||||
| -rw-r--r-- | lisp/net/tramp-sh.el | 60 | ||||
| -rw-r--r-- | lisp/net/tramp.el | 12 |
3 files changed, 84 insertions, 37 deletions
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index cf42b5951f7..b7b0a1c016f 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1003,27 +1003,48 @@ file names." v (concat localname filename) "file-name-all-completions" result)))))))) -(defun tramp-gvfs-handle-file-notify-add-watch (file-name _flags _callback) +(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)))) + ;; We cannot watch directories, because `gvfs-monitor-dir' is not + ;; supported for gvfs-mounted directories. + (when (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)) + (events + (cond + ((and (memq 'change flags) (memq 'attribute-change flags)) + '(created changed changes-done-hint moved deleted + attribute-changed)) + ((memq 'change flags) + '(created changed changes-done-hint moved deleted)) + ((memq 'attribute-change flags) '(attribute-changed)))) + (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") + v 'file-notify-error "Monitoring not supported for `%s'" file-name) (tramp-message v 6 "Run `%s', %S" (mapconcat 'identity (process-command p) " ") p) (tramp-set-connection-property p "vector" v) + (tramp-compat-process-put p 'events events) + (tramp-compat-process-put p 'watch-name localname) (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))) + (set-process-filter p 'tramp-gvfs-monitor-file-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) + (unless (memq (process-status p) '(run open)) + (tramp-error + v 'file-notify-error "Monitoring not supported for `%s'" 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." +(defun tramp-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)))) @@ -1034,6 +1055,8 @@ file names." ;; Attribute change is returned in unused wording. string (tramp-compat-replace-regexp-in-string "ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string)) + (when (string-match "Monitoring not supported" string) + (delete-process proc)) (while (string-match (concat "^[\n\r]*" @@ -1041,10 +1064,10 @@ file names." "File = \\([^\n\r]+\\)[\n\r]+" "Event = \\([^[:blank:]]+\\)[\n\r]+") string) - (let ((action (intern-soft + (let ((file (match-string 1 string)) + (action (intern-soft (tramp-compat-replace-regexp-in-string - "_" "-" (downcase (match-string 2 string))))) - (file (match-string 1 string))) + "_" "-" (downcase (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) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 206ddfbfb55..433b2ba09c7 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3722,12 +3722,12 @@ Fall back to normal file name handler if no Tramp handler exists." "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* ((default-directory (file-name-directory file-name)) - command events filter p sequence) + (let ((default-directory (file-name-directory file-name)) + command events filter p sequence) (cond ;; gvfs-monitor-dir. ((setq command (tramp-get-remote-gvfs-monitor-dir v)) - (setq filter 'tramp-sh-file-gvfs-monitor-dir-process-filter + (setq filter 'tramp-sh-gvfs-monitor-dir-process-filter events (cond ((and (memq 'change flags) (memq 'attribute-change flags)) @@ -3739,16 +3739,16 @@ Fall back to normal file name handler if no Tramp handler exists." sequence `(,command ,localname))) ;; inotifywait. ((setq command (tramp-get-remote-inotifywait v)) - (setq filter 'tramp-sh-file-inotifywait-process-filter + (setq filter 'tramp-sh-inotifywait-process-filter events (cond ((and (memq 'change flags) (memq 'attribute-change flags)) (concat "create,modify,move,moved_from,moved_to,move_self," - "delete,delete_self,attrib")) + "delete,delete_self,attrib,ignored")) ((memq 'change flags) (concat "create,modify,move,moved_from,moved_to,move_self," - "delete,delete_self")) - ((memq 'attribute-change flags) "attrib")) + "delete,delete_self,ignored")) + ((memq 'attribute-change flags) "attrib,ignored")) sequence `(,command "-mq" "-e" ,events ,localname))) ;; None. (t (tramp-error @@ -3770,13 +3770,20 @@ Fall back to normal file name handler if no Tramp handler exists." (mapconcat 'identity sequence " ")) (tramp-message v 6 "Run `%s', %S" (mapconcat 'identity sequence " ") p) (tramp-set-connection-property p "vector" v) - ;; Needed for `tramp-sh-file-gvfs-monitor-dir-process-filter'. + ;; Needed for `tramp-sh-gvfs-monitor-dir-process-filter'. (tramp-compat-process-put p 'events events) + (tramp-compat-process-put p 'watch-name localname) (tramp-compat-set-process-query-on-exit-flag p nil) (set-process-filter p 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) + (unless (memq (process-status p) '(run open)) + (tramp-error + v 'file-notify-error "Monitoring not supported for `%s'" file-name)) p)))) -(defun tramp-sh-file-gvfs-monitor-dir-process-filter (proc string) +(defun tramp-sh-gvfs-monitor-dir-process-filter (proc string) "Read output from \"gvfs-monitor-dir\" and add corresponding \ file-notify events." (let ((remote-prefix @@ -3790,6 +3797,8 @@ file-notify events." ;; Attribute change is returned in unused wording. string (tramp-compat-replace-regexp-in-string "ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string)) + (when (string-match "Monitoring not supported" string) + (delete-process proc)) (while (string-match (concat "^[\n\r]*" @@ -3798,18 +3807,24 @@ file-notify events." "\\(Other = \\([^\n\r]+\\)[\n\r]+\\)?" "Event = \\([^[:blank:]]+\\)[\n\r]+") string) - (let ((object - (list - proc - (intern-soft - (tramp-compat-replace-regexp-in-string - "_" "-" (downcase (match-string 4 string)))) - ;; File names are returned as absolute paths. We must - ;; add the remote prefix. - (concat remote-prefix (match-string 1 string)) - (when (match-string 3 string) - (concat remote-prefix (match-string 3 string)))))) + (let* ((file (match-string 1 string)) + (file1 (match-string 3 string)) + (object + (list + proc + (intern-soft + (tramp-compat-replace-regexp-in-string + "_" "-" (downcase (match-string 4 string)))) + ;; File names are returned as absolute paths. We must + ;; add the remote prefix. + (concat remote-prefix file) + (when file1 (concat remote-prefix file1))))) (setq string (replace-match "" nil nil string)) + ;; Remove watch when file or directory to be watched is deleted. + (when (and (member (cadr object) '(moved deleted)) + (string-equal + file (tramp-compat-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. @@ -3821,7 +3836,7 @@ file-notify events." (when string (tramp-message proc 10 "Rest string:\n%s" string)) (tramp-compat-process-put proc 'rest-string string))) -(defun tramp-sh-file-inotifywait-process-filter (proc string) +(defun tramp-sh-inotifywait-process-filter (proc string) "Read output from \"inotifywait\" and add corresponding file-notify events." (tramp-message proc 6 "%S\n%s" proc string) (dolist (line (split-string string "[\n\r]+" 'omit-nulls)) @@ -3843,6 +3858,9 @@ file-notify events." (tramp-compat-replace-regexp-in-string "_" "-" (downcase x)))) (split-string (match-string 1 line) "," 'omit-nulls)) (match-string 3 line)))) + ;; Remove watch when file or directory to be watched is deleted. + (when (equal (cadr object) 'ignored) + (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. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 9ec3226417c..fbb8c8a349e 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3407,7 +3407,7 @@ of." (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 - ;; its own one. + ;; their own one. (setq filename (expand-file-name filename)) (with-parsed-tramp-file-name filename nil (tramp-error @@ -3419,11 +3419,17 @@ of." (unless (processp proc) (tramp-error proc 'file-notify-error "Not a valid descriptor %S" proc)) (tramp-message proc 6 "Kill %S" proc) - (kill-process proc)) + (delete-process proc)) (defun tramp-handle-file-notify-valid-p (proc) "Like `file-notify-valid-p' for Tramp files." - (and proc (processp proc) (memq (process-status proc) '(run open)))) + (and proc (processp proc) (memq (process-status proc) '(run open)) + ;; Sometimes, the process is still in status `run' when the + ;; file or directory to be watched is deleted already. + (with-current-buffer (process-buffer proc) + (file-exists-p + (concat (file-remote-p default-directory) + (tramp-compat-process-get proc 'watch-name)))))) ;;; Functions for establishing connection: |