Handle watching of several files in the same directory for inotify.

Fixes: debbugs:18880

* filenotify.el (file-notify-descriptors, file-notify-handle-event):
Adapt docstring.
(file-notify--descriptor): New defun.
(file-notify-callback, file-notify-add-watch, file-notify-rm-watch):
Adapt docstring.  Handle multiple values for
`file-notify-descriptors' entries.

* net/tramp.el (tramp-handle-file-notify-rm-watch): Do not check
`file-notify-descriptors', the implementation has been changed.

lisp/ChangeLog

@@ -1,3 +1,15 @@
+2015-01-13  Michael Albinus  <michael.albinus@gmx.de>
+
+	* filenotify.el (file-notify-descriptors, file-notify-handle-event):
+	Adapt docstring.
+	(file-notify--descriptor): New defun.
+	(file-notify-callback, file-notify-add-watch, file-notify-rm-watch):
+	Adapt docstring.  Handle multiple values for
+	`file-notify-descriptors' entries.  (Bug#18880)
+
+	* net/tramp.el (tramp-handle-file-notify-rm-watch): Do not check
+	`file-notify-descriptors', the implementation has been changed.
+
 2015-01-13  Juri Linkov  <juri@linkov.net>
 
         * comint.el (comint-history-isearch-search)

lisp/filenotify.el

@@ -41,13 +41,21 @@ could use another implementation.")
   "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).")
+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.")
 
 ;; This function is used by `gfilenotify', `inotify' and `w32notify' events.
 ;;;###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 COOKIE) CALLBACK)
+
 Otherwise, signal a `file-notify-error'."
   (interactive "e")
   (if (and (eq (car event) 'file-notify)
@@ -81,12 +89,23 @@ This is available in case a file has been moved."
 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 (descriptor 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 (eq file-notify--library 'inotify)
+      (cons descriptor file)
+    descriptor))
+
 ;; 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
+EVENT is the cdr of the event in `file-notify-handle-event'
-car of that event, which is the symbol `file-notify'."
+\(DESCRIPTOR ACTIONS FILE COOKIE)."
   (let* ((desc (car event))
 	 (registered (gethash desc file-notify-descriptors))
 	 (pending-event (assoc desc file-notify--pending-events))
@@ -97,99 +116,113 @@ car of that event, which is the symbol `file-notify'."
     ;; Make actions a list.
     (unless (consp actions) (setq actions (cons actions nil)))
 
-    ;; Check, that event is meant for us.
+    ;; Loop over registered entries.  In fact, more than one entry
-    (unless (setq callback (nth 2 registered))
+    ;; happens only for `inotify'.
-      (setq actions nil))
+    (dolist (entry (cdr registered))
 
-    ;; Loop over actions.  In fact, more than one action happens only
+      ;; Check, that event is meant for us.
-    ;; for `inotify'.
+      (unless (setq callback (cdr entry))
-    (dolist (action actions)
+	(setq actions nil))
 
-      ;; Send pending event, if it doesn't match.
+      ;; Loop over actions.  In fact, more than one action happens only
-      (when (and pending-event
+      ;; for `inotify'.
-		 ;; The cookie doesn't match.
+      (dolist (action actions)
-		 (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.
+	;; Send pending event, if it doesn't match.
-      (setq action
+	(when (and pending-event
-	    (cond
+		   ;; The cookie doesn't match.
-	     ;; gfilenotify.
+		   (not (eq (file-notify--event-cookie pending-event)
-	     ((memq action '(attribute-changed changed created deleted)) action)
+			    (file-notify--event-cookie event)))
-	     ((eq action 'moved)
+		   (or
-	      (setq file1 (file-notify--event-file1-name event))
+		    ;; inotify.
-	      'renamed)
+		    (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)))
 
-	     ;; inotify.
+	;; Map action.  We ignore all events which cannot be mapped.
-	     ((eq action 'attrib) 'attribute-changed)
+	(setq action
-	     ((eq action 'create) 'created)
+	      (cond
-	     ((eq action 'modify) 'changed)
+	       ;; gfilenotify.
-	     ((memq action '(delete 'delete-self move-self)) 'deleted)
+	       ((memq action '(attribute-changed changed created deleted))
-	     ;; Make the event pending.
+		action)
-	     ((eq action 'moved-from)
+	       ((eq action 'moved)
-	      (add-to-list 'file-notify--pending-events
+		(setq file1 (file-notify--event-file1-name event))
-			   (list desc action file
+		'renamed)
-				 (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.
+	       ;; inotify.
-	     ((eq action 'added) 'created)
+	       ((eq action 'attrib) 'attribute-changed)
-	     ((eq action 'modified) 'changed)
+	       ((eq action 'create) 'created)
-	     ((eq action 'removed) 'deleted)
+	       ((eq action 'modify) 'changed)
-	     ;; Make the event pending.
+	       ((memq action '(delete 'delete-self move-self)) 'deleted)
-	     ((eq 'renamed-from action)
+	       ;; Make the event pending.
-	      (add-to-list 'file-notify--pending-events
+	       ((eq action 'moved-from)
-			   (list desc action file
+		(add-to-list 'file-notify--pending-events
-				 (file-notify--event-cookie event)))
+			     (list desc action file
-	      nil)
+				   (file-notify--event-cookie event)))
-	     ;; Look for pending event.
+		nil)
-	     ((eq 'renamed-to action)
+	       ;; Look for pending event.
-	      (if (null pending-event)
+	       ((eq action 'moved-to)
-		  'created
+		(if (null pending-event)
-		(setq file1 file
+		    'created
-		      file (file-notify--event-file-name pending-event)
+		  (setq file1 file
-		      file-notify--pending-events
+			file (file-notify--event-file-name pending-event)
-		      (delete pending-event file-notify--pending-events))
+			file-notify--pending-events
-		'renamed))))
+			(delete pending-event file-notify--pending-events))
+		  'renamed))
 
-      ;; Apply callback.
+	       ;; w32notify.
-      (when (and action
+	       ((eq action 'added) 'created)
-		 (or
+	       ((eq action 'modified) 'changed)
-		  ;; If there is no relative file name for that watch,
+	       ((eq action 'removed) 'deleted)
-		  ;; we watch the whole directory.
+	       ;; Make the event pending.
-		  (null (nth 1 registered))
+	       ((eq action 'renamed-from)
-		  ;; File matches.
+		(add-to-list 'file-notify--pending-events
-		  (string-equal
+			     (list desc action file
-		   (nth 1 registered) (file-name-nondirectory file))
+				   (file-notify--event-cookie event)))
-		  ;; File1 matches.
+		nil)
-		  (and (stringp file1)
+	       ;; Look for pending event.
-		       (string-equal
+	       ((eq action 'renamed-to)
-			(nth 1 registered) (file-name-nondirectory file1)))))
+		(if (null pending-event)
-	(if file1
+		    'created
-	    (funcall callback (list desc action file file1))
+		  (setq file1 file
-	  (funcall callback (list desc action 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 0 entry))
+		    ;; File matches.
+		    (string-equal
+		     (nth 0 entry) (file-name-nondirectory file))
+		    ;; File1 matches.
+		    (and (stringp file1)
+			 (string-equal
+			  (nth 0 entry) (file-name-nondirectory file1)))))
+	  (if file1
+	      (funcall
+	       callback
+	       `(,(file-notify--descriptor desc (nth 0 entry))
+		 ,action ,file ,file1))
+	    (funcall
+	     callback
+	     `(,(file-notify--descriptor desc (nth 0 entry))
+	       ,action ,file))))))))
+
+;; `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
@@ -206,7 +239,7 @@ include the following symbols:
   `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
@@ -240,82 +273,96 @@ FILE is the name of the file whose event is being reported."
 	       (if (file-directory-p file)
 		   file
 		 (file-name-directory file))))
-	desc func l-flags)
+	desc func l-flags registered)
 
-    ;; Check, whether this has been registered already.
+    (if handler
-;    (maphash
+	;; A file name handler could exist even if there is no local
-;     (lambda (key value)
+	;; file notification support.
-;       (when (equal (cons file callback) value) (setq desc key)))
+	(setq desc (funcall
-;     file-notify-descriptors)
+		    handler 'file-notify-add-watch dir flags callback))
 
-    (unless desc
+      ;; Check, whether Emacs has been compiled with file
-      (if handler
+      ;; notification support.
-	  ;; A file name handler could exist even if there is no local
+      (unless file-notify--library
-	  ;; file notification support.
+	(signal 'file-notify-error
-	  (setq desc (funcall
+		'("No file notification package available")))
-		      handler 'file-notify-add-watch dir flags callback))
 
-	;; Check, whether Emacs has been compiled with file
+      ;; Determine low-level function to be called.
-	;; notification support.
+      (setq func
-	(unless file-notify--library
+	    (cond
-	  (signal 'file-notify-error
+	     ((eq file-notify--library 'gfilenotify) 'gfile-add-watch)
-		  '("No file notification package available")))
+	     ((eq file-notify--library 'inotify) 'inotify-add-watch)
+	     ((eq file-notify--library 'w32notify) 'w32notify-add-watch)))
 
-	;; Determine low-level function to be called.
+      ;; Determine respective flags.
-	(setq func
+      (if (eq file-notify--library 'gfilenotify)
-	      (cond
+	  (setq l-flags '(watch-mounts send-moved))
-	       ((eq file-notify--library 'gfilenotify) 'gfile-add-watch)
+	(when (memq 'change flags)
-	       ((eq file-notify--library 'inotify) 'inotify-add-watch)
+	  (setq
-	       ((eq file-notify--library 'w32notify) 'w32notify-add-watch)))
+	   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)))))
 
-	;; Determine respective flags.
+      ;; Call low-level function.
-	(if (eq file-notify--library 'gfilenotify)
+      (setq desc (funcall func dir l-flags 'file-notify-callback)))
-	    (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.
+    ;; Modify `file-notify-descriptors'.
-	(setq desc (funcall func dir l-flags 'file-notify-callback))))
+    (setq registered (gethash desc file-notify-descriptors))
+    (puthash
+     desc
+     `(,dir
+       (,(unless (file-directory-p file) (file-name-nondirectory file))
+	. ,callback)
+       . ,(cdr registered))
+     file-notify-descriptors)
 
     ;; Return descriptor.
-    (puthash desc
+    (file-notify--descriptor
-             (list (directory-file-name
+     desc (unless (file-directory-p file) (file-name-nondirectory file)))))
-		    (if (file-directory-p dir) dir (file-name-directory dir)))
-                   (unless (file-directory-p file)
-		     (file-name-nondirectory file))
-		   callback)
-             file-notify-descriptors)
-    desc))
 
 (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)))
+  (let* ((desc (if (consp descriptor) (car descriptor) descriptor))
-	handler)
+	 (file (if (consp descriptor) (cdr descriptor)))
+	 (dir (car (gethash desc file-notify-descriptors)))
+	 handler registered)
 
-    (when (stringp file)
+    (when (stringp dir)
-      (setq handler (find-file-name-handler file 'file-notify-rm-watch))
+      (setq handler (find-file-name-handler dir '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)))
+      ;; Modify `file-notify-descriptors'.
+      (if (not file)
+	  (remhash desc file-notify-descriptors)
+
+	(setq registered (gethash 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)))
+
+      ;; Call low-level function.
+      (when (null (cdr registered))
+	(if handler
+	    ;; A file name handler could exist even if there is no local
+	    ;; file notification support.
+	    (funcall handler 'file-notify-rm-watch desc)
+
+	  (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))
+	   desc))))))
 
 ;; The end:
 (provide 'filenotify)

lisp/net/tramp.el

@@ -64,7 +64,6 @@
 (defvar bkup-backup-directory-info)
 (defvar directory-sep-char)
 (defvar eshell-path-env)
-(defvar file-notify-descriptors)
 (defvar ls-lisp-use-insert-directory-program)
 (defvar outline-regexp)
 
@@ -3415,7 +3414,7 @@ of."
 (defun tramp-handle-file-notify-rm-watch (proc)
   "Like `file-notify-rm-watch' for Tramp files."
   ;; The descriptor must be a process object.
-  (unless (and (processp proc) (gethash proc file-notify-descriptors))
+  (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))