emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] emacs-24 b1ea160: Handle watching of several files in the


From: Michael Albinus
Subject: [Emacs-diffs] emacs-24 b1ea160: Handle watching of several files in the same directory for inotify.
Date: Tue, 13 Jan 2015 10:26:59 +0000

branch: emacs-24
commit b1ea16072864ed532377c6ea43198a8604890715
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    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 fb8dfba0..3ce3b20 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,15 @@
+2015-01-13  Michael Albinus  <address@hidden>
+
+       * 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  <address@hidden>
 
         * comint.el (comint-history-isearch-search)
diff --git a/lisp/filenotify.el b/lisp/filenotify.el
index 35181b6..18d93d1 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 d23c750..3afb487 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))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]