aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorMichael Albinus2016-01-22 19:56:09 +0100
committerMichael Albinus2016-01-22 19:56:09 +0100
commit7bf54d01159eb09bae3c9cd86f2af0812d9afdf6 (patch)
treef00e00ba1ed5a492ec94faf8d07a6ca2f857a9c5 /lisp
parentf7dc6d8b5bb318e02a4016d93f8b34de0716f4dc (diff)
downloademacs-7bf54d01159eb09bae3c9cd86f2af0812d9afdf6.tar.gz
emacs-7bf54d01159eb09bae3c9cd86f2af0812d9afdf6.zip
Backport kqueue integration from master
* configure.ac (--with-file-notification): Add kqueue. (top): Remove special test for "${HAVE_NS}" and ${with_file_notification}, this is handled inside gfilenotify tests. Add kqueue tests. Use NOTIFY_CFLAGS and NOTIFY_LIBS instead of library specific variables. Add error message for gfile on Nextstep. * doc/lispref/os.texi (File Notifications): Add kqueue as backend. Fix some glitches in the example. * etc/NEWS: Mention kqueue. * lisp/filenotify.el (file-notify--library) (file-notify-descriptors, file-notify-callback) (file-notify-add-watch, file-notify-rm-watch) (file-notify-valid-p): Add kqueue support. (file-notify--rm-descriptor): Remove WHAT arg. * src/Makefile.in: Use NOTIFY_CFLAGS and NOTIFY_LIBS. * src/emacs.c (main): Call globals_of_kqueue and syms_of_kqueue. * src/inotify.c (inotifyevent_to_event): Extract file name from watch_object if the event doesn't provide it. (Finotify_add_watch): Add file name to watch_object. * src/keyboard.c (make_lispy_event): Check also for HAVE_KQUEUE. * src/kqueue.c: New file. * src/lisp.h: Declare extern globals_of_kqueue and syms_of_kqueue. * test/automated/file-notify-tests.el (file-notify--test-expected-events): Remove. (file-notify--test-cleanup): Do not set that variable. (file-notify--test-timeout) Use different timeouts for different libraries. (file-notify--test-library): New defun. (file-notify--test-event-test): Make stronger checks. (file-notify--test-with-events): EVENTS can also be a list of lists. Flush outstanding events before running the body. Make timeout heuristically depend on the number of events. (file-notify-test01-add-watch, file-notify-test02-events) (file-notify-test04-file-validity, file-notify-test05-dir-validity): Rewrite in order to call file monitors but directory monitors. (file-notify-test02-events, file-notify-test04-file-validity): Do not skip cygwin tests. Add additional test for file creation. Adapt expected result for different backends. (file-notify-test03-autorevert): Some of the tests don't work for w32notify. (file-notify-test06-many-events): New test.
Diffstat (limited to 'lisp')
-rw-r--r--lisp/filenotify.el101
1 files changed, 59 insertions, 42 deletions
diff --git a/lisp/filenotify.el b/lisp/filenotify.el
index ebf4dd277c8..faa801ee6e7 100644
--- a/lisp/filenotify.el
+++ b/lisp/filenotify.el
@@ -22,15 +22,16 @@
22;;; Commentary 22;;; Commentary
23 23
24;; This package is an abstraction layer from the different low-level 24;; This package is an abstraction layer from the different low-level
25;; file notification packages `gfilenotify', `inotify' and 25;; file notification packages `inotify', `kqueue', `gfilenotify' and
26;; `w32notify'. 26;; `w32notify'.
27 27
28;;; Code: 28;;; Code:
29 29
30(defconst file-notify--library 30(defconst file-notify--library
31 (cond 31 (cond
32 ((featurep 'gfilenotify) 'gfilenotify)
33 ((featurep 'inotify) 'inotify) 32 ((featurep 'inotify) 'inotify)
33 ((featurep 'kqueue) 'kqueue)
34 ((featurep 'gfilenotify) 'gfilenotify)
34 ((featurep 'w32notify) 'w32notify)) 35 ((featurep 'w32notify) 'w32notify))
35 "Non-nil when Emacs has been compiled with file notification support. 36 "Non-nil when Emacs has been compiled with file notification support.
36The value is the name of the low-level file notification package 37The value is the name of the low-level file notification package
@@ -40,25 +41,24 @@ could use another implementation.")
40(defvar file-notify-descriptors (make-hash-table :test 'equal) 41(defvar file-notify-descriptors (make-hash-table :test 'equal)
41 "Hash table for registered file notification descriptors. 42 "Hash table for registered file notification descriptors.
42A key in this hash table is the descriptor as returned from 43A key in this hash table is the descriptor as returned from
43`gfilenotify', `inotify', `w32notify' or a file name handler. 44`inotify', `kqueue', `gfilenotify', `w32notify' or a file name
44The value in the hash table is a list 45handler. The value in the hash table is a list
45 46
46 (DIR (FILE . CALLBACK) (FILE . CALLBACK) ...) 47 (DIR (FILE . CALLBACK) (FILE . CALLBACK) ...)
47 48
48Several values for a given DIR happen only for `inotify', when 49Several values for a given DIR happen only for `inotify', when
49different files from the same directory are watched.") 50different files from the same directory are watched.")
50 51
51(defun file-notify--rm-descriptor (descriptor &optional what) 52(defun file-notify--rm-descriptor (descriptor)
52 "Remove DESCRIPTOR from `file-notify-descriptors'. 53 "Remove DESCRIPTOR from `file-notify-descriptors'.
53DESCRIPTOR should be an object returned by `file-notify-add-watch'. 54DESCRIPTOR should be an object returned by `file-notify-add-watch'.
54If it is registered in `file-notify-descriptors', a stopped event is sent. 55If it is registered in `file-notify-descriptors', a stopped event is sent."
55WHAT is a file or directory name to be removed, needed just for `inotify'."
56 (let* ((desc (if (consp descriptor) (car descriptor) descriptor)) 56 (let* ((desc (if (consp descriptor) (car descriptor) descriptor))
57 (file (if (consp descriptor) (cdr descriptor))) 57 (file (if (consp descriptor) (cdr descriptor)))
58 (registered (gethash desc file-notify-descriptors)) 58 (registered (gethash desc file-notify-descriptors))
59 (dir (car registered))) 59 (dir (car registered)))
60 60
61 (when (and (consp registered) (or (null what) (string-equal dir what))) 61 (when (consp registered)
62 ;; Send `stopped' event. 62 ;; Send `stopped' event.
63 (dolist (entry (cdr registered)) 63 (dolist (entry (cdr registered))
64 (funcall (cdr entry) 64 (funcall (cdr entry)
@@ -76,7 +76,8 @@ WHAT is a file or directory name to be removed, needed just for `inotify'."
76 (remhash desc file-notify-descriptors) 76 (remhash desc file-notify-descriptors)
77 (puthash desc registered file-notify-descriptors)))))) 77 (puthash desc registered file-notify-descriptors))))))
78 78
79;; This function is used by `gfilenotify', `inotify' and `w32notify' events. 79;; This function is used by `inotify', `kqueue', `gfilenotify' and
80;; `w32notify' events.
80;;;###autoload 81;;;###autoload
81(defun file-notify-handle-event (event) 82(defun file-notify-handle-event (event)
82 "Handle file system monitoring event. 83 "Handle file system monitoring event.
@@ -159,7 +160,7 @@ EVENT is the cadr of the event in `file-notify-handle-event'
159 (setq actions nil)) 160 (setq actions nil))
160 161
161 ;; Loop over actions. In fact, more than one action happens only 162 ;; Loop over actions. In fact, more than one action happens only
162 ;; for `inotify'. 163 ;; for `inotify' and `kqueue'.
163 (dolist (action actions) 164 (dolist (action actions)
164 165
165 ;; Send pending event, if it doesn't match. 166 ;; Send pending event, if it doesn't match.
@@ -184,19 +185,17 @@ EVENT is the cadr of the event in `file-notify-handle-event'
184 ;; Map action. We ignore all events which cannot be mapped. 185 ;; Map action. We ignore all events which cannot be mapped.
185 (setq action 186 (setq action
186 (cond 187 (cond
187 ;; gfilenotify. 188 ((memq action
188 ((memq action '(attribute-changed changed created deleted)) 189 '(attribute-changed changed created deleted renamed))
189 action) 190 action)
190 ((eq action 'moved) 191 ((memq action '(moved rename))
191 (setq file1 (file-notify--event-file1-name event)) 192 (setq file1 (file-notify--event-file1-name event))
192 'renamed) 193 'renamed)
193
194 ;; inotify, w32notify.
195 ((eq action 'ignored) 194 ((eq action 'ignored)
196 (setq stopped t actions nil)) 195 (setq stopped t actions nil))
197 ((eq action 'attrib) 'attribute-changed) 196 ((memq action '(attrib link)) 'attribute-changed)
198 ((memq action '(create added)) 'created) 197 ((memq action '(create added)) 'created)
199 ((memq action '(modify modified)) 'changed) 198 ((memq action '(modify modified write)) 'changed)
200 ((memq action '(delete delete-self move-self removed)) 'deleted) 199 ((memq action '(delete delete-self move-self removed)) 'deleted)
201 ;; Make the event pending. 200 ;; Make the event pending.
202 ((memq action '(moved-from renamed-from)) 201 ((memq action '(moved-from renamed-from))
@@ -236,7 +235,6 @@ EVENT is the cadr of the event in `file-notify-handle-event'
236 (setq pending-event nil)) 235 (setq pending-event nil))
237 236
238 ;; Check for stopped. 237 ;; Check for stopped.
239 ;;(message "file-notify-callback %S %S" file registered)
240 (setq 238 (setq
241 stopped 239 stopped
242 (or 240 (or
@@ -244,10 +242,13 @@ EVENT is the cadr of the event in `file-notify-handle-event'
244 (and 242 (and
245 (memq action '(deleted renamed)) 243 (memq action '(deleted renamed))
246 (= (length (cdr registered)) 1) 244 (= (length (cdr registered)) 1)
247 (string-equal 245 (or
248 (file-name-nondirectory file) 246 (string-equal
249 (or (file-name-nondirectory (car registered)) 247 (file-name-nondirectory file)
250 (car (cadr registered))))))) 248 (file-name-nondirectory (car registered)))
249 (string-equal
250 (file-name-nondirectory file)
251 (car (cadr registered)))))))
251 252
252 ;; Apply callback. 253 ;; Apply callback.
253 (when (and action 254 (when (and action
@@ -258,10 +259,17 @@ EVENT is the cadr of the event in `file-notify-handle-event'
258 ;; File matches. 259 ;; File matches.
259 (string-equal 260 (string-equal
260 (nth 0 entry) (file-name-nondirectory file)) 261 (nth 0 entry) (file-name-nondirectory file))
262 ;; Directory matches.
263 (string-equal
264 (file-name-nondirectory file)
265 (file-name-nondirectory (car registered)))
261 ;; File1 matches. 266 ;; File1 matches.
262 (and (stringp file1) 267 (and (stringp file1)
263 (string-equal 268 (string-equal
264 (nth 0 entry) (file-name-nondirectory file1))))) 269 (nth 0 entry) (file-name-nondirectory file1)))))
270 ;;(message
271 ;;"file-notify-callback %S %S %S %S %S"
272 ;;(file-notify--descriptor desc file) action file file1 registered)
265 (if file1 273 (if file1
266 (funcall 274 (funcall
267 callback 275 callback
@@ -272,11 +280,10 @@ EVENT is the cadr of the event in `file-notify-handle-event'
272 280
273 ;; Modify `file-notify-descriptors'. 281 ;; Modify `file-notify-descriptors'.
274 (when stopped 282 (when stopped
275 (file-notify--rm-descriptor 283 (file-notify-rm-watch (file-notify--descriptor desc file))))))
276 (file-notify--descriptor desc file) file)))))
277 284
278;; `gfilenotify' and `w32notify' return a unique descriptor for every 285;; `kqueue', `gfilenotify' and `w32notify' return a unique descriptor
279;; `file-notify-add-watch', while `inotify' returns a unique 286;; for every `file-notify-add-watch', while `inotify' returns a unique
280;; descriptor per inode only. 287;; descriptor per inode only.
281(defun file-notify-add-watch (file flags callback) 288(defun file-notify-add-watch (file flags callback)
282 "Add a watch for filesystem events pertaining to FILE. 289 "Add a watch for filesystem events pertaining to FILE.
@@ -329,7 +336,7 @@ FILE is the name of the file whose event is being reported."
329 (if (file-directory-p file) 336 (if (file-directory-p file)
330 file 337 file
331 (file-name-directory file)))) 338 (file-name-directory file))))
332 desc func l-flags registered) 339 desc func l-flags registered entry)
333 340
334 (unless (file-directory-p dir) 341 (unless (file-directory-p dir)
335 (signal 'file-notify-error `("Directory does not exist" ,dir))) 342 (signal 'file-notify-error `("Directory does not exist" ,dir)))
@@ -338,7 +345,12 @@ FILE is the name of the file whose event is being reported."
338 ;; A file name handler could exist even if there is no local 345 ;; A file name handler could exist even if there is no local
339 ;; file notification support. 346 ;; file notification support.
340 (setq desc (funcall 347 (setq desc (funcall
341 handler 'file-notify-add-watch dir flags callback)) 348 handler 'file-notify-add-watch
349 ;; kqueue does not report file changes in
350 ;; directory monitor. So we must watch the file
351 ;; itself.
352 (if (eq file-notify--library 'kqueue) file dir)
353 flags callback))
342 354
343 ;; Check, whether Emacs has been compiled with file notification 355 ;; Check, whether Emacs has been compiled with file notification
344 ;; support. 356 ;; support.
@@ -349,8 +361,9 @@ FILE is the name of the file whose event is being reported."
349 ;; Determine low-level function to be called. 361 ;; Determine low-level function to be called.
350 (setq func 362 (setq func
351 (cond 363 (cond
352 ((eq file-notify--library 'gfilenotify) 'gfile-add-watch)
353 ((eq file-notify--library 'inotify) 'inotify-add-watch) 364 ((eq file-notify--library 'inotify) 'inotify-add-watch)
365 ((eq file-notify--library 'kqueue) 'kqueue-add-watch)
366 ((eq file-notify--library 'gfilenotify) 'gfile-add-watch)
354 ((eq file-notify--library 'w32notify) 'w32notify-add-watch))) 367 ((eq file-notify--library 'w32notify) 'w32notify-add-watch)))
355 368
356 ;; Determine respective flags. 369 ;; Determine respective flags.
@@ -362,30 +375,32 @@ FILE is the name of the file whose event is being reported."
362 (cond 375 (cond
363 ((eq file-notify--library 'inotify) 376 ((eq file-notify--library 'inotify)
364 '(create delete delete-self modify move-self move)) 377 '(create delete delete-self modify move-self move))
378 ((eq file-notify--library 'kqueue)
379 '(create delete write extend rename))
365 ((eq file-notify--library 'w32notify) 380 ((eq file-notify--library 'w32notify)
366 '(file-name directory-name size last-write-time))))) 381 '(file-name directory-name size last-write-time)))))
367 (when (memq 'attribute-change flags) 382 (when (memq 'attribute-change flags)
368 (push (cond 383 (push (cond
369 ((eq file-notify--library 'inotify) 'attrib) 384 ((eq file-notify--library 'inotify) 'attrib)
385 ((eq file-notify--library 'kqueue) 'attrib)
370 ((eq file-notify--library 'w32notify) 'attributes)) 386 ((eq file-notify--library 'w32notify) 'attributes))
371 l-flags))) 387 l-flags)))
372 388
373 ;; Call low-level function. 389 ;; Call low-level function.
374 (setq desc (funcall func dir l-flags 'file-notify-callback))) 390 (setq desc (funcall
391 func (if (eq file-notify--library 'kqueue) file dir)
392 l-flags 'file-notify-callback)))
375 393
376 ;; Modify `file-notify-descriptors'. 394 ;; Modify `file-notify-descriptors'.
377 (setq registered (gethash desc file-notify-descriptors)) 395 (setq file (unless (file-directory-p file) (file-name-nondirectory file))
378 (puthash 396 desc (if (consp desc) (car desc) desc)
379 desc 397 registered (gethash desc file-notify-descriptors)
380 `(,dir 398 entry `(,file . ,callback))
381 (,(unless (file-directory-p file) (file-name-nondirectory file)) 399 (unless (member entry (cdr registered))
382 . ,callback) 400 (puthash desc `(,dir ,entry . ,(cdr registered)) file-notify-descriptors))
383 . ,(cdr registered))
384 file-notify-descriptors)
385 401
386 ;; Return descriptor. 402 ;; Return descriptor.
387 (file-notify--descriptor 403 (file-notify--descriptor desc file)))
388 desc (unless (file-directory-p file) (file-name-nondirectory file)))))
389 404
390(defun file-notify-rm-watch (descriptor) 405(defun file-notify-rm-watch (descriptor)
391 "Remove an existing watch specified by its DESCRIPTOR. 406 "Remove an existing watch specified by its DESCRIPTOR.
@@ -410,8 +425,9 @@ DESCRIPTOR should be an object returned by `file-notify-add-watch'."
410 425
411 (funcall 426 (funcall
412 (cond 427 (cond
413 ((eq file-notify--library 'gfilenotify) 'gfile-rm-watch)
414 ((eq file-notify--library 'inotify) 'inotify-rm-watch) 428 ((eq file-notify--library 'inotify) 'inotify-rm-watch)
429 ((eq file-notify--library 'kqueue) 'kqueue-rm-watch)
430 ((eq file-notify--library 'gfilenotify) 'gfile-rm-watch)
415 ((eq file-notify--library 'w32notify) 'w32notify-rm-watch)) 431 ((eq file-notify--library 'w32notify) 'w32notify-rm-watch))
416 desc)) 432 desc))
417 (file-notify-error nil))) 433 (file-notify-error nil)))
@@ -441,8 +457,9 @@ DESCRIPTOR should be an object returned by `file-notify-add-watch'."
441 (funcall handler 'file-notify-valid-p descriptor) 457 (funcall handler 'file-notify-valid-p descriptor)
442 (funcall 458 (funcall
443 (cond 459 (cond
444 ((eq file-notify--library 'gfilenotify) 'gfile-valid-p)
445 ((eq file-notify--library 'inotify) 'inotify-valid-p) 460 ((eq file-notify--library 'inotify) 'inotify-valid-p)
461 ((eq file-notify--library 'kqueue) 'kqueue-valid-p)
462 ((eq file-notify--library 'gfilenotify) 'gfile-valid-p)
446 ((eq file-notify--library 'w32notify) 'w32notify-valid-p)) 463 ((eq file-notify--library 'w32notify) 'w32notify-valid-p))
447 desc)) 464 desc))
448 t)))) 465 t))))