From b1ea16072864ed532377c6ea43198a8604890715 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 13 Jan 2015 11:26:39 +0100 Subject: [PATCH] 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 | 12 ++ lisp/filenotify.el | 383 +++++++++++++++++++++++++-------------------- lisp/net/tramp.el | 3 +- 3 files changed, 228 insertions(+), 170 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index fb8dfba05d5..3ce3b202466 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,15 @@ +2015-01-13 Michael Albinus + + * 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 * comint.el (comint-history-isearch-search) diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 35181b63f3a..18d93d16c87 100644 --- a/lisp/filenotify.el +++ b/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 -car of that event, which is the symbol `file-notify'." +EVENT is the cdr of the event in `file-notify-handle-event' +\(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. - (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'. + (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 action 'renamed-from) + (add-to-list 'file-notify--pending-events + (list desc action file + (file-notify--event-cookie event))) + nil) + ;; Look for pending event. + ((eq action 'renamed-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)))) + + ;; 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) - - ;; 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) + + (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))) + + ;; Modify `file-notify-descriptors'. + (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 - (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 (unless (file-directory-p file) (file-name-nondirectory 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'." - (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))) + (dir (car (gethash desc file-notify-descriptors))) + handler registered) + + (when (stringp dir) + (setq handler (find-file-name-handler dir 'file-notify-rm-watch)) + + ;; 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) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index d23c750fb99..3afb487ec3d 100644 --- a/lisp/net/tramp.el +++ b/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)) -- 2.39.2