From ab116b19eda6bf42b11f7b902c749a77d7cb7683 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 25 Oct 2015 14:18:17 +0100 Subject: [PATCH] Introduce `stopped' event in file notification * lisp/filenotify.el (file-notify--rm-descriptor): New defun. (file-notify-rm-watch): Use it. (file-notify-callback): Implement `stopped' event. (file-notify-add-watch): Mention `stopped' in the docstring. Check, that upper directory exists. * test/automated/file-notify-tests.el (file-notify-test01-add-watch): Add two test cases. (file-notify-test02-events): Handle also `stopped' event. (file-notify-test04-file-validity): Add another test case. --- lisp/filenotify.el | 73 ++++++++++++++----- test/automated/file-notify-tests.el | 108 ++++++++++++++++++++-------- 2 files changed, 134 insertions(+), 47 deletions(-) diff --git a/lisp/filenotify.el b/lisp/filenotify.el index b9f59dedfde..55d9028f252 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -48,6 +48,33 @@ The value in the hash table is a list Several values for a given DIR happen only for `inotify', when different files from the same directory are watched.") +(defun file-notify--rm-descriptor (descriptor) + "Remove DESCRIPTOR from `file-notify-descriptors'. +DESCRIPTOR should be an object returned by `file-notify-add-watch'. +If it is registered in `file-notify-descriptors', a stopped event is sent." + (let* ((desc (if (consp descriptor) (car descriptor) descriptor)) + (file (if (consp descriptor) (cdr descriptor))) + (registered (gethash desc file-notify-descriptors)) + (dir (car registered))) + + (when (consp registered) + ;; Send `stopped' event. + (dolist (entry (cdr registered)) + (funcall (cdr entry) + `(,(file-notify--descriptor desc) stopped + ,(or (and (stringp (car entry)) + (expand-file-name (car entry) dir)) + dir)))) + + ;; Modify `file-notify-descriptors'. + (if (not file) + (remhash desc file-notify-descriptors) + (setcdr registered + (delete (assoc file (cdr registered)) (cdr registered))) + (if (null (cdr registered)) + (remhash desc file-notify-descriptors) + (puthash desc registered file-notify-descriptors)))))) + ;; This function is used by `gfilenotify', `inotify' and `w32notify' events. ;;;###autoload (defun file-notify-handle-event (event) @@ -111,7 +138,7 @@ EVENT is the cadr of the event in `file-notify-handle-event' (registered (gethash desc file-notify-descriptors)) (actions (nth 1 event)) (file (file-notify--event-file-name event)) - file1 callback pending-event) + file1 callback pending-event stopped) ;; Make actions a list. (unless (consp actions) (setq actions (cons actions nil))) @@ -158,6 +185,8 @@ EVENT is the cadr of the event in `file-notify-handle-event' 'renamed) ;; inotify, w32notify. + ((eq action 'ignored) + (setq stopped t actions nil)) ((eq action 'attrib) 'attribute-changed) ((memq action '(create added)) 'created) ((memq action '(modify modified)) 'changed) @@ -194,6 +223,17 @@ EVENT is the cadr of the event in `file-notify-handle-event' (funcall (cadr pending-event) (car pending-event)) (setq pending-event nil)) + ;; Check for stopped. + (setq + stopped + (or + stopped + (and + (memq action '(deleted renamed)) + (= (length (cdr registered)) 1) + (string-equal + (or (file-name-nondirectory file) "") (car (cadr registered)))))) + ;; Apply callback. (when (and action (or @@ -213,7 +253,11 @@ EVENT is the cadr of the event in `file-notify-handle-event' `(,(file-notify--descriptor desc) ,action ,file ,file1)) (funcall callback - `(,(file-notify--descriptor desc) ,action ,file)))))))) + `(,(file-notify--descriptor desc) ,action ,file))))) + + ;; Modify `file-notify-descriptors'. + (when stopped + (file-notify--rm-descriptor (file-notify--descriptor desc)))))) ;; `gfilenotify' and `w32notify' return a unique descriptor for every ;; `file-notify-add-watch', while `inotify' returns a unique @@ -251,17 +295,18 @@ following: `changed' -- FILE has changed `renamed' -- FILE has been renamed to FILE1 `attribute-changed' -- a FILE attribute was changed + `stopped' -- watching FILE has been stopped FILE is the name of the file whose event is being reported." ;; Check arguments. (unless (stringp file) - (signal 'wrong-type-argument (list file))) + (signal 'wrong-type-argument `(,file))) (setq file (expand-file-name file)) (unless (and (consp flags) (null (delq 'change (delq 'attribute-change (copy-tree flags))))) - (signal 'wrong-type-argument (list flags))) + (signal 'wrong-type-argument `(,flags))) (unless (functionp callback) - (signal 'wrong-type-argument (list callback))) + (signal 'wrong-type-argument `(,callback))) (let* ((handler (find-file-name-handler file 'file-notify-add-watch)) (dir (directory-file-name @@ -270,6 +315,9 @@ FILE is the name of the file whose event is being reported." (file-name-directory file)))) desc func l-flags registered) + (unless (file-directory-p dir) + (signal 'file-notify-error `("Directory does not exist" ,dir))) + (if handler ;; A file name handler could exist even if there is no local ;; file notification support. @@ -326,10 +374,10 @@ FILE is the name of the file whose event is being reported." DESCRIPTOR should be an object returned by `file-notify-add-watch'." (let* ((desc (if (consp descriptor) (car descriptor) descriptor)) (file (if (consp descriptor) (cdr descriptor))) - (dir (car (gethash desc file-notify-descriptors))) + (registered (gethash desc file-notify-descriptors)) + (dir (car registered)) (handler (and (stringp dir) - (find-file-name-handler dir 'file-notify-rm-watch))) - (registered (gethash desc file-notify-descriptors))) + (find-file-name-handler dir 'file-notify-rm-watch)))) (when (stringp dir) ;; Call low-level function. @@ -351,14 +399,7 @@ DESCRIPTOR should be an object returned by `file-notify-add-watch'." (file-notify-error nil))) ;; Modify `file-notify-descriptors'. - (if (not file) - (remhash desc file-notify-descriptors) - - (setcdr registered - (delete (assoc file (cdr registered)) (cdr registered))) - (if (null (cdr registered)) - (remhash desc file-notify-descriptors) - (puthash desc registered file-notify-descriptors)))))) + (file-notify--rm-descriptor descriptor)))) (defun file-notify-valid-p (descriptor) "Check a watch specified by its DESCRIPTOR. diff --git a/test/automated/file-notify-tests.el b/test/automated/file-notify-tests.el index 8441d6d7468..56b4f69597d 100644 --- a/test/automated/file-notify-tests.el +++ b/test/automated/file-notify-tests.el @@ -83,11 +83,11 @@ (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) - (setq file-notify--test-desc nil) - (setq file-notify--test-results nil) - (setq file-notify--test-events nil) + (setq file-notify--test-tmpfile nil + file-notify--test-tmpfile1 nil + file-notify--test-desc nil + file-notify--test-results nil + file-notify--test-events nil) (when file-notify--test-event (error "file-notify--test-event should not be set but bound dynamically"))) @@ -166,6 +166,11 @@ being the result.") (ert-deftest file-notify-test01-add-watch () "Check `file-notify-add-watch'." (skip-unless (file-notify--test-local-enabled)) + + (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) + file-notify--test-tmpfile1 + (format "%s/%s" file-notify--test-tmpfile (md5 (current-time-string)))) + ;; Check, that different valid parameters are accepted. (should (setq file-notify--test-desc @@ -181,6 +186,12 @@ being the result.") (file-notify-add-watch temporary-file-directory '(change attribute-change) 'ignore))) (file-notify-rm-watch file-notify--test-desc) + ;; The file does not need to exist, just the upper directory. + (should + (setq file-notify--test-desc + (file-notify-add-watch + file-notify--test-tmpfile '(change attribute-change) 'ignore))) + (file-notify-rm-watch file-notify--test-desc) ;; Check error handling. (should-error (file-notify-add-watch 1 2 3 4) @@ -197,6 +208,13 @@ being the result.") (equal (should-error (file-notify-add-watch temporary-file-directory '(change) 3)) '(wrong-type-argument 3))) + ;; The upper directory of a file must exist. + (should + (equal (should-error + (file-notify-add-watch + file-notify--test-tmpfile1 '(change attribute-change) 'ignore)) + `(file-notify-error + "Directory does not exist" ,file-notify--test-tmpfile))) ;; Cleanup. (file-notify--test-cleanup)) @@ -230,8 +248,8 @@ and the event to `file-notify--test-events'." (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 + (append file-notify--test-events `(,file-notify--test-event)) + file-notify--test-results (append file-notify--test-results `(,result))))) (defun file-notify--test-make-temp-name () @@ -273,7 +291,7 @@ Don't wait longer than TIMEOUT seconds for the events to be delivered." file-notify--test-tmpfile '(change) 'file-notify--test-event-handler)) (file-notify--test-with-events - (file-notify--test-timeout) '(created changed deleted) + (file-notify--test-timeout) '(created changed deleted stopped) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) (delete-file file-notify--test-tmpfile)) @@ -290,8 +308,8 @@ Don't wait longer than TIMEOUT seconds for the events to be delivered." ;; w32notify does not distinguish between `changed' and ;; `attribute-changed'. (if (eq file-notify--library 'w32notify) - '(created changed changed deleted) - '(created changed deleted)) + '(created changed changed deleted stopped) + '(created changed deleted stopped)) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) (copy-file file-notify--test-tmpfile file-notify--test-tmpfile1) @@ -310,7 +328,7 @@ Don't wait longer than TIMEOUT seconds for the events to be delivered." '(change) 'file-notify--test-event-handler)) (should file-notify--test-desc) (file-notify--test-with-events - (file-notify--test-timeout) '(created changed renamed) + (file-notify--test-timeout) '(created changed renamed stopped) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) (rename-file file-notify--test-tmpfile file-notify--test-tmpfile1) @@ -335,11 +353,11 @@ Don't wait longer than TIMEOUT seconds for the events to be delivered." ;; Otherwise, not all events arrive us in the remote case. (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) - (sleep-for 0.1) + (read-event nil nil 0.1) (set-file-modes file-notify--test-tmpfile 000) - (sleep-for 0.1) + (read-event nil nil 0.1) (set-file-times file-notify--test-tmpfile '(0 0)) - (sleep-for 0.1) + (read-event nil nil 0.1) (delete-file file-notify--test-tmpfile)) (file-notify-rm-watch file-notify--test-desc)) @@ -348,18 +366,19 @@ Don't wait longer than TIMEOUT seconds for the events to be delivered." (should (equal (mapcar #'cadr file-notify--test-events) (if (eq file-notify--library 'w32notify) - '(created changed deleted - created changed changed deleted - created changed renamed) + '(created changed deleted stopped + created changed changed deleted stopped + created changed renamed stopped) (if (file-remote-p temporary-file-directory) - '(created changed deleted - created changed deleted - created changed renamed - attribute-changed attribute-changed attribute-changed) - '(created changed deleted - created changed deleted - created changed renamed - attribute-changed attribute-changed))))) + '(created changed deleted stopped + created changed deleted stopped + created changed renamed stopped + attribute-changed attribute-changed + attribute-changed stopped) + '(created changed deleted stopped + created changed deleted stopped + created changed renamed stopped + attribute-changed attribute-changed stopped))))) (should file-notify--test-results) (dolist (result file-notify--test-results) ;;(message "%s" (ert-test-result-messages result)) @@ -438,8 +457,8 @@ Don't wait longer than TIMEOUT seconds for the events to be delivered." (unwind-protect (progn - (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)) - (setq file-notify--test-desc + (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) + file-notify--test-desc (file-notify-add-watch file-notify--test-tmpfile '(change) #'file-notify--test-event-handler)) @@ -452,6 +471,33 @@ Don't wait longer than TIMEOUT seconds for the events to be delivered." ;; After removing the watch, the descriptor must not be valid ;; anymore. (file-notify-rm-watch file-notify--test-desc) + (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))) + + ;; Cleanup. + (file-notify--test-cleanup)) + + (unwind-protect + (progn + (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) + file-notify--test-desc + (file-notify-add-watch + file-notify--test-tmpfile + '(change) #'file-notify--test-event-handler)) + (file-notify--test-with-events + (file-notify--test-timeout) '(created changed) + (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 deleting the file, the descriptor must not be valid + ;; anymore. + (delete-file file-notify--test-tmpfile) + (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))) ;; Cleanup. @@ -463,8 +509,8 @@ Don't wait longer than TIMEOUT seconds for the events to be delivered." (unless (and noninteractive (eq file-notify--library 'w32notify)) (let ((temporary-file-directory (make-temp-file "file-notify-test-parent" t))) - (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)) - (setq file-notify--test-desc + (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) + file-notify--test-desc (file-notify-add-watch file-notify--test-tmpfile '(change) #'file-notify--test-event-handler)) @@ -474,8 +520,8 @@ Don't wait longer than TIMEOUT seconds for the events to be delivered." (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) (should (file-notify-valid-p file-notify--test-desc))) - ;; After deleting the parent, the descriptor must not be valid - ;; anymore. + ;; After deleting the parent, the descriptor must not be + ;; valid anymore. (delete-directory temporary-file-directory t) (file-notify--wait-for-events (file-notify--test-timeout) -- 2.39.5