procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Introduce `stopped' event in file notification

Browse source 
* lisp/filenotify.el (file-notify--rm-descriptor): New defun.
(file-notify-rm-watch): Use it.
(file-notify-callback): Implement `stopped' event.
(file-notify-add-watch): Mention `stopped' in the docstring.
Check, that upper directory exists.

* test/automated/file-notify-tests.el (file-notify-test01-add-watch):
Add two test cases.
(file-notify-test02-events): Handle also `stopped' event.
(file-notify-test04-file-validity): Add another test case.
This commit is contained in:
Michael Albinus 2015-10-25 14:18:17 +01:00
parent 92c63c6552
commit ab116b19ed
2 changed files with 134 additions and 47 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

73
lisp/filenotify.el
View file

@ -48,6 +48,33 @@ The value in the hash table is a list
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))
(file (if (consp descriptor) (cdr descriptor)))
(registered (gethash desc file-notify-descriptors))
(dir (car registered)))
(when (consp registered)
;; Send `stopped' event.
(dolist (entry (cdr registered))
(funcall (cdr entry)
`(,(file-notify--descriptor desc) stopped
,(or (and (stringp (car entry))
(expand-file-name (car entry) 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 `gfilenotify', `inotify' and `w32notify' events.
;;;###autoload
(defun file-notify-handle-event (event)
@ -111,7 +138,7 @@ EVENT is the cadr of the event in `file-notify-handle-event'
(registered (gethash desc file-notify-descriptors))
(actions (nth 1 event))
(file (file-notify--event-file-name event))
file1 callback pending-event)
file1 callback pending-event stopped)
;; Make actions a list.
(unless (consp actions) (setq actions (cons actions nil)))
@ -158,6 +185,8 @@ EVENT is the cadr of the event in `file-notify-handle-event'
'renamed)
;; inotify, w32notify.
((eq action 'ignored)
(setq stopped t actions nil))
((eq action 'attrib) 'attribute-changed)
((memq action '(create added)) 'created)
((memq action '(modify modified)) 'changed)
@ -194,6 +223,17 @@ EVENT is the cadr of the event in `file-notify-handle-event'
(funcall (cadr pending-event) (car pending-event))
(setq pending-event nil))
;; Check for stopped.
(setq
stopped
(or
stopped
(and
(memq action '(deleted renamed))
(= (length (cdr registered)) 1)
(string-equal
(or (file-name-nondirectory file) "") (car (cadr registered))))))
;; Apply callback.
(when (and action
(or
@ -213,7 +253,11 @@ EVENT is the cadr of the event in `file-notify-handle-event'
`(,(file-notify--descriptor desc) ,action ,file ,file1))
(funcall
callback
`(,(file-notify--descriptor desc) ,action ,file))))))))
`(,(file-notify--descriptor desc) ,action ,file)))))
;; Modify `file-notify-descriptors'.
(when stopped
(file-notify--rm-descriptor (file-notify--descriptor desc))))))
;; `gfilenotify' and `w32notify' return a unique descriptor for every
;; `file-notify-add-watch', while `inotify' returns a unique
@ -251,17 +295,18 @@ following:
`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)
(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)))))
(signal 'wrong-type-argument (list flags)))
(signal 'wrong-type-argument `(,flags)))
(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
@ -270,6 +315,9 @@ FILE is the name of the file whose event is being reported."
(file-name-directory file))))
desc func l-flags registered)
(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.
@ -326,10 +374,10 @@ FILE is the name of the file whose event is being reported."
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)))
(dir (car (gethash desc file-notify-descriptors)))
(registered (gethash desc file-notify-descriptors))
(dir (car registered))
(handler (and (stringp dir)
(find-file-name-handler dir 'file-notify-rm-watch)))
(registered (gethash desc file-notify-descriptors)))
(find-file-name-handler dir 'file-notify-rm-watch))))
(when (stringp dir)
;; Call low-level function.
@ -351,14 +399,7 @@ DESCRIPTOR should be an object returned by `file-notify-add-watch'."
(file-notify-error nil)))
;; 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))))))
(file-notify--rm-descriptor descriptor))))
(defun file-notify-valid-p (descriptor)
"Check a watch specified by its DESCRIPTOR.

108
test/automated/file-notify-tests.el
View file

@ -83,11 +83,11 @@
(tramp-cleanup-connection
(tramp-dissect-file-name temporary-file-directory) nil 'keep-password))
(setq file-notify--test-tmpfile nil)
(setq file-notify--test-tmpfile1 nil)
(setq file-notify--test-desc nil)
(setq file-notify--test-results nil)
(setq file-notify--test-events nil)
(setq file-notify--test-tmpfile nil
file-notify--test-tmpfile1 nil
file-notify--test-desc nil
file-notify--test-results nil
file-notify--test-events nil)
(when file-notify--test-event
(error "file-notify--test-event should not be set but bound dynamically")))
@ -166,6 +166,11 @@ being the result.")
(ert-deftest file-notify-test01-add-watch ()
"Check `file-notify-add-watch'."
(skip-unless (file-notify--test-local-enabled))
(setq file-notify--test-tmpfile (file-notify--test-make-temp-name)
file-notify--test-tmpfile1
(format "%s/%s" file-notify--test-tmpfile (md5 (current-time-string))))
;; Check, that different valid parameters are accepted.
(should
(setq file-notify--test-desc
@ -181,6 +186,12 @@ being the result.")
(file-notify-add-watch
temporary-file-directory '(change attribute-change) 'ignore)))
(file-notify-rm-watch file-notify--test-desc)
;; The file does not need to exist, just the upper directory.
(should
(setq file-notify--test-desc
(file-notify-add-watch
file-notify--test-tmpfile '(change attribute-change) 'ignore)))
(file-notify-rm-watch file-notify--test-desc)
;; Check error handling.
(should-error (file-notify-add-watch 1 2 3 4)
@ -197,6 +208,13 @@ being the result.")
(equal (should-error
(file-notify-add-watch temporary-file-directory '(change) 3))
'(wrong-type-argument 3)))
;; The upper directory of a file must exist.
(should
(equal (should-error
(file-notify-add-watch
file-notify--test-tmpfile1 '(change attribute-change) 'ignore))
`(file-notify-error
"Directory does not exist" ,file-notify--test-tmpfile)))
;; Cleanup.
(file-notify--test-cleanup))
@ -230,8 +248,8 @@ and the event to `file-notify--test-events'."
(result
(ert-run-test (make-ert-test :body 'file-notify--test-event-test))))
(setq file-notify--test-events
(append file-notify--test-events `(,file-notify--test-event)))
(setq file-notify--test-results
(append file-notify--test-events `(,file-notify--test-event))
file-notify--test-results
(append file-notify--test-results `(,result)))))
(defun file-notify--test-make-temp-name ()
@ -273,7 +291,7 @@ Don't wait longer than TIMEOUT seconds for the events to be delivered."
file-notify--test-tmpfile
'(change) 'file-notify--test-event-handler))
(file-notify--test-with-events
(file-notify--test-timeout) '(created changed deleted)
(file-notify--test-timeout) '(created changed deleted stopped)
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
(delete-file file-notify--test-tmpfile))
@ -290,8 +308,8 @@ Don't wait longer than TIMEOUT seconds for the events to be delivered."
;; w32notify does not distinguish between `changed' and
;; `attribute-changed'.
(if (eq file-notify--library 'w32notify)
'(created changed changed deleted)
'(created changed deleted))
'(created changed changed deleted stopped)
'(created changed deleted stopped))
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
(copy-file file-notify--test-tmpfile file-notify--test-tmpfile1)
@ -310,7 +328,7 @@ Don't wait longer than TIMEOUT seconds for the events to be delivered."
'(change) 'file-notify--test-event-handler))
(should file-notify--test-desc)
(file-notify--test-with-events
(file-notify--test-timeout) '(created changed renamed)
(file-notify--test-timeout) '(created changed renamed stopped)
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
(rename-file file-notify--test-tmpfile file-notify--test-tmpfile1)
@ -335,11 +353,11 @@ Don't wait longer than TIMEOUT seconds for the events to be delivered."
;; Otherwise, not all events arrive us in the remote case.
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
(sleep-for 0.1)
(read-event nil nil 0.1)
(set-file-modes file-notify--test-tmpfile 000)
(sleep-for 0.1)
(read-event nil nil 0.1)
(set-file-times file-notify--test-tmpfile '(0 0))
(sleep-for 0.1)
(read-event nil nil 0.1)
(delete-file file-notify--test-tmpfile))
(file-notify-rm-watch file-notify--test-desc))
@ -348,18 +366,19 @@ Don't wait longer than TIMEOUT seconds for the events to be delivered."
(should (equal
(mapcar #'cadr file-notify--test-events)
(if (eq file-notify--library 'w32notify)
'(created changed deleted
created changed changed deleted
created changed renamed)
'(created changed deleted stopped
created changed changed deleted stopped
created changed renamed stopped)
(if (file-remote-p temporary-file-directory)
'(created changed deleted
created changed deleted
created changed renamed
attribute-changed attribute-changed attribute-changed)
'(created changed deleted
created changed deleted
created changed renamed
attribute-changed attribute-changed)))))
'(created changed deleted stopped
created changed deleted stopped
created changed renamed stopped
attribute-changed attribute-changed
attribute-changed stopped)
'(created changed deleted stopped
created changed deleted stopped
created changed renamed stopped
attribute-changed attribute-changed stopped)))))
(should file-notify--test-results)
(dolist (result file-notify--test-results)
;;(message "%s" (ert-test-result-messages result))
@ -438,8 +457,8 @@ Don't wait longer than TIMEOUT seconds for the events to be delivered."
(unwind-protect
(progn
(setq file-notify--test-tmpfile (file-notify--test-make-temp-name))
(setq file-notify--test-desc
(setq file-notify--test-tmpfile (file-notify--test-make-temp-name)
file-notify--test-desc
(file-notify-add-watch
file-notify--test-tmpfile
'(change) #'file-notify--test-event-handler))
@ -452,6 +471,33 @@ Don't wait longer than TIMEOUT seconds for the events to be delivered."
;; After removing the watch, the descriptor must not be valid
;; anymore.
(file-notify-rm-watch file-notify--test-desc)
(file-notify--wait-for-events
(file-notify--test-timeout)
(not (file-notify-valid-p file-notify--test-desc)))
(should-not (file-notify-valid-p file-notify--test-desc)))
;; Cleanup.
(file-notify--test-cleanup))
(unwind-protect
(progn
(setq file-notify--test-tmpfile (file-notify--test-make-temp-name)
file-notify--test-desc
(file-notify-add-watch
file-notify--test-tmpfile
'(change) #'file-notify--test-event-handler))
(file-notify--test-with-events
(file-notify--test-timeout) '(created changed)
(should (file-notify-valid-p file-notify--test-desc))
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
(should (file-notify-valid-p file-notify--test-desc)))
;; After deleting the file, the descriptor must not be valid
;; anymore.
(delete-file file-notify--test-tmpfile)
(file-notify--wait-for-events
(file-notify--test-timeout)
(not (file-notify-valid-p file-notify--test-desc)))
(should-not (file-notify-valid-p file-notify--test-desc)))
;; Cleanup.
@ -463,8 +509,8 @@ Don't wait longer than TIMEOUT seconds for the events to be delivered."
(unless (and noninteractive (eq file-notify--library 'w32notify))
(let ((temporary-file-directory (make-temp-file
"file-notify-test-parent" t)))
(setq file-notify--test-tmpfile (file-notify--test-make-temp-name))
(setq file-notify--test-desc
(setq file-notify--test-tmpfile (file-notify--test-make-temp-name)
file-notify--test-desc
(file-notify-add-watch
file-notify--test-tmpfile
'(change) #'file-notify--test-event-handler))
@ -474,8 +520,8 @@ Don't wait longer than TIMEOUT seconds for the events to be delivered."
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
(should (file-notify-valid-p file-notify--test-desc)))
;; After deleting the parent, the descriptor must not be valid
;; anymore.
;; After deleting the parent, the descriptor must not be
;; valid anymore.
(delete-directory temporary-file-directory t)
(file-notify--wait-for-events
(file-notify--test-timeout)