Commit b1ea1607 authored by Michael Albinus's avatar Michael Albinus

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.
parent 67edddfc
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)
......
......@@ -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)
......
......@@ -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))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment