[Emacs-diffs] master ab116b1: Introduce `stopped' event in file notification

[Michael Albinus]

branch: master
commit ab116b19eda6bf42b11f7b902c749a77d7cb7683
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    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 b9f59de..55d9028 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 8441d6d..56b4f69 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)