mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-26 07:33:47 +00:00
Improve file notifications, especially for Tramp
* doc/lispref/files.texi (Magic File Names): Mention `file-notify-valid-p'. * doc/lispref/os.texi (File Notifications): Describe `file-notify-valid-p'. * etc/NEWS: Add `file-notify-valid-p'. * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-notify-add-watch): Improve implementation. (tramp-gvfs-monitor-file-process-filter): Rename from `tramp-gvfs-file-gvfs-monitor-file-process-filter'. Delete process if appropriate. * lisp/net/tramp-sh.el (tramp-sh-handle-file-notify-add-watch): Improve implementation. (tramp-sh-gvfs-monitor-dir-process-filter): Rename from `tramp-sh-file-gvfs-monitor-dir-process-filter'. Delete process if appropriate. (tramp-sh-inotifywait-process-filter): Rename from `tramp-sh-file-inotifywait-process-filter'. Delete process if appropriate. * lisp/net/tramp.el (tramp-handle-file-notify-rm-watch): Use `delete-process' (tramp-handle-file-notify-valid-p): Check also, that file or directory to be watched still exists. * test/automated/file-notify-tests.el (file-notify--test-timeout): New defun. Use it at all places a timeout is needed. (file-notify--test-cleanup): Delete directories recursively. Cleanup also Tramp connections. (file-notify-test02-events): Add tests for `attribute-change'. (file-notify-test04-file-validity, file-notify-test05-dir-validity): Add tests for `file-notify-rm-watch'.
This commit is contained in:
Michael Albinus
parent
ab11a1cf27
commit
f5bdcb3221
@ -2854,6 +2854,7 @@ first, before handlers for jobs such as remote file access.
|
||||
@code{file-name-nondirectory},
|
||||
@code{file-name-sans-versions}, @code{file-newer-than-file-p},
|
||||
@code{file-notify-add-watch}, @code{file-notify-rm-watch},
|
||||
@code{file-notify-valid-p},
|
||||
@code{file-ownership-preserved-p},
|
||||
@code{file-readable-p}, @code{file-regular-p},
|
||||
@code{file-remote-p}, @code{file-selinux-context},
|
||||
@ -2907,6 +2908,7 @@ first, before handlers for jobs such as remote file access.
|
||||
@code{file-name-nondirec@discretionary{}{}{}tory},
|
||||
@code{file-name-sans-versions}, @code{file-newer-than-file-p},
|
||||
@code{file-notify-add-watch}, @code{file-notify-rm-watch},
|
||||
@code{file-notify-valid-p},
|
||||
@code{file-ownership-pre@discretionary{}{}{}served-p},
|
||||
@code{file-readable-p}, @code{file-regular-p},
|
||||
@code{file-remote-p}, @code{file-selinux-context},
|
||||
|
||||
@ -2692,6 +2692,17 @@ Removes an existing file watch specified by its @var{descriptor}.
|
||||
@code{file-notify-add-watch}.
|
||||
@end defun
|
||||
|
||||
@defun file-notify-valid-p descriptor
|
||||
Checks a watch specified by its @var{descriptor} for validity.
|
||||
@var{descriptor} should be an object returned by
|
||||
@code{file-notify-add-watch}.
|
||||
|
||||
A watch can become invalid if the file or directory it watches is
|
||||
deleted, or if the watcher thread exits abnormally for any other
|
||||
reason. Removing the watch by calling @code{file-notify-rm-watch}
|
||||
also makes it invalid.
|
||||
@end defun
|
||||
|
||||
@node Dynamic Libraries
|
||||
@section Dynamically Loaded Libraries
|
||||
@cindex dynamic libraries
|
||||
|
||||
13
etc/NEWS
13
etc/NEWS
@ -412,7 +412,6 @@ the old behavior -- *shell* buffer displays in current window -- use
|
||||
(add-to-list 'display-buffer-alist
|
||||
'("^\\*shell\\*$" . (display-buffer-same-window))).
|
||||
|
||||
|
||||
** EIEIO
|
||||
+++
|
||||
*** The `:protection' slot option is not obeyed any more.
|
||||
@ -657,11 +656,17 @@ plist will contain a :peer element that has the output of
|
||||
|
||||
** Tramp
|
||||
|
||||
+++
|
||||
*** New connection method "nc", which allows to access dumb busyboxes.
|
||||
|
||||
+++
|
||||
*** Method-specific parameters can be overwritten now with variable
|
||||
`tramp-connection-properties'.
|
||||
|
||||
---
|
||||
*** Handler for `file-notify-valid-p' for remote machines that support
|
||||
filesystem notifications.
|
||||
|
||||
** SQL mode
|
||||
|
||||
*** New user variable `sql-default-directory' enables remote
|
||||
@ -822,9 +827,15 @@ make the new option `eshell-destroy-buffer-when-process-dies' non-nil.
|
||||
** tar-mode: new `tar-new-entry' command, allowing for new members to
|
||||
be added to the archive.
|
||||
|
||||
---
|
||||
** Autorevert: dired buffers are also auto-reverted via file
|
||||
notifications, if Emacs is compiled with file notification support.
|
||||
|
||||
+++
|
||||
** File Notifications: the new function `file-notify-valid-p' checks,
|
||||
whether a file notification descriptor still corresponds to an
|
||||
activate watch.
|
||||
|
||||
** Obsolete packages
|
||||
|
||||
---
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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:
|
||||
|
||||
|
||||
@ -61,6 +61,8 @@
|
||||
(defvar file-notify--test-results nil)
|
||||
(defvar file-notify--test-event nil)
|
||||
(defvar file-notify--test-events nil)
|
||||
(defun file-notify--test-timeout ()
|
||||
(if (file-remote-p temporary-file-directory) 6 3))
|
||||
|
||||
(defun file-notify--test-cleanup ()
|
||||
"Cleanup after a test."
|
||||
@ -69,13 +71,16 @@
|
||||
(when (and file-notify--test-tmpfile
|
||||
(file-exists-p file-notify--test-tmpfile))
|
||||
(if (directory-name-p file-notify--test-tmpfile)
|
||||
(delete-directory file-notify--test-tmpfile)
|
||||
(delete-directory file-notify--test-tmpfile 'recursive)
|
||||
(delete-file file-notify--test-tmpfile)))
|
||||
(when (and file-notify--test-tmpfile1
|
||||
(file-exists-p file-notify--test-tmpfile1))
|
||||
(if (directory-name-p file-notify--test-tmpfile1)
|
||||
(delete-directory file-notify--test-tmpfile1)
|
||||
(delete-directory file-notify--test-tmpfile1 'recursive)
|
||||
(delete-file file-notify--test-tmpfile1)))
|
||||
(when (file-remote-p temporary-file-directory)
|
||||
(tramp-cleanup-connection
|
||||
(tramp-dissect-file-name temporary-file-directory) nil 'keep-password))
|
||||
|
||||
(setq file-notify--test-tmpfile nil)
|
||||
(setq file-notify--test-tmpfile1 nil)
|
||||
@ -150,6 +155,8 @@ being the result.")
|
||||
(should
|
||||
(setq file-notify--test-desc
|
||||
(file-notify-add-watch temporary-file-directory '(change) 'ignore)))
|
||||
|
||||
;; Cleanup.
|
||||
(file-notify--test-cleanup))
|
||||
|
||||
(file-notify--deftest-remote file-notify-test00-availability
|
||||
@ -190,6 +197,7 @@ being the result.")
|
||||
(file-notify-add-watch temporary-file-directory '(change) 3))
|
||||
'(wrong-type-argument 3)))
|
||||
|
||||
;; Cleanup.
|
||||
(file-notify--test-cleanup))
|
||||
|
||||
(file-notify--deftest-remote file-notify-test01-add-watch
|
||||
@ -215,11 +223,11 @@ is bound somewhere."
|
||||
|
||||
(defun file-notify--test-event-handler (event)
|
||||
"Run a test over FILE-NOTIFY--TEST-EVENT.
|
||||
For later analysis, append the test result to
|
||||
`file-notify--test-results' and the event to
|
||||
`file-notify--test-events'."
|
||||
For later analysis, append the test result to `file-notify--test-results'
|
||||
and the event to `file-notify--test-events'."
|
||||
(let* ((file-notify--test-event event)
|
||||
(result (ert-run-test (make-ert-test :body 'file-notify--test-event-test))))
|
||||
(result
|
||||
(ert-run-test (make-ert-test :body 'file-notify--test-event-test))))
|
||||
(setq file-notify--test-events
|
||||
(append file-notify--test-events `(,file-notify--test-event)))
|
||||
(setq file-notify--test-results
|
||||
@ -243,7 +251,7 @@ Don't wait longer than TIMEOUT seconds for the events to be delivered."
|
||||
(declare (indent 3))
|
||||
(let ((outer (make-symbol "outer")))
|
||||
`(let ((,outer file-notify--test-events))
|
||||
(let ((file-notify--test-events nil))
|
||||
(let (file-notify--test-events)
|
||||
,@body
|
||||
(file-notify--wait-for-events
|
||||
,timeout (= ,n (length file-notify--test-events)))
|
||||
@ -256,9 +264,7 @@ Don't wait longer than TIMEOUT seconds for the events to be delivered."
|
||||
(skip-unless (file-notify--test-local-enabled))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(setq file-notify--test-results nil
|
||||
file-notify--test-events nil
|
||||
file-notify--test-tmpfile (file-notify--test-make-temp-name)
|
||||
(setq file-notify--test-tmpfile (file-notify--test-make-temp-name)
|
||||
file-notify--test-tmpfile1 (file-notify--test-make-temp-name)
|
||||
file-notify--test-desc
|
||||
(file-notify-add-watch
|
||||
@ -268,41 +274,66 @@ Don't wait longer than TIMEOUT seconds for the events to be delivered."
|
||||
|
||||
;; Check creation, change, and deletion.
|
||||
(file-notify--test-with-events
|
||||
3 3 (lambda (events)
|
||||
(should (equal '(created changed deleted)
|
||||
(mapcar #'cadr events))))
|
||||
3 (file-notify--test-timeout)
|
||||
(lambda (events)
|
||||
(should (equal '(created changed deleted)
|
||||
(mapcar #'cadr events))))
|
||||
(write-region
|
||||
"any text" nil file-notify--test-tmpfile nil 'no-message)
|
||||
(delete-file file-notify--test-tmpfile))
|
||||
|
||||
;; Check copy.
|
||||
(file-notify--test-with-events
|
||||
3 3 (lambda (events)
|
||||
(should (equal '(created changed deleted)
|
||||
(mapcar #'cadr events))))
|
||||
3 (file-notify--test-timeout)
|
||||
(lambda (events)
|
||||
(should (equal '(created changed deleted)
|
||||
(mapcar #'cadr events))))
|
||||
(write-region
|
||||
"any text" nil file-notify--test-tmpfile nil 'no-message)
|
||||
(copy-file file-notify--test-tmpfile file-notify--test-tmpfile1)
|
||||
;; The next two events shall not be visible.
|
||||
(set-file-modes file-notify--test-tmpfile 000)
|
||||
(set-file-times file-notify--test-tmpfile '(0 0))
|
||||
(delete-file file-notify--test-tmpfile)
|
||||
(delete-file file-notify--test-tmpfile1))
|
||||
|
||||
;; Check rename.
|
||||
(file-notify--test-with-events
|
||||
3 3 (lambda (events)
|
||||
(should (equal '(created changed renamed)
|
||||
(mapcar #'cadr events))))
|
||||
3 (file-notify--test-timeout)
|
||||
(lambda (events)
|
||||
(should (equal '(created changed renamed)
|
||||
(mapcar #'cadr events))))
|
||||
(write-region
|
||||
"any text" nil file-notify--test-tmpfile nil 'no-message)
|
||||
(rename-file file-notify--test-tmpfile file-notify--test-tmpfile1)
|
||||
;; After the rename, we won't get events anymore.
|
||||
(delete-file file-notify--test-tmpfile1))
|
||||
|
||||
;; Check attribute change.
|
||||
(file-notify-rm-watch file-notify--test-desc)
|
||||
(setq file-notify--test-desc
|
||||
(file-notify-add-watch
|
||||
file-notify--test-tmpfile
|
||||
'(attribute-change) 'file-notify--test-event-handler))
|
||||
(file-notify--test-with-events
|
||||
2 (file-notify--test-timeout)
|
||||
(lambda (events)
|
||||
(should (equal '(attribute-changed attribute-changed)
|
||||
(mapcar #'cadr events))))
|
||||
(write-region
|
||||
"any text" nil file-notify--test-tmpfile nil 'no-message)
|
||||
(set-file-modes file-notify--test-tmpfile 000)
|
||||
(read-event nil nil 0.1) ; In order to distinguish the events.
|
||||
(set-file-times file-notify--test-tmpfile '(0 0))
|
||||
(delete-file file-notify--test-tmpfile))
|
||||
|
||||
;; Check the global sequence again just to make sure that
|
||||
;; `file-notify--test-events' has been set correctly.
|
||||
(should (equal (mapcar #'cadr file-notify--test-events)
|
||||
'(created changed deleted
|
||||
created changed deleted
|
||||
created changed renamed)))
|
||||
created changed renamed
|
||||
attribute-changed attribute-changed)))
|
||||
|
||||
(should file-notify--test-results)
|
||||
(dolist (result file-notify--test-results)
|
||||
@ -310,6 +341,8 @@ Don't wait longer than TIMEOUT seconds for the events to be delivered."
|
||||
(when (ert-test-failed-p result)
|
||||
(ert-fail
|
||||
(cadr (ert-test-result-with-condition-condition result))))))
|
||||
|
||||
;; Cleanup.
|
||||
(file-notify--test-cleanup)))
|
||||
|
||||
(file-notify--deftest-remote file-notify-test02-events
|
||||
@ -367,7 +400,7 @@ Don't wait longer than TIMEOUT seconds for the events to be delivered."
|
||||
(buffer-string))))
|
||||
(should (string-match "another text" (buffer-string)))))
|
||||
|
||||
;; Exit.
|
||||
;; Cleanup.
|
||||
(ignore-errors (kill-buffer buf))
|
||||
(file-notify--test-cleanup))))
|
||||
|
||||
@ -377,6 +410,31 @@ Don't wait longer than TIMEOUT seconds for the events to be delivered."
|
||||
(ert-deftest file-notify-test04-file-validity ()
|
||||
"Check `file-notify-valid-p' for files."
|
||||
(skip-unless (file-notify--test-local-enabled))
|
||||
|
||||
(unwind-protect
|
||||
(progn
|
||||
(setq file-notify--test-tmpfile (file-notify--test-make-temp-name))
|
||||
(setq file-notify--test-desc (file-notify-add-watch
|
||||
file-notify--test-tmpfile
|
||||
'(change)
|
||||
#'file-notify--test-event-handler))
|
||||
(file-notify--test-with-events
|
||||
2 (file-notify--test-timeout)
|
||||
(lambda (events)
|
||||
(should (equal '(created changed)
|
||||
(mapcar #'cadr events))))
|
||||
(should (file-notify-valid-p file-notify--test-desc))
|
||||
(write-region
|
||||
"any text" nil file-notify--test-tmpfile nil 'no-message)
|
||||
(should (file-notify-valid-p file-notify--test-desc)))
|
||||
;; After removing the watch, the descriptor must not be valid
|
||||
;; anymore.
|
||||
(file-notify-rm-watch file-notify--test-desc)
|
||||
(should-not (file-notify-valid-p file-notify--test-desc)))
|
||||
|
||||
;; Cleanup.
|
||||
(file-notify--test-cleanup))
|
||||
|
||||
;; The batch-mode operation of w32notify is fragile (there's no
|
||||
;; input threads to send the message to).
|
||||
(skip-unless (not (and noninteractive (eq file-notify--library 'w32notify))))
|
||||
@ -389,9 +447,10 @@ Don't wait longer than TIMEOUT seconds for the events to be delivered."
|
||||
'(change)
|
||||
#'file-notify--test-event-handler))
|
||||
(file-notify--test-with-events
|
||||
2 3 (lambda (events)
|
||||
(should (equal '(created changed)
|
||||
(mapcar #'cadr events))))
|
||||
2 (file-notify--test-timeout)
|
||||
(lambda (events)
|
||||
(should (equal '(created changed)
|
||||
(mapcar #'cadr events))))
|
||||
(should (file-notify-valid-p file-notify--test-desc))
|
||||
(write-region
|
||||
"any text" nil file-notify--test-tmpfile nil 'no-message)
|
||||
@ -399,10 +458,12 @@ Don't wait longer than TIMEOUT seconds for the events to be delivered."
|
||||
;; After deleting the parent, the descriptor must not be valid
|
||||
;; anymore.
|
||||
(delete-directory temporary-file-directory t)
|
||||
(read-event nil nil 0.5)
|
||||
(file-notify--wait-for-events
|
||||
(file-notify--test-timeout)
|
||||
(not (file-notify-valid-p file-notify--test-desc)))
|
||||
(should-not (file-notify-valid-p file-notify--test-desc)))
|
||||
|
||||
;; Exit.
|
||||
;; Cleanup.
|
||||
(file-notify--test-cleanup)))
|
||||
|
||||
(file-notify--deftest-remote file-notify-test04-file-validity
|
||||
@ -411,6 +472,25 @@ Don't wait longer than TIMEOUT seconds for the events to be delivered."
|
||||
(ert-deftest file-notify-test05-dir-validity ()
|
||||
"Check `file-notify-valid-p' for directories."
|
||||
(skip-unless (file-notify--test-local-enabled))
|
||||
|
||||
(unwind-protect
|
||||
(progn
|
||||
(setq file-notify--test-tmpfile (file-name-as-directory
|
||||
(file-notify--test-make-temp-name)))
|
||||
(make-directory file-notify--test-tmpfile)
|
||||
(setq file-notify--test-desc (file-notify-add-watch
|
||||
file-notify--test-tmpfile
|
||||
'(change)
|
||||
#'file-notify--test-event-handler))
|
||||
(should (file-notify-valid-p file-notify--test-desc))
|
||||
;; After removing the watch, the descriptor must not be valid
|
||||
;; anymore.
|
||||
(file-notify-rm-watch file-notify--test-desc)
|
||||
(should-not (file-notify-valid-p file-notify--test-desc)))
|
||||
|
||||
;; Cleanup.
|
||||
(file-notify--test-cleanup))
|
||||
|
||||
;; The batch-mode operation of w32notify is fragile (there's no
|
||||
;; input threads to send the message to).
|
||||
(skip-unless (not (and noninteractive (eq file-notify--library 'w32notify))))
|
||||
@ -424,13 +504,15 @@ Don't wait longer than TIMEOUT seconds for the events to be delivered."
|
||||
'(change)
|
||||
#'file-notify--test-event-handler))
|
||||
(should (file-notify-valid-p file-notify--test-desc))
|
||||
(delete-directory file-notify--test-tmpfile t)
|
||||
;; After deleting the directory, the descriptor must not be
|
||||
;; valid anymore.
|
||||
(read-event nil nil 0.5)
|
||||
(delete-directory file-notify--test-tmpfile t)
|
||||
(file-notify--wait-for-events
|
||||
(file-notify--test-timeout)
|
||||
(not (file-notify-valid-p file-notify--test-desc)))
|
||||
(should-not (file-notify-valid-p file-notify--test-desc)))
|
||||
|
||||
;; Exit.
|
||||
;; Cleanup.
|
||||
(file-notify--test-cleanup)))
|
||||
|
||||
(file-notify--deftest-remote file-notify-test05-dir-validity
|
||||
|
||||
Loading…
Reference in New Issue
Block a user