; Fix breakage from previous commit

[gnu-emacs] / lisp / filenotify.el

diff --git a/lisp/filenotify.el b/lisp/filenotify.el
index 72ee0ced785ef8c3ee5e55bf84748b293d6e7cb4..61b6d240e6eada9c487a829241a013ecf9ab2101 100644 (file)
--- a/lisp/filenotify.el
+++ b/lisp/filenotify.el
@@ -1,6 +1,6 @@
-;;; filenotify.el --- watch files for changes on disk
+;;; filenotify.el --- watch files for changes on disk  -*- lexical-binding:t -*-

 
 

-;; Copyright (C) 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2016 Free Software Foundation, Inc.

 
 ;; Author: Michael Albinus <michael.albinus@gmx.de>
 
 
 ;; Author: Michael Albinus <michael.albinus@gmx.de>
 


@@ -22,15 +22,18 @@
 ;;; Commentary
 
 ;; This package is an abstraction layer from the different low-level
 ;;; Commentary
 
 ;; This package is an abstraction layer from the different low-level

-;; file notification packages `gfilenotify', `inotify' and
+;; file notification packages `inotify', `kqueue', `gfilenotify' and

 ;; `w32notify'.
 
 ;;; Code:
 
 ;; `w32notify'.
 
 ;;; Code:
 

+(require 'cl-lib)
+

 (defconst file-notify--library
   (cond
 (defconst file-notify--library
   (cond

-   ((featurep 'gfilenotify) 'gfilenotify)

    ((featurep 'inotify) 'inotify)
    ((featurep 'inotify) 'inotify)

+   ((featurep 'kqueue) 'kqueue)
+   ((featurep 'gfilenotify) 'gfilenotify)

    ((featurep 'w32notify) 'w32notify))
   "Non-nil when Emacs has been compiled with file notification support.
 The value is the name of the low-level file notification package
    ((featurep 'w32notify) 'w32notify))
   "Non-nil when Emacs has been compiled with file notification support.
 The value is the name of the low-level file notification package


@@ -40,40 +43,85 @@ could use another implementation.")
 (defvar file-notify-descriptors (make-hash-table :test 'equal)
   "Hash table for registered file notification descriptors.
 A key in this hash table is the descriptor as returned from
 (defvar file-notify-descriptors (make-hash-table :test 'equal)
   "Hash table for registered file notification descriptors.
 A key in this hash table is the descriptor as returned from

-`gfilenotify', `inotify', `w32notify' or a file name handler.
-The value in the hash table is the cons cell (DIR FILE CALLBACK).")
-
-;; This function is used by `gfilenotify', `inotify' and `w32notify' events.
+`inotify', `kqueue', `gfilenotify', `w32notify' or a file name
+handler.  The value in the hash table is a list
+
+  (DIR (FILE . CALLBACK) (FILE . CALLBACK) ...)
+
+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))
+         (registered (gethash desc file-notify-descriptors))
+        (file (if (consp descriptor) (cdr descriptor) (cl-caadr registered)))
+        (dir (car registered)))
+
+    (when (consp registered)
+      ;; Send `stopped' event.
+      (funcall
+       (cdr (assoc file (cdr registered)))
+       `(,descriptor stopped ,(if file (expand-file-name file 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 `inotify', `kqueue', `gfilenotify' and
+;; `w32notify' events.

 ;;;###autoload
 (defun file-notify-handle-event (event)
   "Handle file system monitoring event.
 ;;;###autoload
 (defun file-notify-handle-event (event)
   "Handle file system monitoring event.

-If EVENT is a filewatch event, call its callback.
+If EVENT is a filewatch event, call its callback.  It has the format
+
+  (file-notify (DESCRIPTOR ACTIONS FILE [FILE1-OR-COOKIE]) CALLBACK)
+

 Otherwise, signal a `file-notify-error'."
   (interactive "e")
 Otherwise, signal a `file-notify-error'."
   (interactive "e")

+  ;;(message "file-notify-handle-event %S" event)

   (if (and (eq (car event) 'file-notify)
           (>= (length event) 3))
       (funcall (nth 2 event) (nth 1 event))
     (signal 'file-notify-error
            (cons "Not a valid file-notify event" event))))
 
   (if (and (eq (car event) 'file-notify)
           (>= (length event) 3))
       (funcall (nth 2 event) (nth 1 event))
     (signal 'file-notify-error
            (cons "Not a valid file-notify event" event))))
 

-(defvar file-notify--pending-events nil
-  "List of pending file notification events for a future `renamed' action.
-The entries are a list (DESCRIPTOR ACTION FILE COOKIE).  ACTION
-is either `moved-from' or `renamed-from'.")
+;; Needed for `inotify' and `w32notify'.  In the latter case, COOKIE is nil.
+(defvar file-notify--pending-event nil
+  "A pending file notification events for a future `renamed' action.
+It is a form ((DESCRIPTOR ACTION FILE [FILE1-OR-COOKIE]) CALLBACK).")
+
+(defun file-notify--event-watched-file (event)
+  "Return file or directory being watched.
+Could be different from the directory watched by the backend library."
+  (let* ((desc (if (consp (car event)) (caar event) (car event)))
+         (registered (gethash desc file-notify-descriptors))
+        (file (if (consp (car event)) (cdar event) (cl-caadr registered)))
+        (dir (car registered)))
+    (if file (expand-file-name file dir) dir)))

 
 (defun file-notify--event-file-name (event)
   "Return file name of file notification event, or nil."
 
 (defun file-notify--event-file-name (event)
   "Return file name of file notification event, or nil."

-  (expand-file-name
-   (or  (and (stringp (nth 2 event)) (nth 2 event)) "")
-   (car (gethash (car event) file-notify-descriptors))))
+  (directory-file-name
+   (expand-file-name
+    (or  (and (stringp (nth 2 event)) (nth 2 event)) "")
+    (car (gethash (car event) file-notify-descriptors)))))

 
 ;; Only `gfilenotify' could return two file names.
 (defun file-notify--event-file1-name (event)
   "Return second file name of file notification event, or nil.
 This is available in case a file has been moved."
   (and (stringp (nth 3 event))
 
 ;; Only `gfilenotify' could return two file names.
 (defun file-notify--event-file1-name (event)
   "Return second file name of file notification event, or nil.
 This is available in case a file has been moved."
   (and (stringp (nth 3 event))

-       (expand-file-name
-       (nth 3 event) (car (gethash (car event) file-notify-descriptors)))))
+       (directory-file-name
+        (expand-file-name
+         (nth 3 event) (car (gethash (car event) file-notify-descriptors))))))

 
 ;; Cookies are offered by `inotify' only.
 (defun file-notify--event-cookie (event)
 
 ;; Cookies are offered by `inotify' only.
 (defun file-notify--event-cookie (event)


@@ -81,115 +129,164 @@ This is available in case a file has been moved."
 This is available in case a file has been moved."
   (nth 3 event))
 
 This is available in case a file has been moved."
   (nth 3 event))
 

+;; `inotify' returns the same descriptor when the file (directory)
+;; uses the same inode.  We want to distinguish, and apply a virtual
+;; descriptor which make the difference.
+(defun file-notify--descriptor (desc file)
+  "Return the descriptor to be used in `file-notify-*-watch'.
+For `gfilenotify' and `w32notify' it is the same descriptor as
+used in the low-level file notification package."
+  (if (and (natnump desc) (eq file-notify--library 'inotify))
+      (cons desc
+            (and (stringp file)
+                 (car (assoc
+                       (file-name-nondirectory file)
+                       (gethash desc file-notify-descriptors)))))
+    desc))
+

 ;; The callback function used to map between specific flags of the
 ;; respective file notifications, and the ones we return.
 (defun file-notify-callback (event)
   "Handle an EVENT returned from file notification.
 ;; The callback function used to map between specific flags of the
 ;; respective file notifications, and the ones we return.
 (defun file-notify-callback (event)
   "Handle an EVENT returned from file notification.

-EVENT is the same one as in `file-notify-handle-event' except the
-car of that event, which is the symbol `file-notify'."
+EVENT is the cadr of the event in `file-notify-handle-event'
+\(DESCRIPTOR ACTIONS FILE [FILE1-OR-COOKIE])."

   (let* ((desc (car event))
         (registered (gethash desc file-notify-descriptors))
   (let* ((desc (car event))
         (registered (gethash desc file-notify-descriptors))

-        (pending-event (assoc desc file-notify--pending-events))

         (actions (nth 1 event))
         (file (file-notify--event-file-name event))
         (actions (nth 1 event))
         (file (file-notify--event-file-name event))

-        file1 callback)
+        file1 callback pending-event stopped)

 
     ;; Make actions a list.
     (unless (consp actions) (setq actions (cons actions nil)))
 
 
     ;; Make actions a list.
     (unless (consp actions) (setq actions (cons actions nil)))
 

-    ;; Check, that event is meant for us.
-    (unless (setq callback (nth 2 registered))
-      (setq actions nil))
-
-    ;; Loop over actions.  In fact, more than one action happens only
-    ;; for `inotify'.
-    (dolist (action actions)
-
-      ;; Send pending event, if it doesn't match.
-      (when (and pending-event
-                ;; The cookie doesn't match.
-                (not (eq (file-notify--event-cookie pending-event)
-                         (file-notify--event-cookie event)))
-                (or
-                 ;; inotify.
-                 (and (eq (nth 1 pending-event) 'moved-from)
-                      (not (eq action 'moved-to)))
-                 ;; w32notify.
-                 (and (eq (nth 1 pending-event) 'renamed-from)
-                      (not (eq action 'renamed-to)))))
-       (funcall callback
-                (list desc 'deleted
-                      (file-notify--event-file-name pending-event)))
-       (setq file-notify--pending-events
-             (delete pending-event file-notify--pending-events)))
-
-      ;; Map action.  We ignore all events which cannot be mapped.
-      (setq action
-           (cond
-            ;; gfilenotify.
-            ((memq action '(attribute-changed changed created deleted)) action)
-            ((eq action 'moved)
-             (setq file1 (file-notify--event-file1-name event))
-             'renamed)
-
-            ;; inotify.
-            ((eq action 'attrib) 'attribute-changed)
-            ((eq action 'create) 'created)
-            ((eq action 'modify) 'changed)
-            ((memq action '(delete 'delete-self move-self)) 'deleted)
-            ;; Make the event pending.
-            ((eq action 'moved-from)
-             (add-to-list 'file-notify--pending-events
-                          (list desc action file
-                                (file-notify--event-cookie event)))
-             nil)
-            ;; Look for pending event.
-            ((eq action 'moved-to)
-             (if (null pending-event)
-                 'created
-               (setq file1 file
-                     file (file-notify--event-file-name pending-event)
-                     file-notify--pending-events
-                     (delete pending-event file-notify--pending-events))
-               'renamed))
-
-            ;; w32notify.
-            ((eq action 'added) 'created)
-            ((eq action 'modified) 'changed)
-            ((eq action 'removed) 'deleted)
-            ;; Make the event pending.
-            ((eq 'renamed-from action)
-             (add-to-list 'file-notify--pending-events
-                          (list desc action file
-                                (file-notify--event-cookie event)))
-             nil)
-            ;; Look for pending event.
-            ((eq 'renamed-to action)
-             (if (null pending-event)
-                 'created
-               (setq file1 file
-                     file (file-notify--event-file-name pending-event)
-                     file-notify--pending-events
-                     (delete pending-event file-notify--pending-events))
-               'renamed))))
-
-      ;; Apply callback.
-      (when (and action
-                (or
-                 ;; If there is no relative file name for that watch,
-                 ;; we watch the whole directory.
-                 (null (nth 1 registered))
-                 ;; File matches.
-                 (string-equal
-                  (nth 1 registered) (file-name-nondirectory file))
-                 ;; File1 matches.
-                 (and (stringp file1)
-                      (string-equal
-                       (nth 1 registered) (file-name-nondirectory file1)))))
-       (if file1
-           (funcall callback (list desc action file file1))
-         (funcall callback (list desc action file)))))))
-
+    ;; Loop over registered entries.  In fact, more than one entry
+    ;; happens only for `inotify'.
+    (dolist (entry (cdr registered))
+
+      ;; Check, that event is meant for us.
+      (unless (setq callback (cdr entry))
+       (setq actions nil))
+
+      ;; Loop over actions.  In fact, more than one action happens only
+      ;; for `inotify' and `kqueue'.
+      (dolist (action actions)
+
+       ;; Send pending event, if it doesn't match.
+       (when (and file-notify--pending-event
+                  ;; The cookie doesn't match.
+                  (not (eq (file-notify--event-cookie
+                             (car file-notify--pending-event))
+                           (file-notify--event-cookie event)))
+                  (or
+                   ;; inotify.
+                   (and (eq (nth 1 (car file-notify--pending-event))
+                             'moved-from)
+                        (not (eq action 'moved-to)))
+                   ;; w32notify.
+                   (and (eq (nth 1 (car file-notify--pending-event))
+                             'renamed-from)
+                        (not (eq action 'renamed-to)))))
+          (setq pending-event file-notify--pending-event
+                file-notify--pending-event nil)
+          (setcar (cdar pending-event) 'deleted))
+
+       ;; Map action.  We ignore all events which cannot be mapped.
+       (setq action
+             (cond
+              ((memq action
+                      '(attribute-changed changed created deleted renamed))
+               action)
+              ((memq action '(moved rename))
+               ;; The kqueue rename event does not return file1 in
+               ;; case a file monitor is established.
+               (if (setq file1 (file-notify--event-file1-name event))
+                   'renamed 'deleted))
+              ((eq action 'ignored)
+                (setq stopped t actions nil))
+              ((memq action '(attrib link)) 'attribute-changed)
+              ((memq action '(create added)) 'created)
+              ((memq action '(modify modified write)) 'changed)
+              ((memq action '(delete delete-self move-self removed)) 'deleted)
+              ;; Make the event pending.
+              ((memq action '(moved-from renamed-from))
+               (setq file-notify--pending-event
+                      `((,desc ,action ,file ,(file-notify--event-cookie event))
+                        ,callback))
+               nil)
+              ;; Look for pending event.
+              ((memq action '(moved-to renamed-to))
+               (if (null file-notify--pending-event)
+                   'created
+                 (setq file1 file
+                       file (file-notify--event-file-name
+                              (car file-notify--pending-event)))
+                  ;; If the source is handled by another watch, we
+                  ;; must fire the rename event there as well.
+                  (when (not (equal (file-notify--descriptor desc file1)
+                                    (file-notify--descriptor
+                                     (caar file-notify--pending-event)
+                                     (file-notify--event-file-name
+                                      file-notify--pending-event))))
+                    (setq pending-event
+                          `((,(caar file-notify--pending-event)
+                             renamed ,file ,file1)
+                            ,(cadr file-notify--pending-event))))
+                  (setq file-notify--pending-event nil)
+                  'renamed))))
+
+        ;; Apply pending callback.
+        (when pending-event
+          (setcar
+           (car pending-event)
+           (file-notify--descriptor
+            (caar pending-event)
+            (file-notify--event-file-name file-notify--pending-event)))
+          (funcall (cadr pending-event) (car pending-event))
+          (setq pending-event nil))
+
+       ;; Apply callback.
+       (when (and action
+                  (or
+                   ;; If there is no relative file name for that watch,
+                   ;; we watch the whole directory.
+                   (null (nth 0 entry))
+                   ;; File matches.
+                   (string-equal
+                    (nth 0 entry) (file-name-nondirectory file))
+                   ;; Directory matches.
+                   (string-equal
+                    (file-name-nondirectory file)
+                    (file-name-nondirectory (car registered)))
+                   ;; File1 matches.
+                   (and (stringp file1)
+                        (string-equal
+                         (nth 0 entry) (file-name-nondirectory file1)))))
+          ;;(message
+           ;;"file-notify-callback %S %S %S %S %S"
+           ;;(file-notify--descriptor desc (car entry))
+           ;;action file file1 registered)
+         (if file1
+             (funcall
+              callback
+              `(,(file-notify--descriptor desc (car entry))
+                 ,action ,file ,file1))
+           (funcall
+            callback
+            `(,(file-notify--descriptor desc (car entry)) ,action ,file))))
+
+        ;; Send `stopped' event.
+        (when (or stopped
+                  (and (memq action '(deleted renamed))
+                       ;; Not, when a file is backed up.
+                       (not (and (stringp file1) (backup-file-name-p file1)))
+                       ;; Watched file or directory is concerned.
+                       (string-equal
+                        file (file-notify--event-watched-file event))))
+          (file-notify-rm-watch (file-notify--descriptor desc (car entry))))))))
+
+;; `kqueue', `gfilenotify' and `w32notify' return a unique descriptor
+;; for every `file-notify-add-watch', while `inotify' returns a unique
+;; descriptor per inode only.

 (defun file-notify-add-watch (file flags callback)
   "Add a watch for filesystem events pertaining to FILE.
 This arranges for filesystem events pertaining to FILE to be reported
 (defun file-notify-add-watch (file flags callback)
   "Add a watch for filesystem events pertaining to FILE.
 This arranges for filesystem events pertaining to FILE to be reported


@@ -206,7 +303,7 @@ include the following symbols:
   `attribute-change' -- watch for file attributes changes, like
                         permissions or modification time
 
   `attribute-change' -- watch for file attributes changes, like
                         permissions or modification time
 

-If FILE is a directory, 'change' watches for file creation or
+If FILE is a directory, `change' watches for file creation or

 deletion in that directory.  This does not work recursively.
 
 When any event happens, Emacs will call the CALLBACK function passing
 deletion in that directory.  This does not work recursively.
 
 When any event happens, Emacs will call the CALLBACK function passing


@@ -223,99 +320,151 @@ following:
   `changed'           -- FILE has changed
   `renamed'           -- FILE has been renamed to FILE1
   `attribute-changed' -- a FILE attribute was changed
   `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)
 
 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)))))
   (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)
   (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
               (if (file-directory-p file)
                   file
                 (file-name-directory file))))
 
   (let* ((handler (find-file-name-handler file 'file-notify-add-watch))
         (dir (directory-file-name
               (if (file-directory-p file)
                   file
                 (file-name-directory file))))

-       desc func l-flags)
-
-    ;; Check, whether this has been registered already.
-;    (maphash
-;     (lambda (key value)
-;       (when (equal (cons file callback) value) (setq desc key)))
-;     file-notify-descriptors)
-
-    (unless desc
-      (if handler
-         ;; A file name handler could exist even if there is no local
-         ;; file notification support.
-         (setq desc (funcall
-                     handler 'file-notify-add-watch dir flags callback))
-
-       ;; Check, whether Emacs has been compiled with file
-       ;; notification support.
-       (unless file-notify--library
-         (signal 'file-notify-error
-                 '("No file notification package available")))
-
-       ;; Determine low-level function to be called.
-       (setq func
-             (cond
-              ((eq file-notify--library 'gfilenotify) 'gfile-add-watch)
-              ((eq file-notify--library 'inotify) 'inotify-add-watch)
-              ((eq file-notify--library 'w32notify) 'w32notify-add-watch)))
-
-       ;; Determine respective flags.
-       (if (eq file-notify--library 'gfilenotify)
-           (setq l-flags '(watch-mounts send-moved))
-         (when (memq 'change flags)
-           (setq
-            l-flags
-            (cond
-             ((eq file-notify--library 'inotify) '(create modify move delete))
-             ((eq file-notify--library 'w32notify)
-              '(file-name directory-name size last-write-time)))))
-         (when (memq 'attribute-change flags)
-           (add-to-list
-            'l-flags
-            (cond
-             ((eq file-notify--library 'inotify) 'attrib)
-             ((eq file-notify--library 'w32notify) 'attributes)))))
-
-       ;; Call low-level function.
-       (setq desc (funcall func dir l-flags 'file-notify-callback))))
+       desc func l-flags registered entry)
+
+    (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.
+       (setq desc (funcall
+                   handler 'file-notify-add-watch
+                    ;; kqueue does not report file changes in
+                    ;; directory monitor.  So we must watch the file
+                    ;; itself.
+                    (if (eq file-notify--library 'kqueue) file dir)
+                    flags callback))
+
+      ;; Check, whether Emacs has been compiled with file notification
+      ;; support.
+      (unless file-notify--library
+       (signal 'file-notify-error
+               '("No file notification package available")))
+
+      ;; Determine low-level function to be called.
+      (setq func
+           (cond
+            ((eq file-notify--library 'inotify) 'inotify-add-watch)
+            ((eq file-notify--library 'kqueue) 'kqueue-add-watch)
+            ((eq file-notify--library 'gfilenotify) 'gfile-add-watch)
+            ((eq file-notify--library 'w32notify) 'w32notify-add-watch)))
+
+      ;; Determine respective flags.
+      (if (eq file-notify--library 'gfilenotify)
+         (setq l-flags (append '(watch-mounts send-moved) flags))
+       (when (memq 'change flags)
+         (setq
+          l-flags
+          (cond
+           ((eq file-notify--library 'inotify)
+            '(create delete delete-self modify move-self move))
+           ((eq file-notify--library 'kqueue)
+            '(create delete write extend rename))
+           ((eq file-notify--library 'w32notify)
+            '(file-name directory-name size last-write-time)))))
+       (when (memq 'attribute-change flags)
+         (push (cond
+                 ((eq file-notify--library 'inotify) 'attrib)
+                 ((eq file-notify--library 'kqueue) 'attrib)
+                 ((eq file-notify--library 'w32notify) 'attributes))
+                l-flags)))
+
+      ;; Call low-level function.
+      (setq desc (funcall
+                  func (if (eq file-notify--library 'kqueue) file dir)
+                  l-flags 'file-notify-callback)))
+
+    ;; Modify `file-notify-descriptors'.
+    (setq file (unless (file-directory-p file) (file-name-nondirectory file))
+         desc (if (consp desc) (car desc) desc)
+         registered (gethash desc file-notify-descriptors)
+         entry `(,file . ,callback))
+    (unless (member entry (cdr registered))
+      (puthash desc `(,dir ,entry . ,(cdr registered)) file-notify-descriptors))

 
     ;; Return descriptor.
 
     ;; Return descriptor.

-    (puthash desc
-             (list (directory-file-name
-                   (if (file-directory-p dir) dir (file-name-directory dir)))
-                   (unless (file-directory-p file)
-                    (file-name-nondirectory file))
-                  callback)
-             file-notify-descriptors)
-    desc))
+    (file-notify--descriptor desc file)))

 
 (defun file-notify-rm-watch (descriptor)
   "Remove an existing watch specified by its DESCRIPTOR.
 DESCRIPTOR should be an object returned by `file-notify-add-watch'."
 
 (defun file-notify-rm-watch (descriptor)
   "Remove an existing watch specified by its DESCRIPTOR.
 DESCRIPTOR should be an object returned by `file-notify-add-watch'."

-  (let ((file (car (gethash descriptor file-notify-descriptors)))
-       handler)
-
-    (when (stringp file)
-      (setq handler (find-file-name-handler file 'file-notify-rm-watch))
-      (if handler
-         (funcall handler 'file-notify-rm-watch descriptor)
-       (funcall
-        (cond
-         ((eq file-notify--library 'gfilenotify) 'gfile-rm-watch)
-         ((eq file-notify--library 'inotify) 'inotify-rm-watch)
-         ((eq file-notify--library 'w32notify) 'w32notify-rm-watch))
-        descriptor)))
-
-    (remhash descriptor file-notify-descriptors)))
+  (let* ((desc (if (consp descriptor) (car descriptor) descriptor))
+        (file (if (consp descriptor) (cdr descriptor)))
+         (registered (gethash desc file-notify-descriptors))
+        (dir (car registered))
+        (handler (and (stringp dir)
+                       (find-file-name-handler dir 'file-notify-rm-watch))))
+
+    (when (stringp dir)
+      ;; Call low-level function.
+      (when (or (not file)
+                (and (= (length (cdr registered)) 1)
+                     (assoc file (cdr registered))))
+        (condition-case nil
+            (if handler
+                ;; A file name handler could exist even if there is no local
+                ;; file notification support.
+                (funcall handler 'file-notify-rm-watch descriptor)
+
+              (funcall
+               (cond
+                ((eq file-notify--library 'inotify) 'inotify-rm-watch)
+                ((eq file-notify--library 'kqueue) 'kqueue-rm-watch)
+                ((eq file-notify--library 'gfilenotify) 'gfile-rm-watch)
+                ((eq file-notify--library 'w32notify) 'w32notify-rm-watch))
+               desc))
+          (file-notify-error nil)))
+
+      ;; Modify `file-notify-descriptors'.
+      (file-notify--rm-descriptor descriptor))))
+
+(defun file-notify-valid-p (descriptor)
+  "Check a watch specified by its DESCRIPTOR.
+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)))
+         (registered (gethash desc file-notify-descriptors))
+        (dir (car registered))
+        handler)
+
+    (when (stringp dir)
+      (setq handler (find-file-name-handler dir 'file-notify-valid-p))
+
+      (and (or ;; It is a directory.
+               (not file)
+               ;; The file is registered.
+               (assoc file (cdr registered)))
+           (if handler
+               ;; A file name handler could exist even if there is no
+               ;; local file notification support.
+               (funcall handler 'file-notify-valid-p descriptor)
+             (funcall
+              (cond
+               ((eq file-notify--library 'inotify) 'inotify-valid-p)
+               ((eq file-notify--library 'kqueue) 'kqueue-valid-p)
+               ((eq file-notify--library 'gfilenotify) 'gfile-valid-p)
+               ((eq file-notify--library 'w32notify) 'w32notify-valid-p))
+              desc))
+           t))))

 
 ;; The end:
 (provide 'filenotify)
 
 ;; The end:
 (provide 'filenotify)