diff options
| author | Michael Albinus | 2016-01-22 19:56:09 +0100 |
|---|---|---|
| committer | Michael Albinus | 2016-01-22 19:56:09 +0100 |
| commit | 7bf54d01159eb09bae3c9cd86f2af0812d9afdf6 (patch) | |
| tree | f00e00ba1ed5a492ec94faf8d07a6ca2f857a9c5 /lisp | |
| parent | f7dc6d8b5bb318e02a4016d93f8b34de0716f4dc (diff) | |
| download | emacs-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.el | 101 |
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. |
| 36 | The value is the name of the low-level file notification package | 37 | The 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. |
| 42 | A key in this hash table is the descriptor as returned from | 43 | A 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 |
| 44 | The value in the hash table is a list | 45 | handler. 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 | ||
| 48 | Several values for a given DIR happen only for `inotify', when | 49 | Several values for a given DIR happen only for `inotify', when |
| 49 | different files from the same directory are watched.") | 50 | different 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'. |
| 53 | DESCRIPTOR should be an object returned by `file-notify-add-watch'. | 54 | DESCRIPTOR should be an object returned by `file-notify-add-watch'. |
| 54 | If it is registered in `file-notify-descriptors', a stopped event is sent. | 55 | If it is registered in `file-notify-descriptors', a stopped event is sent." |
| 55 | WHAT 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)))) |