aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMichael Albinus2015-11-25 15:24:27 +0100
committerMichael Albinus2015-11-25 15:24:27 +0100
commit91cad2b327f19094764ca1dc2c432368742f1d2f (patch)
treec08880452d912fb7992d631eb092b1943d65b1b0
parentc378d6c33f751d1a0b97958f3cacfe0b07c72f58 (diff)
parentbec57a486a2a40d7c770dab72a34cf6a4d17a5d0 (diff)
downloademacs-91cad2b327f19094764ca1dc2c432368742f1d2f.tar.gz
emacs-91cad2b327f19094764ca1dc2c432368742f1d2f.zip
Merge from scratch/kqueue
bec57a4 Some final fixes in file notification before merging with master 0247489 Rework file notifications, kqueue has problems with directory monitors 5154781 Continie with pending events 6b490c0 Improve loops in file-notify-test06-many-events c8e266f Handle more complex rename operation in kqueue 5044bdf New test with a larger number of events. 65ba5a9 Further fixes for kqueue. 13f3508 Code cleanup of kqueue.c 99aa855 Doc changes for kqueue 8deebe1 Finish implementation in kqueue.c 90d6c69 * lisp/filenotify.el (file-notify-add-watch): Fix thinko. e95b309 More work on kqueue 41d9bd0 Implement directory events c571fc1 Build fixes for kqueue support. e0a68f2 Continue kqueue implementation 7543d1c Work on kqueue e3354e2 Add kqueue support c6457ce Minor fix to comment indentation and typo in last commit b92307f linum-mode plays more nicely with other margin-setting extensions 58e6235 * lisp/image-mode.el: Support encrypted file 9375652 * lisp/progmodes/verilog-mode.el (verilog-save-buffer-state): Add backquote 47f83b6 ; ChangeLog.2 fixes 7cc233e * lisp/emacs-lisp/package.el: Fix a decoding issue 5f9153f * lisp/emacs-lisp/package.el: Refactor -with-work-buffer-async 353f5e7 * lisp/progmodes/verilog-mode.el: Use with-silent-modifications 70f1fda ; Auto-commit of ChangeLog files. ae0653b * CONTRIBUTE: Remove information about feature freeze. 9459456 Merge branch 'release-process-lowercase' 9a4aa0f Document the release process f8cc14b * admin/release-process: Rename from admin/FOR-RELEASE. dcd5877 gitmerge: Fix git log command 2ac79ae gitmerge: Try to detect cherry-picks 5f7a2a9 Increment Emacs version on master branch ed2e7e2 Mention CONTRIBUTE in README 9e00a02 Update verilog-mode.el to 2015-11-09-b121d60-vpo. 138ad3d ; Fix warnings 7126e9a ; Update xref-etags-mode for the latest change 246d660 Use generic dispatch for xref backends 31f6e93 Support rectangular regions for more commands f103a27 Handle multiple matches on the same line; add highlighting fe973fc Replace xref-match-bounds with xref-match-length 92a5010 Merge from gnulib 04ac097 Spruce up ftfont.c memory allocation 4c4b520 Port recent XCB changes to 64-bit ‘long int’ 4f0ce9c * src/undo.c (run_undoable_change): Now static. 695a6f9 Remove support for ':timeout' from w32 tray notifications a731c2f * test/automated/simple-test.el: Add test for bug#20698 (bug#21885) 2b4c0c0 * lisp/progmodes/elisp-mode.el: Declare function `project-roots' 66b9f7b * src/undo.c: Small fixes for previous change 2fac30e Add a few more variables to redisplay--variables 04f69f1 * lisp/loadup.el: Enlarge the size of the hash table to 80000. e221d32 Fix point positioning after transposing with negative arg 35f5afb Fix last change in shr.el 508e77b Fix last change d60ed3f Another fix for MinGW64 and Cygwin builds due to notifications 805a39b Remove intern calls and XXX comments from Fx_export_frames 9463abf shr: don't invoke unbound function (Bug#21895) 6e5186e * test/automated/keymaps-test.el: Fix test to make it repeatable 0c92826 * test/automated/cl-lib-tests.el (cl-lib-struct-constructors): Small fix 39dbd1c : Tests for undo-auto functionality. 20aa42e ; Merge branch 'fix/no-undo-boundary-on-secondary-buffer-change' 44dfa86 The heuristic that Emacs uses to add an `undo-boundary' has been reworked, as it interacts poorly with functions on `post-command-hook' or `after-change-functions'. d2f73db Bind [?\S-\ ] to previous line command in Dired-like modes. c1bc6e5 Fix the MinGW64 and Cygwin-w32 builds 1e363a8 Enable sorting of JSON object keys when encoding 9dd7da9 * test/automated/keymap-tests.el: New test file aa17de9 Speed up x_real_pos_and_offsets using XCB a838c83 Enable use of XCB for checking window manager state c7f2b6a Detect XCB and save a connection handle e1c27db Reduce some data dependencies between X calls 25e32bd Use color cache for creating bitmap 851be0f Add "^" to the interactive specs of `dired-next/previous-line' 055ca3a Sync with soap-client repository, version 3.0.2 e0f64e7 CC Mode: Respect users' settings of open-paren-in-column-0-is-defun-start. 952395d * lisp/obarray.el: Fix shadowed variables 436d330 Avoid error in submitting a form with EWW e887f6e ; * doc/lispref/os.texi: Fix indentation of sample code. 51d840a Rename seq-p and map-p to seqp and mapp 23036ba Rename obarray-p to obarrayp 20aea42 Rename obarray-foreach to obarray-map a3b2101 New file with obarray functions. 9d43941 Implement tray notifications for MS-Windows
-rw-r--r--configure.ac58
-rw-r--r--doc/lispref/os.texi41
-rw-r--r--lisp/filenotify.el101
-rw-r--r--src/Makefile.in11
-rw-r--r--src/emacs.c16
-rw-r--r--src/inotify.c9
-rw-r--r--src/keyboard.c4
-rw-r--r--src/kqueue.c520
-rw-r--r--src/lisp.h16
-rw-r--r--test/automated/auto-revert-tests.el2
-rw-r--r--test/automated/file-notify-tests.el557
11 files changed, 1064 insertions, 271 deletions
diff --git a/configure.ac b/configure.ac
index 0348c062911..bae4fec72ec 100644
--- a/configure.ac
+++ b/configure.ac
@@ -355,17 +355,18 @@ OPTION_DEFAULT_ON([gnutls],[don't use -lgnutls for SSL/TLS support])
355OPTION_DEFAULT_ON([zlib],[don't compile with zlib decompression support]) 355OPTION_DEFAULT_ON([zlib],[don't compile with zlib decompression support])
356 356
357AC_ARG_WITH([file-notification],[AS_HELP_STRING([--with-file-notification=LIB], 357AC_ARG_WITH([file-notification],[AS_HELP_STRING([--with-file-notification=LIB],
358 [use a file notification library (LIB one of: yes, gfile, inotify, w32, no)])], 358 [use a file notification library (LIB one of: yes, inotify, kqueue, gfile, w32, no)])],
359 [ case "${withval}" in 359 [ case "${withval}" in
360 y | ye | yes ) val=yes ;; 360 y | ye | yes ) val=yes ;;
361 n | no ) val=no ;; 361 n | no ) val=no ;;
362 g | gf | gfi | gfil | gfile ) val=gfile ;;
363 i | in | ino | inot | inoti | inotif | inotify ) val=inotify ;; 362 i | in | ino | inot | inoti | inotif | inotify ) val=inotify ;;
363 k | kq | kqu | kque | kqueu | kqueue ) val=kqueue ;;
364 g | gf | gfi | gfil | gfile ) val=gfile ;;
364 w | w3 | w32 ) val=w32 ;; 365 w | w3 | w32 ) val=w32 ;;
365 * ) AC_MSG_ERROR(['--with-file-notification=$withval' is invalid; 366 * ) AC_MSG_ERROR(['--with-file-notification=$withval' is invalid;
366this option's value should be 'yes', 'no', 'gfile', 'inotify' or 'w32'. 367this option's value should be 'yes', 'no', 'inotify', 'kqeue', 'gfile' or 'w32'.
367'yes' is a synonym for 'w32' on MS-Windows, for 'no' on Nextstep, 368'yes' is a synonym for 'w32' on MS-Windows, for 'no' on Nextstep,
368otherwise for the first of 'inotify' or 'gfile' that is usable.]) 369otherwise for the first of 'inotify', 'kqueue' or 'gfile' that is usable.])
369 ;; 370 ;;
370 esac 371 esac
371 with_file_notification=$val 372 with_file_notification=$val
@@ -2690,12 +2691,6 @@ AC_SUBST(LIBGNUTLS_CFLAGS)
2690NOTIFY_OBJ= 2691NOTIFY_OBJ=
2691NOTIFY_SUMMARY=no 2692NOTIFY_SUMMARY=no
2692 2693
2693dnl FIXME? Don't auto-detect on NS, but do allow someone to specify
2694dnl a particular library. This doesn't make much sense?
2695if test "${HAVE_NS}" = yes && test ${with_file_notification} = yes; then
2696 with_file_notification=no
2697fi
2698
2699dnl MS Windows native file monitor is available for mingw32 only. 2694dnl MS Windows native file monitor is available for mingw32 only.
2700case $with_file_notification,$opsys in 2695case $with_file_notification,$opsys in
2701 w32,cygwin) 2696 w32,cygwin)
@@ -2726,16 +2721,41 @@ case $with_file_notification,$NOTIFY_OBJ in
2726 fi ;; 2721 fi ;;
2727esac 2722esac
2728 2723
2724dnl kqueue is available on BSD-like systems.
2725case $with_file_notification,$NOTIFY_OBJ in
2726 kqueue,* | yes,)
2727 EMACS_CHECK_MODULES([KQUEUE], [libkqueue])
2728 if test "$HAVE_KQUEUE" = "yes"; then
2729 AC_DEFINE(HAVE_KQUEUE, 1, [Define to 1 to use kqueue.])
2730 CPPFLAGS="$CPPFLAGS -I/usr/include/kqueue"
2731 NOTIFY_CFLAGS=$KQUEUE_CFLAGS
2732 NOTIFY_LIBS=$KQUEUE_LIBS
2733 NOTIFY_OBJ=kqueue.o
2734 NOTIFY_SUMMARY="yes -lkqueue"
2735 else
2736 AC_SEARCH_LIBS(kqueue, [])
2737 if test "$ac_cv_search_kqueue" != no; then
2738 AC_DEFINE(HAVE_KQUEUE, 1, [Define to 1 to use kqueue.])
2739 NOTIFY_OBJ=kqueue.o
2740 NOTIFY_SUMMARY="yes (kqueue)"
2741 fi
2742 fi ;;
2743esac
2744
2729dnl g_file_monitor exists since glib 2.18. G_FILE_MONITOR_EVENT_MOVED 2745dnl g_file_monitor exists since glib 2.18. G_FILE_MONITOR_EVENT_MOVED
2730dnl has been added in glib 2.24. It has been tested under 2746dnl has been added in glib 2.24. It has been tested under
2731dnl GNU/Linux only. 2747dnl GNU/Linux only.
2732case $with_file_notification,$NOTIFY_OBJ in 2748case $with_file_notification,$NOTIFY_OBJ in
2733 gfile,* | yes,) 2749 gfile,* | yes,)
2734 EMACS_CHECK_MODULES([GFILENOTIFY], [gio-2.0 >= 2.24]) 2750 if test "${HAVE_NS}" != yes; then
2735 if test "$HAVE_GFILENOTIFY" = "yes"; then 2751 EMACS_CHECK_MODULES([GFILENOTIFY], [gio-2.0 >= 2.24])
2736 AC_DEFINE(HAVE_GFILENOTIFY, 1, [Define to 1 if using GFile.]) 2752 if test "$HAVE_GFILENOTIFY" = "yes"; then
2737 NOTIFY_OBJ=gfilenotify.o 2753 AC_DEFINE(HAVE_GFILENOTIFY, 1, [Define to 1 if using GFile.])
2738 NOTIFY_SUMMARY="yes -lgio (gfile)" 2754 NOTIFY_CFLAGS=$GFILENOTIFY_CFLAGS
2755 NOTIFY_LIBS=$GFILENOTIFY_LIBS
2756 NOTIFY_OBJ=gfilenotify.o
2757 NOTIFY_SUMMARY="yes -lgio (gfile)"
2758 fi
2739 fi ;; 2759 fi ;;
2740esac 2760esac
2741 2761
@@ -2747,9 +2767,9 @@ esac
2747if test -n "$NOTIFY_OBJ"; then 2767if test -n "$NOTIFY_OBJ"; then
2748 AC_DEFINE(USE_FILE_NOTIFY, 1, [Define to 1 if using file notifications.]) 2768 AC_DEFINE(USE_FILE_NOTIFY, 1, [Define to 1 if using file notifications.])
2749fi 2769fi
2770AC_SUBST(NOTIFY_CFLAGS)
2771AC_SUBST(NOTIFY_LIBS)
2750AC_SUBST(NOTIFY_OBJ) 2772AC_SUBST(NOTIFY_OBJ)
2751AC_SUBST(GFILENOTIFY_CFLAGS)
2752AC_SUBST(GFILENOTIFY_LIBS)
2753 2773
2754dnl Do not put whitespace before the #include statements below. 2774dnl Do not put whitespace before the #include statements below.
2755dnl Older compilers (eg sunos4 cc) choke on it. 2775dnl Older compilers (eg sunos4 cc) choke on it.
@@ -4066,8 +4086,8 @@ OLDCFLAGS="$CFLAGS"
4066OLDLIBS="$LIBS" 4086OLDLIBS="$LIBS"
4067CFLAGS="$CFLAGS $GTK_CFLAGS $RSVG_CFLAGS $DBUS_CFLAGS $SETTINGS_CFLAGS" 4087CFLAGS="$CFLAGS $GTK_CFLAGS $RSVG_CFLAGS $DBUS_CFLAGS $SETTINGS_CFLAGS"
4068LIBS="$LIBS $GTK_LIBS $RSVG_LIBS $DBUS_LIBS $SETTINGS_LIBS" 4088LIBS="$LIBS $GTK_LIBS $RSVG_LIBS $DBUS_LIBS $SETTINGS_LIBS"
4069CFLAGS="$CFLAGS $GFILENOTIFY_CFLAGS $CAIRO_CFLAGS" 4089CFLAGS="$CFLAGS $NOTIFY_CFLAGS $CAIRO_CFLAGS"
4070LIBS="$LIBS $GFILENOTIFY_LIBS $CAIRO_LIBS" 4090LIBS="$LIBS $NOTIFY_LIBS $CAIRO_LIBS"
4071AC_MSG_CHECKING([whether GLib is linked in]) 4091AC_MSG_CHECKING([whether GLib is linked in])
4072AC_LINK_IFELSE([AC_LANG_PROGRAM( 4092AC_LINK_IFELSE([AC_LANG_PROGRAM(
4073 [[#include <glib.h> 4093 [[#include <glib.h>
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index f3c4e29cca2..17a0b47ad06 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -2640,9 +2640,9 @@ This function removes the tray notification given by its unique
2640 2640
2641Several operating systems support watching of filesystems for changes 2641Several operating systems support watching of filesystems for changes
2642of files. If configured properly, Emacs links a respective library 2642of files. If configured properly, Emacs links a respective library
2643like @file{gfilenotify}, @file{inotify}, or @file{w32notify} 2643like @file{inotify}, @file{kqueue}, @file{gfilenotify}, or
2644statically. These libraries enable watching of filesystems on the 2644@file{w32notify} statically. These libraries enable watching of
2645local machine. 2645filesystems on the local machine.
2646 2646
2647It is also possible to watch filesystems on remote machines, 2647It is also possible to watch filesystems on remote machines,
2648@pxref{Remote Files,, Remote Files, emacs, The GNU Emacs Manual} 2648@pxref{Remote Files,, Remote Files, emacs, The GNU Emacs Manual}
@@ -2713,7 +2713,8 @@ watching @var{file} has been stopped
2713Note that the @file{w32notify} library does not report 2713Note that the @file{w32notify} library does not report
2714@code{attribute-changed} events. When some file's attribute, like 2714@code{attribute-changed} events. When some file's attribute, like
2715permissions or modification time, has changed, this library reports a 2715permissions or modification time, has changed, this library reports a
2716@code{changed} event. 2716@code{changed} event. Likewise, the @file{kqueue} library does not
2717report reliably file attribute changes when watching a directory.
2717 2718
2718The @code{stopped} event reports, that watching the file has been 2719The @code{stopped} event reports, that watching the file has been
2719stopped. This could be because @code{file-notify-rm-watch} was called 2720stopped. This could be because @code{file-notify-rm-watch} was called
@@ -2752,7 +2753,7 @@ being reported. For example:
2752@group 2753@group
2753(write-region "bla" nil "/tmp/foo") 2754(write-region "bla" nil "/tmp/foo")
2754 @result{} Event (35025468 created "/tmp/.#foo") 2755 @result{} Event (35025468 created "/tmp/.#foo")
2755 Event (35025468 changed "/tmp/foo") [2 times] 2756 Event (35025468 changed "/tmp/foo")
2756 Event (35025468 deleted "/tmp/.#foo") 2757 Event (35025468 deleted "/tmp/.#foo")
2757@end group 2758@end group
2758 2759
@@ -2798,14 +2799,14 @@ also makes it invalid.
2798@example 2799@example
2799@group 2800@group
2800(make-directory "/tmp/foo") 2801(make-directory "/tmp/foo")
2801 @result{} nil 2802 @result{} Event (35025468 created "/tmp/foo")
2802@end group 2803@end group
2803 2804
2804@group 2805@group
2805(setq desc 2806(setq desc
2806 (file-notify-add-watch 2807 (file-notify-add-watch
2807 "/tmp/foo" '(change) 'my-notify-callback)) 2808 "/tmp/foo" '(change) 'my-notify-callback))
2808 @result{} 35025468 2809 @result{} 11359632
2809@end group 2810@end group
2810 2811
2811@group 2812@group
@@ -2815,32 +2816,34 @@ also makes it invalid.
2815 2816
2816@group 2817@group
2817(write-region "bla" nil "/tmp/foo/bla") 2818(write-region "bla" nil "/tmp/foo/bla")
2818 @result{} Event (35025468 created "/tmp/foo/.#bla") 2819 @result{} Event (11359632 created "/tmp/foo/.#bla")
2819 Event (35025468 created "/tmp/foo/bla") 2820 Event (11359632 created "/tmp/foo/bla")
2820 Event (35025468 changed "/tmp/foo/bla") 2821 Event (11359632 changed "/tmp/foo/bla")
2821 Event (35025468 changed "/tmp/foo/.#bla") 2822 Event (11359632 deleted "/tmp/foo/.#bla")
2822@end group 2823@end group
2823 2824
2824@group 2825@group
2825;; Deleting a file in the directory doesn't invalidate the watch. 2826;; Deleting a file in the directory doesn't invalidate the watch.
2826(delete-file "/tmp/foo/bla") 2827(delete-file "/tmp/foo/bla")
2827 @result{} Event (35025468 deleted "/tmp/foo/bla") 2828 @result{} Event (11359632 deleted "/tmp/foo/bla")
2828@end group 2829@end group
2829 2830
2830@group 2831@group
2831(write-region "bla" nil "/tmp/foo/bla") 2832(write-region "bla" nil "/tmp/foo/bla")
2832 @result{} Event (35025468 created "/tmp/foo/.#bla") 2833 @result{} Event (11359632 created "/tmp/foo/.#bla")
2833 Event (35025468 created "/tmp/foo/bla") 2834 Event (11359632 created "/tmp/foo/bla")
2834 Event (35025468 changed "/tmp/foo/bla") 2835 Event (11359632 changed "/tmp/foo/bla")
2835 Event (35025468 changed "/tmp/foo/.#bla") 2836 Event (11359632 deleted "/tmp/foo/.#bla")
2836@end group 2837@end group
2837 2838
2838@group 2839@group
2839;; Deleting the directory invalidates the watch. 2840;; Deleting the directory invalidates the watch.
2841;; Events arrive for different watch descriptors.
2840(delete-directory "/tmp/foo" 'recursive) 2842(delete-directory "/tmp/foo" 'recursive)
2841 @result{} Event (35025468 deleted "/tmp/foo/bla") 2843 @result{} Event (35025468 deleted "/tmp/foo")
2842 Event (35025468 deleted "/tmp/foo") 2844 Event (11359632 deleted "/tmp/foo/bla")
2843 Event (35025468 stopped "/tmp/foo") 2845 Event (11359632 deleted "/tmp/foo")
2846 Event (11359632 stopped "/tmp/foo")
2844@end group 2847@end group
2845 2848
2846@group 2849@group
diff --git a/lisp/filenotify.el b/lisp/filenotify.el
index 4c5d43fb44e..b6c1f686fe1 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))))
diff --git a/src/Makefile.in b/src/Makefile.in
index d667c55ee33..d7ad3954579 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -160,12 +160,13 @@ SETTINGS_LIBS = @SETTINGS_LIBS@
160## gtkutil.o if USE_GTK, else empty. 160## gtkutil.o if USE_GTK, else empty.
161GTK_OBJ=@GTK_OBJ@ 161GTK_OBJ=@GTK_OBJ@
162 162
163## gfilenotify.o if HAVE_GFILENOTIFY.
164## inotify.o if HAVE_INOTIFY. 163## inotify.o if HAVE_INOTIFY.
164## kqueue.o if HAVE_KQUEUE.
165## gfilenotify.o if HAVE_GFILENOTIFY.
165## w32notify.o if HAVE_W32NOTIFY. 166## w32notify.o if HAVE_W32NOTIFY.
166NOTIFY_OBJ = @NOTIFY_OBJ@ 167NOTIFY_OBJ = @NOTIFY_OBJ@
167GFILENOTIFY_CFLAGS = @GFILENOTIFY_CFLAGS@ 168NOTIFY_CFLAGS = @NOTIFY_CFLAGS@
168GFILENOTIFY_LIBS = @GFILENOTIFY_LIBS@ 169NOTIFY_LIBS = @NOTIFY_LIBS@
169 170
170## -ltermcap, or -lncurses, or -lcurses, or "". 171## -ltermcap, or -lncurses, or -lcurses, or "".
171LIBS_TERMCAP=@LIBS_TERMCAP@ 172LIBS_TERMCAP=@LIBS_TERMCAP@
@@ -355,7 +356,7 @@ ALL_CFLAGS=-Demacs $(MYCPPFLAGS) -I. -I$(srcdir) \
355 $(XRANDR_CFLAGS) $(XINERAMA_CFLAGS) $(XFIXES_CFLAGS) \ 356 $(XRANDR_CFLAGS) $(XINERAMA_CFLAGS) $(XFIXES_CFLAGS) \
356 $(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \ 357 $(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \
357 $(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) \ 358 $(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) \
358 $(LIBGNUTLS_CFLAGS) $(GFILENOTIFY_CFLAGS) $(CAIRO_CFLAGS) \ 359 $(LIBGNUTLS_CFLAGS) $(NOTIFY_CFLAGS) $(CAIRO_CFLAGS) \
359 $(WARN_CFLAGS) $(WERROR_CFLAGS) $(CFLAGS) 360 $(WARN_CFLAGS) $(WERROR_CFLAGS) $(CFLAGS)
360ALL_OBJC_CFLAGS=$(ALL_CFLAGS) $(GNU_OBJC_CFLAGS) 361ALL_OBJC_CFLAGS=$(ALL_CFLAGS) $(GNU_OBJC_CFLAGS)
361 362
@@ -468,7 +469,7 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE) $(LIBIMAGE) \
468 $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \ 469 $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \
469 $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \ 470 $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \
470 $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) \ 471 $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) \
471 $(GFILENOTIFY_LIBS) $(LIB_MATH) $(LIBZ) 472 $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ)
472 473
473$(leimdir)/leim-list.el: bootstrap-emacs$(EXEEXT) 474$(leimdir)/leim-list.el: bootstrap-emacs$(EXEEXT)
474 $(MAKE) -C ../leim leim-list.el EMACS="$(bootstrap_exe)" 475 $(MAKE) -C ../leim leim-list.el EMACS="$(bootstrap_exe)"
diff --git a/src/emacs.c b/src/emacs.c
index b4052b851d7..2e9f950851a 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1350,6 +1350,10 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
1350 tzset (); 1350 tzset ();
1351#endif /* MSDOS */ 1351#endif /* MSDOS */
1352 1352
1353#ifdef HAVE_KQUEUE
1354 globals_of_kqueue ();
1355#endif
1356
1353#ifdef HAVE_GFILENOTIFY 1357#ifdef HAVE_GFILENOTIFY
1354 globals_of_gfilenotify (); 1358 globals_of_gfilenotify ();
1355#endif 1359#endif
@@ -1520,14 +1524,18 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
1520 1524
1521 syms_of_gnutls (); 1525 syms_of_gnutls ();
1522 1526
1523#ifdef HAVE_GFILENOTIFY
1524 syms_of_gfilenotify ();
1525#endif /* HAVE_GFILENOTIFY */
1526
1527#ifdef HAVE_INOTIFY 1527#ifdef HAVE_INOTIFY
1528 syms_of_inotify (); 1528 syms_of_inotify ();
1529#endif /* HAVE_INOTIFY */ 1529#endif /* HAVE_INOTIFY */
1530 1530
1531#ifdef HAVE_KQUEUE
1532 syms_of_kqueue ();
1533#endif /* HAVE_KQUEUE */
1534
1535#ifdef HAVE_GFILENOTIFY
1536 syms_of_gfilenotify ();
1537#endif /* HAVE_GFILENOTIFY */
1538
1531#ifdef HAVE_DBUS 1539#ifdef HAVE_DBUS
1532 syms_of_dbusbind (); 1540 syms_of_dbusbind ();
1533#endif /* HAVE_DBUS */ 1541#endif /* HAVE_DBUS */
diff --git a/src/inotify.c b/src/inotify.c
index d1a80bbad1b..6577ee28cd1 100644
--- a/src/inotify.c
+++ b/src/inotify.c
@@ -46,8 +46,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
46static int inotifyfd = -1; 46static int inotifyfd = -1;
47 47
48/* Assoc list of files being watched. 48/* Assoc list of files being watched.
49 Format: 49 Format: (watch-descriptor name callback)
50 (watch-descriptor . callback)
51 */ 50 */
52static Lisp_Object watch_list; 51static Lisp_Object watch_list;
53 52
@@ -106,12 +105,14 @@ inotifyevent_to_event (Lisp_Object watch_object, struct inotify_event const *ev)
106 name = make_unibyte_string (ev->name, min (len, ev->len)); 105 name = make_unibyte_string (ev->name, min (len, ev->len));
107 name = DECODE_FILE (name); 106 name = DECODE_FILE (name);
108 } 107 }
108 else
109 name = XCAR (XCDR (watch_object));
109 110
110 return list2 (list4 (make_watch_descriptor (ev->wd), 111 return list2 (list4 (make_watch_descriptor (ev->wd),
111 mask_to_aspects (ev->mask), 112 mask_to_aspects (ev->mask),
112 name, 113 name,
113 make_number (ev->cookie)), 114 make_number (ev->cookie)),
114 XCDR (watch_object)); 115 Fnth (make_number (2), watch_object));
115} 116}
116 117
117/* This callback is called when the FD is available for read. The inotify 118/* This callback is called when the FD is available for read. The inotify
@@ -325,7 +326,7 @@ is managed internally and there is no corresponding inotify_init. Use
325 watch_list = Fdelete (watch_object, watch_list); 326 watch_list = Fdelete (watch_object, watch_list);
326 327
327 /* Store watch object in watch list. */ 328 /* Store watch object in watch list. */
328 watch_object = Fcons (watch_descriptor, callback); 329 watch_object = list3 (watch_descriptor, encoded_file_name, callback);
329 watch_list = Fcons (watch_object, watch_list); 330 watch_list = Fcons (watch_object, watch_list);
330 331
331 return watch_descriptor; 332 return watch_descriptor;
diff --git a/src/keyboard.c b/src/keyboard.c
index 2449abb7dfc..ab7cb34a030 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -5945,12 +5945,12 @@ make_lispy_event (struct input_event *event)
5945 } 5945 }
5946#endif /* HAVE_DBUS */ 5946#endif /* HAVE_DBUS */
5947 5947
5948#if defined HAVE_GFILENOTIFY || defined HAVE_INOTIFY 5948#if defined HAVE_INOTIFY || defined HAVE_KQUEUE || defined HAVE_GFILENOTIFY
5949 case FILE_NOTIFY_EVENT: 5949 case FILE_NOTIFY_EVENT:
5950 { 5950 {
5951 return Fcons (Qfile_notify, event->arg); 5951 return Fcons (Qfile_notify, event->arg);
5952 } 5952 }
5953#endif /* defined HAVE_GFILENOTIFY || defined HAVE_INOTIFY */ 5953#endif /* HAVE_INOTIFY || HAVE_KQUEUE || HAVE_GFILENOTIFY */
5954 5954
5955 case CONFIG_CHANGED_EVENT: 5955 case CONFIG_CHANGED_EVENT:
5956 return list3 (Qconfig_changed_event, 5956 return list3 (Qconfig_changed_event,
diff --git a/src/kqueue.c b/src/kqueue.c
new file mode 100644
index 00000000000..1830040637e
--- /dev/null
+++ b/src/kqueue.c
@@ -0,0 +1,520 @@
1/* Filesystem notifications support with kqueue API.
2 Copyright (C) 2015 Free Software Foundation, Inc.
3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software: you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
8the Free Software Foundation, either version 3 of the License, or
9(at your option) any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
18
19#include <config.h>
20
21#ifdef HAVE_KQUEUE
22#include <stdio.h>
23#include <sys/types.h>
24#include <sys/event.h>
25#include <sys/time.h>
26#include <sys/file.h>
27#include "lisp.h"
28#include "keyboard.h"
29#include "process.h"
30
31
32/* File handle for kqueue. */
33static int kqueuefd = -1;
34
35/* This is a list, elements are (DESCRIPTOR FILE FLAGS CALLBACK [DIRLIST]). */
36static Lisp_Object watch_list;
37
38/* Generate a list from the directory_files_internal output.
39 Items are (INODE FILE-NAME LAST-MOD LAST-STATUS-MOD SIZE). */
40Lisp_Object
41kqueue_directory_listing (Lisp_Object directory_files)
42{
43 Lisp_Object dl, result = Qnil;
44
45 for (dl = directory_files; ! NILP (dl); dl = XCDR (dl)) {
46 /* We ignore "." and "..". */
47 if ((strcmp (".", SSDATA (XCAR (XCAR (dl)))) == 0) ||
48 (strcmp ("..", SSDATA (XCAR (XCAR (dl)))) == 0))
49 continue;
50
51 result = Fcons
52 (list5 (/* inode. */
53 Fnth (make_number (11), XCAR (dl)),
54 /* filename. */
55 XCAR (XCAR (dl)),
56 /* last modification time. */
57 Fnth (make_number (6), XCAR (dl)),
58 /* last status change time. */
59 Fnth (make_number (7), XCAR (dl)),
60 /* size. */
61 Fnth (make_number (8), XCAR (dl))),
62 result);
63 }
64 return result;
65}
66
67/* Generate a file notification event. */
68static void
69kqueue_generate_event
70(Lisp_Object watch_object, Lisp_Object actions,
71 Lisp_Object file, Lisp_Object file1)
72{
73 Lisp_Object flags, action, entry;
74 struct input_event event;
75
76 /* Check, whether all actions shall be monitored. */
77 flags = Fnth (make_number (2), watch_object);
78 action = actions;
79 do {
80 if (NILP (action))
81 break;
82 entry = XCAR (action);
83 if (NILP (Fmember (entry, flags))) {
84 action = XCDR (action);
85 actions = Fdelq (entry, actions);
86 } else
87 action = XCDR (action);
88 } while (1);
89
90 /* Store it into the input event queue. */
91 if (! NILP (actions)) {
92 EVENT_INIT (event);
93 event.kind = FILE_NOTIFY_EVENT;
94 event.frame_or_window = Qnil;
95 event.arg = list2 (Fcons (XCAR (watch_object),
96 Fcons (actions,
97 NILP (file1)
98 ? Fcons (file, Qnil)
99 : list2 (file, file1))),
100 Fnth (make_number (3), watch_object));
101 kbd_buffer_store_event (&event);
102 }
103}
104
105/* This compares two directory listings in case of a `write' event for
106 a directory. Generate resulting file notification events. The old
107 directory listing is retrieved from watch_object, it will be
108 replaced by the new directory listing at the end of this
109 function. */
110static void
111kqueue_compare_dir_list
112(Lisp_Object watch_object)
113{
114 Lisp_Object dir, pending_dl, deleted_dl;
115 Lisp_Object old_directory_files, old_dl, new_directory_files, new_dl, dl;
116
117 dir = XCAR (XCDR (watch_object));
118 pending_dl = Qnil;
119 deleted_dl = Qnil;
120
121 old_directory_files = Fnth (make_number (4), watch_object);
122 old_dl = kqueue_directory_listing (old_directory_files);
123
124 /* When the directory is not accessible anymore, it has been deleted. */
125 if (NILP (Ffile_directory_p (dir))) {
126 kqueue_generate_event (watch_object, Fcons (Qdelete, Qnil), dir, Qnil);
127 return;
128 }
129 new_directory_files =
130 directory_files_internal (dir, Qnil, Qnil, Qnil, 1, Qnil);
131 new_dl = kqueue_directory_listing (new_directory_files);
132
133 /* Parse through the old list. */
134 dl = old_dl;
135 while (1) {
136 Lisp_Object old_entry, new_entry, dl1;
137 if (NILP (dl))
138 break;
139
140 /* Search for an entry with the same inode. */
141 old_entry = XCAR (dl);
142 new_entry = assq_no_quit (XCAR (old_entry), new_dl);
143 if (! NILP (Fequal (old_entry, new_entry))) {
144 /* Both entries are identical. Nothing to do. */
145 new_dl = Fdelq (new_entry, new_dl);
146 goto the_end;
147 }
148
149 /* Both entries have the same inode. */
150 if (! NILP (new_entry)) {
151 /* Both entries have the same file name. */
152 if (strcmp (SSDATA (XCAR (XCDR (old_entry))),
153 SSDATA (XCAR (XCDR (new_entry)))) == 0) {
154 /* Modification time has been changed, the file has been written. */
155 if (NILP (Fequal (Fnth (make_number (2), old_entry),
156 Fnth (make_number (2), new_entry))))
157 kqueue_generate_event
158 (watch_object, Fcons (Qwrite, Qnil), XCAR (XCDR (old_entry)), Qnil);
159 /* Status change time has been changed, the file attributes
160 have changed. */
161 if (NILP (Fequal (Fnth (make_number (3), old_entry),
162 Fnth (make_number (3), new_entry))))
163 kqueue_generate_event
164 (watch_object, Fcons (Qattrib, Qnil),
165 XCAR (XCDR (old_entry)), Qnil);
166
167 } else {
168 /* The file has been renamed. */
169 kqueue_generate_event
170 (watch_object, Fcons (Qrename, Qnil),
171 XCAR (XCDR (old_entry)), XCAR (XCDR (new_entry)));
172 deleted_dl = Fcons (new_entry, deleted_dl);
173 }
174 new_dl = Fdelq (new_entry, new_dl);
175 goto the_end;
176 }
177
178 /* Search, whether there is a file with the same name but another
179 inode. */
180 for (dl1 = new_dl; ! NILP (dl1); dl1 = XCDR (dl1)) {
181 new_entry = XCAR (dl1);
182 if (strcmp (SSDATA (XCAR (XCDR (old_entry))),
183 SSDATA (XCAR (XCDR (new_entry)))) == 0) {
184 pending_dl = Fcons (new_entry, pending_dl);
185 new_dl = Fdelq (new_entry, new_dl);
186 goto the_end;
187 }
188 }
189
190 /* Check, whether this a pending file. */
191 new_entry = assq_no_quit (XCAR (old_entry), pending_dl);
192
193 if (NILP (new_entry)) {
194 /* Check, whether this is an already deleted file (by rename). */
195 for (dl1 = deleted_dl; ! NILP (dl1); dl1 = XCDR (dl1)) {
196 new_entry = XCAR (dl1);
197 if (strcmp (SSDATA (XCAR (XCDR (old_entry))),
198 SSDATA (XCAR (XCDR (new_entry)))) == 0) {
199 deleted_dl = Fdelq (new_entry, deleted_dl);
200 goto the_end;
201 }
202 }
203 /* The file has been deleted. */
204 kqueue_generate_event
205 (watch_object, Fcons (Qdelete, Qnil), XCAR (XCDR (old_entry)), Qnil);
206
207 } else {
208 /* The file has been renamed. */
209 kqueue_generate_event
210 (watch_object, Fcons (Qrename, Qnil),
211 XCAR (XCDR (old_entry)), XCAR (XCDR (new_entry)));
212 pending_dl = Fdelq (new_entry, pending_dl);
213 }
214
215 the_end:
216 dl = XCDR (dl);
217 old_dl = Fdelq (old_entry, old_dl);
218 }
219
220 /* Parse through the resulting new list. */
221 dl = new_dl;
222 while (1) {
223 Lisp_Object entry;
224 if (NILP (dl))
225 break;
226
227 /* A new file has appeared. */
228 entry = XCAR (dl);
229 kqueue_generate_event
230 (watch_object, Fcons (Qcreate, Qnil), XCAR (XCDR (entry)), Qnil);
231
232 /* Check size of that file. */
233 Lisp_Object size = Fnth (make_number (4), entry);
234 if (FLOATP (size) || (XINT (size) > 0))
235 kqueue_generate_event
236 (watch_object, Fcons (Qwrite, Qnil), XCAR (XCDR (entry)), Qnil);
237
238 dl = XCDR (dl);
239 new_dl = Fdelq (entry, new_dl);
240 }
241
242 /* Parse through the resulting pending_dl list. */
243 dl = pending_dl;
244 while (1) {
245 Lisp_Object entry;
246 if (NILP (dl))
247 break;
248
249 /* A file is still pending. Assume it was a write. */
250 entry = XCAR (dl);
251 kqueue_generate_event
252 (watch_object, Fcons (Qwrite, Qnil), XCAR (XCDR (entry)), Qnil);
253
254 dl = XCDR (dl);
255 pending_dl = Fdelq (entry, pending_dl);
256 }
257
258 /* At this point, old_dl, new_dl and pending_dl shall be empty.
259 deleted_dl might not be empty when there was a rename to a
260 nonexisting file. Let's make a check for this (might be removed
261 once the code is stable). */
262 if (! NILP (old_dl))
263 report_file_error ("Old list not empty", old_dl);
264 if (! NILP (new_dl))
265 report_file_error ("New list not empty", new_dl);
266 if (! NILP (pending_dl))
267 report_file_error ("Pending events list not empty", pending_dl);
268 // if (! NILP (deleted_dl))
269 // report_file_error ("Deleted events list not empty", deleted_dl);
270
271 /* Replace old directory listing with the new one. */
272 XSETCDR (Fnthcdr (make_number (3), watch_object),
273 Fcons (new_directory_files, Qnil));
274 return;
275}
276
277/* This is the callback function for arriving input on kqueuefd. It
278 shall create a Lisp event, and put it into the Emacs input queue. */
279static void
280kqueue_callback (int fd, void *data)
281{
282 for (;;) {
283 struct kevent kev;
284 static const struct timespec nullts = { 0, 0 };
285 Lisp_Object descriptor, watch_object, file, actions;
286
287 /* Read one event. */
288 int ret = kevent (kqueuefd, NULL, 0, &kev, 1, &nullts);
289 if (ret < 1) {
290 /* All events read. */
291 return;
292 }
293
294 /* Determine descriptor and file name. */
295 descriptor = make_number (kev.ident);
296 watch_object = assq_no_quit (descriptor, watch_list);
297 if (CONSP (watch_object))
298 file = XCAR (XCDR (watch_object));
299 else
300 continue;
301
302 /* Determine event actions. */
303 actions = Qnil;
304 if (kev.fflags & NOTE_DELETE)
305 actions = Fcons (Qdelete, actions);
306 if (kev.fflags & NOTE_WRITE) {
307 /* Check, whether this is a directory event. */
308 if (NILP (Fnth (make_number (4), watch_object)))
309 actions = Fcons (Qwrite, actions);
310 else
311 kqueue_compare_dir_list (watch_object);
312 }
313 if (kev.fflags & NOTE_EXTEND)
314 actions = Fcons (Qextend, actions);
315 if (kev.fflags & NOTE_ATTRIB)
316 actions = Fcons (Qattrib, actions);
317 if (kev.fflags & NOTE_LINK)
318 actions = Fcons (Qlink, actions);
319 /* It would be useful to know the target of the rename operation.
320 At this point, it is not possible. Happens only when the upper
321 directory is monitored. */
322 if (kev.fflags & NOTE_RENAME)
323 actions = Fcons (Qrename, actions);
324
325 /* Create the event. */
326 if (! NILP (actions))
327 kqueue_generate_event (watch_object, actions, file, Qnil);
328
329 /* Cancel monitor if file or directory is deleted or renamed. */
330 if (kev.fflags & (NOTE_DELETE | NOTE_RENAME))
331 Fkqueue_rm_watch (descriptor);
332 }
333 return;
334}
335
336DEFUN ("kqueue-add-watch", Fkqueue_add_watch, Skqueue_add_watch, 3, 3, 0,
337 doc: /* Add a watch for filesystem events pertaining to FILE.
338
339This arranges for filesystem events pertaining to FILE to be reported
340to Emacs. Use `kqueue-rm-watch' to cancel the watch.
341
342Returned value is a descriptor for the added watch. If the file cannot be
343watched for some reason, this function signals a `file-notify-error' error.
344
345FLAGS is a list of events to be watched for. It can include the
346following symbols:
347
348 `create' -- FILE was created
349 `delete' -- FILE was deleted
350 `write' -- FILE has changed
351 `extend' -- FILE was extended
352 `attrib' -- a FILE attribute was changed
353 `link' -- a FILE's link count was changed
354 `rename' -- FILE was moved to FILE1
355
356When any event happens, Emacs will call the CALLBACK function passing
357it a single argument EVENT, which is of the form
358
359 (DESCRIPTOR ACTIONS FILE [FILE1])
360
361DESCRIPTOR is the same object as the one returned by this function.
362ACTIONS is a list of events.
363
364FILE is the name of the file whose event is being reported. FILE1
365will be reported only in case of the `rename' event. This is possible
366only when the upper directory of the renamed file is watched. */)
367 (Lisp_Object file, Lisp_Object flags, Lisp_Object callback)
368{
369 Lisp_Object watch_object, dir_list;
370 int fd, oflags;
371 u_short fflags = 0;
372 struct kevent kev;
373
374 /* Check parameters. */
375 CHECK_STRING (file);
376 file = Fdirectory_file_name (Fexpand_file_name (file, Qnil));
377 if (NILP (Ffile_exists_p (file)))
378 report_file_error ("File does not exist", file);
379
380 CHECK_LIST (flags);
381
382 if (! FUNCTIONP (callback))
383 wrong_type_argument (Qinvalid_function, callback);
384
385 if (kqueuefd < 0)
386 {
387 /* Create kqueue descriptor. */
388 kqueuefd = kqueue ();
389 if (kqueuefd < 0)
390 report_file_notify_error ("File watching is not available", Qnil);
391
392 /* Start monitoring for possible I/O. */
393 add_read_fd (kqueuefd, kqueue_callback, NULL);
394
395 watch_list = Qnil;
396 }
397
398 /* Open file. */
399 file = ENCODE_FILE (file);
400 oflags = O_NONBLOCK;
401#if O_EVTONLY
402 oflags |= O_EVTONLY;
403#else
404 oflags |= O_RDONLY;
405#endif
406#if O_SYMLINK
407 oflags |= O_SYMLINK;
408#else
409 oflags |= O_NOFOLLOW;
410#endif
411 fd = emacs_open (SSDATA (file), oflags, 0);
412 if (fd == -1)
413 report_file_error ("File cannot be opened", file);
414
415 /* Assemble filter flags */
416 if (! NILP (Fmember (Qdelete, flags))) fflags |= NOTE_DELETE;
417 if (! NILP (Fmember (Qwrite, flags))) fflags |= NOTE_WRITE;
418 if (! NILP (Fmember (Qextend, flags))) fflags |= NOTE_EXTEND;
419 if (! NILP (Fmember (Qattrib, flags))) fflags |= NOTE_ATTRIB;
420 if (! NILP (Fmember (Qlink, flags))) fflags |= NOTE_LINK;
421 if (! NILP (Fmember (Qrename, flags))) fflags |= NOTE_RENAME;
422
423 /* Register event. */
424 EV_SET (&kev, fd, EVFILT_VNODE, EV_ADD | EV_ENABLE | EV_CLEAR,
425 fflags, 0, NULL);
426
427 if (kevent (kqueuefd, &kev, 1, NULL, 0, NULL) < 0) {
428 emacs_close (fd);
429 report_file_error ("Cannot watch file", file);
430 }
431
432 /* Store watch object in watch list. */
433 Lisp_Object watch_descriptor = make_number (fd);
434 if (NILP (Ffile_directory_p (file)))
435 watch_object = list4 (watch_descriptor, file, flags, callback);
436 else {
437 dir_list = directory_files_internal (file, Qnil, Qnil, Qnil, 1, Qnil);
438 watch_object = list5 (watch_descriptor, file, flags, callback, dir_list);
439 }
440 watch_list = Fcons (watch_object, watch_list);
441
442 return watch_descriptor;
443}
444
445DEFUN ("kqueue-rm-watch", Fkqueue_rm_watch, Skqueue_rm_watch, 1, 1, 0,
446 doc: /* Remove an existing WATCH-DESCRIPTOR.
447
448WATCH-DESCRIPTOR should be an object returned by `kqueue-add-watch'. */)
449 (Lisp_Object watch_descriptor)
450{
451 Lisp_Object watch_object = assq_no_quit (watch_descriptor, watch_list);
452
453 if (! CONSP (watch_object))
454 xsignal2 (Qfile_notify_error, build_string ("Not a watch descriptor"),
455 watch_descriptor);
456
457 eassert (INTEGERP (watch_descriptor));
458 int fd = XINT (watch_descriptor);
459 if ( fd >= 0)
460 emacs_close (fd);
461
462 /* Remove watch descriptor from watch list. */
463 watch_list = Fdelq (watch_object, watch_list);
464
465 if (NILP (watch_list) && (kqueuefd >= 0)) {
466 delete_read_fd (kqueuefd);
467 emacs_close (kqueuefd);
468 kqueuefd = -1;
469 }
470
471 return Qt;
472}
473
474DEFUN ("kqueue-valid-p", Fkqueue_valid_p, Skqueue_valid_p, 1, 1, 0,
475 doc: /* "Check a watch specified by its WATCH-DESCRIPTOR.
476
477WATCH-DESCRIPTOR should be an object returned by `kqueue-add-watch'.
478
479A watch can become invalid if the file or directory it watches is
480deleted, or if the watcher thread exits abnormally for any other
481reason. Removing the watch by calling `kqueue-rm-watch' also makes it
482invalid. */)
483 (Lisp_Object watch_descriptor)
484{
485 return NILP (assq_no_quit (watch_descriptor, watch_list)) ? Qnil : Qt;
486}
487
488
489void
490globals_of_kqueue (void)
491{
492 watch_list = Qnil;
493}
494
495void
496syms_of_kqueue (void)
497{
498 defsubr (&Skqueue_add_watch);
499 defsubr (&Skqueue_rm_watch);
500 defsubr (&Skqueue_valid_p);
501
502 /* Event types. */
503 DEFSYM (Qcreate, "create");
504 DEFSYM (Qdelete, "delete"); /* NOTE_DELETE */
505 DEFSYM (Qwrite, "write"); /* NOTE_WRITE */
506 DEFSYM (Qextend, "extend"); /* NOTE_EXTEND */
507 DEFSYM (Qattrib, "attrib"); /* NOTE_ATTRIB */
508 DEFSYM (Qlink, "link"); /* NOTE_LINK */
509 DEFSYM (Qrename, "rename"); /* NOTE_RENAME */
510
511 staticpro (&watch_list);
512
513 Fprovide (intern_c_string ("kqueue"), Qnil);
514}
515
516#endif /* HAVE_KQUEUE */
517
518/* PROBLEMS
519 * https://bugs.launchpad.net/ubuntu/+source/libkqueue/+bug/1514837
520 prevents tests on Ubuntu. */
diff --git a/src/lisp.h b/src/lisp.h
index 3efa492e0e8..426b6c949e9 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4257,17 +4257,23 @@ extern void init_font (void);
4257extern void syms_of_fontset (void); 4257extern void syms_of_fontset (void);
4258#endif 4258#endif
4259 4259
4260/* Defined in inotify.c */
4261#ifdef HAVE_INOTIFY
4262extern void syms_of_inotify (void);
4263#endif
4264
4265/* Defined in kqueue.c */
4266#ifdef HAVE_KQUEUE
4267extern void globals_of_kqueue (void);
4268extern void syms_of_kqueue (void);
4269#endif
4270
4260/* Defined in gfilenotify.c */ 4271/* Defined in gfilenotify.c */
4261#ifdef HAVE_GFILENOTIFY 4272#ifdef HAVE_GFILENOTIFY
4262extern void globals_of_gfilenotify (void); 4273extern void globals_of_gfilenotify (void);
4263extern void syms_of_gfilenotify (void); 4274extern void syms_of_gfilenotify (void);
4264#endif 4275#endif
4265 4276
4266/* Defined in inotify.c */
4267#ifdef HAVE_INOTIFY
4268extern void syms_of_inotify (void);
4269#endif
4270
4271#ifdef HAVE_W32NOTIFY 4277#ifdef HAVE_W32NOTIFY
4272/* Defined on w32notify.c. */ 4278/* Defined on w32notify.c. */
4273extern void syms_of_w32notify (void); 4279extern void syms_of_w32notify (void);
diff --git a/test/automated/auto-revert-tests.el b/test/automated/auto-revert-tests.el
index 2745f106087..6f186973ee7 100644
--- a/test/automated/auto-revert-tests.el
+++ b/test/automated/auto-revert-tests.el
@@ -136,7 +136,7 @@
136 ;; Strange, that `copy-directory' does not work as expected. 136 ;; Strange, that `copy-directory' does not work as expected.
137 ;; The following shell command is not portable on all 137 ;; The following shell command is not portable on all
138 ;; platforms, unfortunately. 138 ;; platforms, unfortunately.
139 (shell-command (format "%s -f %s/* %s" cp tmpdir2 tmpdir1)) 139 (shell-command (format "%s %s/* %s" cp tmpdir2 tmpdir1))
140 140
141 ;; Check, that the buffers have been reverted. 141 ;; Check, that the buffers have been reverted.
142 (dolist (buf (list buf1 buf2)) 142 (dolist (buf (list buf1 buf2))
diff --git a/test/automated/file-notify-tests.el b/test/automated/file-notify-tests.el
index 67e929a6477..b665dddb631 100644
--- a/test/automated/file-notify-tests.el
+++ b/test/automated/file-notify-tests.el
@@ -65,7 +65,11 @@
65 65
66(defun file-notify--test-timeout () 66(defun file-notify--test-timeout ()
67 "Timeout to wait for arriving events, in seconds." 67 "Timeout to wait for arriving events, in seconds."
68 (if (file-remote-p temporary-file-directory) 6 3)) 68 (cond
69 ((file-remote-p temporary-file-directory) 6)
70 ((string-equal (file-notify--test-library) "w32notify") 20)
71 ((eq system-type 'cygwin) 10)
72 (t 3)))
69 73
70(defun file-notify--test-cleanup () 74(defun file-notify--test-cleanup ()
71 "Cleanup after a test." 75 "Cleanup after a test."
@@ -133,6 +137,18 @@ being the result.")
133 ;; Return result. 137 ;; Return result.
134 (cdr file-notify--test-remote-enabled-checked)) 138 (cdr file-notify--test-remote-enabled-checked))
135 139
140(defun file-notify--test-library ()
141 "The used libray for the test, as string.
142In the remote case, it is the process name which runs on the
143remote host, or nil."
144 (if (null (file-remote-p temporary-file-directory))
145 (symbol-name file-notify--library)
146 (and (consp file-notify--test-remote-enabled-checked)
147 (processp (cdr file-notify--test-remote-enabled-checked))
148 (replace-regexp-in-string
149 "<[[:digit:]]+>\\'" ""
150 (process-name (cdr file-notify--test-remote-enabled-checked))))))
151
136(defmacro file-notify--deftest-remote (test docstring) 152(defmacro file-notify--deftest-remote (test docstring)
137 "Define ert `TEST-remote' for remote files." 153 "Define ert `TEST-remote' for remote files."
138 (declare (indent 1)) 154 (declare (indent 1))
@@ -150,12 +166,7 @@ being the result.")
150 "Test availability of `file-notify'." 166 "Test availability of `file-notify'."
151 (skip-unless (file-notify--test-local-enabled)) 167 (skip-unless (file-notify--test-local-enabled))
152 ;; Report the native library which has been used. 168 ;; Report the native library which has been used.
153 (if (null (file-remote-p temporary-file-directory)) 169 (message "Library: `%s'" (file-notify--test-library))
154 (message "Local library: `%s'" file-notify--library)
155 (message "Remote command: `%s'"
156 (replace-regexp-in-string
157 "<[[:digit:]]+>\\'" ""
158 (process-name (cdr file-notify--test-remote-enabled-checked)))))
159 (should 170 (should
160 (setq file-notify--test-desc 171 (setq file-notify--test-desc
161 (file-notify-add-watch temporary-file-directory '(change) 'ignore))) 172 (file-notify-add-watch temporary-file-directory '(change) 'ignore)))
@@ -189,12 +200,13 @@ being the result.")
189 (file-notify-add-watch 200 (file-notify-add-watch
190 temporary-file-directory '(change attribute-change) 'ignore))) 201 temporary-file-directory '(change attribute-change) 'ignore)))
191 (file-notify-rm-watch file-notify--test-desc) 202 (file-notify-rm-watch file-notify--test-desc)
192 ;; The file does not need to exist, just the upper directory. 203 (write-region "any text" nil file-notify--test-tmpfile nil 'no-message)
193 (should 204 (should
194 (setq file-notify--test-desc 205 (setq file-notify--test-desc
195 (file-notify-add-watch 206 (file-notify-add-watch
196 file-notify--test-tmpfile '(change attribute-change) 'ignore))) 207 file-notify--test-tmpfile '(change attribute-change) 'ignore)))
197 (file-notify-rm-watch file-notify--test-desc) 208 (file-notify-rm-watch file-notify--test-desc)
209 (delete-file file-notify--test-tmpfile)
198 210
199 ;; Check error handling. 211 ;; Check error handling.
200 (should-error (file-notify-add-watch 1 2 3 4) 212 (should-error (file-notify-add-watch 1 2 3 4)
@@ -235,16 +247,17 @@ is bound somewhere."
235 (should 247 (should
236 (or (string-equal (file-notify--event-file-name file-notify--test-event) 248 (or (string-equal (file-notify--event-file-name file-notify--test-event)
237 file-notify--test-tmpfile) 249 file-notify--test-tmpfile)
238 (string-equal (directory-file-name 250 (string-equal (file-notify--event-file-name file-notify--test-event)
239 (file-name-directory 251 file-notify--test-tmpfile1)
240 (file-notify--event-file-name file-notify--test-event))) 252 (string-equal (file-notify--event-file-name file-notify--test-event)
241 file-notify--test-tmpfile))) 253 temporary-file-directory)))
242 ;; Check the second file name if exists. 254 ;; Check the second file name if exists.
243 (when (eq (nth 1 file-notify--test-event) 'renamed) 255 (when (eq (nth 1 file-notify--test-event) 'renamed)
244 (should 256 (should
245 (string-equal 257 (or (string-equal (file-notify--event-file1-name file-notify--test-event)
246 (file-notify--event-file1-name file-notify--test-event) 258 file-notify--test-tmpfile1)
247 file-notify--test-tmpfile1)))) 259 (string-equal (file-notify--event-file1-name file-notify--test-event)
260 temporary-file-directory)))))
248 261
249(defun file-notify--test-event-handler (event) 262(defun file-notify--test-event-handler (event)
250 "Run a test over FILE-NOTIFY--TEST-EVENT. 263 "Run a test over FILE-NOTIFY--TEST-EVENT.
@@ -253,7 +266,7 @@ and the event to `file-notify--test-events'."
253 (let* ((file-notify--test-event event) 266 (let* ((file-notify--test-event event)
254 (result 267 (result
255 (ert-run-test (make-ert-test :body 'file-notify--test-event-test)))) 268 (ert-run-test (make-ert-test :body 'file-notify--test-event-test))))
256 ;; Do not add temporary files, this would confuse the checks. 269 ;; Do not add lock files, this would confuse the checks.
257 (unless (string-match 270 (unless (string-match
258 (regexp-quote ".#") 271 (regexp-quote ".#")
259 (file-notify--event-file-name file-notify--test-event)) 272 (file-notify--event-file-name file-notify--test-event))
@@ -280,13 +293,19 @@ TIMEOUT is the maximum time to wait for, in seconds."
280Don't wait longer than timeout seconds for the events to be delivered." 293Don't wait longer than timeout seconds for the events to be delivered."
281 (declare (indent 1)) 294 (declare (indent 1))
282 (let ((outer (make-symbol "outer"))) 295 (let ((outer (make-symbol "outer")))
283 `(let ((,outer file-notify--test-events)) 296 `(let ((,outer file-notify--test-events)
297 create-lockfiles)
284 (setq file-notify--test-expected-events 298 (setq file-notify--test-expected-events
285 (append file-notify--test-expected-events ,events)) 299 (append file-notify--test-expected-events ,events))
300 ;; Flush pending events.
301 (file-notify--wait-for-events
302 (file-notify--test-timeout)
303 (input-pending-p))
286 (let (file-notify--test-events) 304 (let (file-notify--test-events)
287 ,@body 305 ,@body
288 (file-notify--wait-for-events 306 (file-notify--wait-for-events
289 (file-notify--test-timeout) 307 ;; More events need more time. Use some fudge factor.
308 (* (ceiling (length ,events) 100) (file-notify--test-timeout))
290 (= (length ,events) (length file-notify--test-events))) 309 (= (length ,events) (length file-notify--test-events)))
291 (should (equal ,events (mapcar #'cadr file-notify--test-events))) 310 (should (equal ,events (mapcar #'cadr file-notify--test-events)))
292 (setq ,outer (append ,outer file-notify--test-events))) 311 (setq ,outer (append ,outer file-notify--test-events)))
@@ -295,111 +314,207 @@ Don't wait longer than timeout seconds for the events to be delivered."
295(ert-deftest file-notify-test02-events () 314(ert-deftest file-notify-test02-events ()
296 "Check file creation/change/removal notifications." 315 "Check file creation/change/removal notifications."
297 (skip-unless (file-notify--test-local-enabled)) 316 (skip-unless (file-notify--test-local-enabled))
298 ;; Under cygwin there are so bad timings that it doesn't make sense to test.
299 (skip-unless (not (eq system-type 'cygwin)))
300
301 (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)
302 file-notify--test-tmpfile1 (file-notify--test-make-temp-name))
303 317
304 (unwind-protect 318 (unwind-protect
305 (progn 319 (progn
306 ;; Check creation, change and deletion. 320 ;; Check file creation, change and deletion. It doesn't work
307 (setq file-notify--test-desc 321 ;; for cygwin and kqueue, because we don't use an implicit
308 (file-notify-add-watch 322 ;; directory monitor (kqueue), or the timings are too bad (cygwin).
309 file-notify--test-tmpfile 323 (unless (or (eq system-type 'cygwin)
310 '(change) 'file-notify--test-event-handler)) 324 (string-equal (file-notify--test-library) "kqueue"))
311 (file-notify--test-with-events '(created changed deleted) 325 (setq file-notify--test-tmpfile (file-notify--test-make-temp-name))
326 (should
327 (setq file-notify--test-desc
328 (file-notify-add-watch
329 file-notify--test-tmpfile
330 '(change) 'file-notify--test-event-handler)))
331 (file-notify--test-with-events
332 (cond
333 ;; cygwin recognizes only `deleted' and `stopped' events.
334 ((eq system-type 'cygwin)
335 '(deleted stopped))
336 (t '(created changed deleted stopped)))
337 (write-region
338 "another text" nil file-notify--test-tmpfile nil 'no-message)
339 (read-event nil nil 0.1)
340 (delete-file file-notify--test-tmpfile))
341 ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it.
342 (let (file-notify--test-events)
343 (file-notify-rm-watch file-notify--test-desc)))
344
345 ;; Check file change and deletion.
346 (setq file-notify--test-tmpfile (file-notify--test-make-temp-name))
347 (write-region "any text" nil file-notify--test-tmpfile nil 'no-message)
348 (should
349 (setq file-notify--test-desc
350 (file-notify-add-watch
351 file-notify--test-tmpfile
352 '(change) 'file-notify--test-event-handler)))
353 (file-notify--test-with-events
354 (cond
355 ;; cygwin recognizes only `deleted' and `stopped' events.
356 ((eq system-type 'cygwin)
357 '(deleted stopped))
358 ;; inotify, kqueueg and gfilenotify raise just one
359 ;; `changed' event, the other backends show us two of
360 ;; them.
361 ((or (string-equal "inotify" (file-notify--test-library))
362 (string-equal "kqueue" (file-notify--test-library))
363 (string-equal "gfilenotify" (file-notify--test-library)))
364 '(changed deleted stopped))
365 (t '(changed changed deleted stopped)))
366 (read-event nil nil 0.1)
312 (write-region 367 (write-region
313 "any text" nil file-notify--test-tmpfile nil 'no-message) 368 "another text" nil file-notify--test-tmpfile nil 'no-message)
369 (read-event nil nil 0.1)
314 (delete-file file-notify--test-tmpfile)) 370 (delete-file file-notify--test-tmpfile))
315 ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. 371 ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it.
316 (let (file-notify--test-events) 372 (let (file-notify--test-events)
317 (file-notify-rm-watch file-notify--test-desc)) 373 (file-notify-rm-watch file-notify--test-desc))
318 374
319 ;; Check creation, change and deletion. There must be a 375 ;; Check file creation, change and deletion when watching a
320 ;; `stopped' event when deleting the directory. It doesn't 376 ;; directory. There must be a `stopped' event when deleting
321 ;; work for w32notify. 377 ;; the directory.
322 (unless (eq file-notify--library 'w32notify) 378 (let ((temporary-file-directory
323 (make-directory file-notify--test-tmpfile) 379 (make-temp-file "file-notify-test-parent" t)))
324 (setq file-notify--test-desc 380 (should
325 (file-notify-add-watch 381 (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)
326 file-notify--test-tmpfile 382 file-notify--test-desc
327 '(change) 'file-notify--test-event-handler)) 383 (file-notify-add-watch
384 temporary-file-directory
385 '(change) 'file-notify--test-event-handler)))
328 (file-notify--test-with-events 386 (file-notify--test-with-events
329 ;; There are two `deleted' events, for the file and for 387 (cond
330 ;; the directory. 388 ;; w32notify does raise a `stopped' event when a
331 '(created changed deleted deleted stopped) 389 ;; watched directory is deleted.
390 ((string-equal (file-notify--test-library) "w32notify")
391 '(created changed deleted))
392 ;; cygwin recognizes only `deleted' and `stopped' events.
393 ((eq system-type 'cygwin)
394 '(deleted stopped))
395 ;; There are two `deleted' events, for the file and for
396 ;; the directory. Except for kqueue.
397 ((string-equal (file-notify--test-library) "kqueue")
398 '(created changed deleted stopped))
399 (t '(created changed deleted deleted stopped)))
400 (read-event nil nil 0.1)
332 (write-region 401 (write-region
333 "any text" nil (expand-file-name "foo" file-notify--test-tmpfile) 402 "any text" nil file-notify--test-tmpfile nil 'no-message)
334 nil 'no-message) 403 (read-event nil nil 0.1)
335 (delete-directory file-notify--test-tmpfile 'recursive)) 404 (delete-directory temporary-file-directory 'recursive))
336 ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. 405 ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it.
337 (let (file-notify--test-events) 406 (let (file-notify--test-events)
338 (file-notify-rm-watch file-notify--test-desc))) 407 (file-notify-rm-watch file-notify--test-desc)))
339 408
340 ;; Check copy. 409 ;; Check copy of files inside a directory.
341 (setq file-notify--test-desc 410 (let ((temporary-file-directory
342 (file-notify-add-watch 411 (make-temp-file "file-notify-test-parent" t)))
343 file-notify--test-tmpfile 412 (should
344 '(change) 'file-notify--test-event-handler)) 413 (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)
345 (should file-notify--test-desc) 414 file-notify--test-tmpfile1 (file-notify--test-make-temp-name)
346 (file-notify--test-with-events 415 file-notify--test-desc
347 ;; w32notify does not distinguish between `changed' and 416 (file-notify-add-watch
348 ;; `attribute-changed'. 417 temporary-file-directory
349 (if (eq file-notify--library 'w32notify) 418 '(change) 'file-notify--test-event-handler)))
350 '(created changed changed deleted) 419 (file-notify--test-with-events
351 '(created changed deleted)) 420 (cond
352 (write-region 421 ;; w32notify does not distinguish between `changed' and
353 "any text" nil file-notify--test-tmpfile nil 'no-message) 422 ;; `attribute-changed'.
354 (copy-file file-notify--test-tmpfile file-notify--test-tmpfile1) 423 ((string-equal (file-notify--test-library) "w32notify")
355 ;; The next two events shall not be visible. 424 '(created changed created changed changed changed changed
356 (set-file-modes file-notify--test-tmpfile 000) 425 deleted deleted))
357 (read-event nil nil 0.1) ; In order to distinguish the events. 426 ;; cygwin recognizes only `deleted' and `stopped' events.
358 (set-file-times file-notify--test-tmpfile '(0 0)) 427 ((eq system-type 'cygwin)
359 (delete-file file-notify--test-tmpfile) 428 '(deleted stopped))
360 (delete-file file-notify--test-tmpfile1)) 429 ;; There are three `deleted' events, for two files and
361 ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. 430 ;; for the directory. Except for kqueue.
362 (let (file-notify--test-events) 431 ((string-equal (file-notify--test-library) "kqueue")
363 (file-notify-rm-watch file-notify--test-desc)) 432 '(created changed created changed deleted stopped))
433 (t '(created changed created changed
434 deleted deleted deleted stopped)))
435 (read-event nil nil 0.1)
436 (write-region
437 "any text" nil file-notify--test-tmpfile nil 'no-message)
438 (read-event nil nil 0.1)
439 (copy-file file-notify--test-tmpfile file-notify--test-tmpfile1)
440 ;; The next two events shall not be visible.
441 (read-event nil nil 0.1)
442 (set-file-modes file-notify--test-tmpfile 000)
443 (read-event nil nil 0.1)
444 (set-file-times file-notify--test-tmpfile '(0 0))
445 (read-event nil nil 0.1)
446 (delete-directory temporary-file-directory 'recursive))
447 ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it.
448 (let (file-notify--test-events)
449 (file-notify-rm-watch file-notify--test-desc)))
364 450
365 ;; Check rename. 451 ;; Check rename of files inside a directory.
366 (setq file-notify--test-desc 452 (let ((temporary-file-directory
367 (file-notify-add-watch 453 (make-temp-file "file-notify-test-parent" t)))
368 file-notify--test-tmpfile 454 (should
369 '(change) 'file-notify--test-event-handler)) 455 (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)
370 (should file-notify--test-desc) 456 file-notify--test-tmpfile1 (file-notify--test-make-temp-name)
371 (file-notify--test-with-events '(created changed renamed) 457 file-notify--test-desc
372 (write-region 458 (file-notify-add-watch
373 "any text" nil file-notify--test-tmpfile nil 'no-message) 459 temporary-file-directory
374 (rename-file file-notify--test-tmpfile file-notify--test-tmpfile1) 460 '(change) 'file-notify--test-event-handler)))
375 ;; After the rename, we won't get events anymore. 461 (file-notify--test-with-events
376 (delete-file file-notify--test-tmpfile1)) 462 (cond
377 ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. 463 ;; w32notify does not distinguish between `changed' and
378 (let (file-notify--test-events) 464 ;; `attribute-changed'.
379 (file-notify-rm-watch file-notify--test-desc)) 465 ((string-equal (file-notify--test-library) "w32notify")
466 '(created changed renamed deleted))
467 ;; cygwin recognizes only `deleted' and `stopped' events.
468 ((eq system-type 'cygwin)
469 '(deleted stopped))
470 ;; There are two `deleted' events, for the file and for
471 ;; the directory. Except for kqueue.
472 ((string-equal (file-notify--test-library) "kqueue")
473 '(created changed renamed deleted stopped))
474 (t '(created changed renamed deleted deleted stopped)))
475 (read-event nil nil 0.1)
476 (write-region
477 "any text" nil file-notify--test-tmpfile nil 'no-message)
478 (read-event nil nil 0.1)
479 (rename-file file-notify--test-tmpfile file-notify--test-tmpfile1)
480 ;; After the rename, we won't get events anymore.
481 (read-event nil nil 0.1)
482 (delete-directory temporary-file-directory 'recursive))
483 ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it.
484 (let (file-notify--test-events)
485 (file-notify-rm-watch file-notify--test-desc)))
380 486
381 ;; Check attribute change. It doesn't work for w32notify. 487 ;; Check attribute change. Does not work for cygwin.
382 (unless (eq file-notify--library 'w32notify) 488 (unless (eq system-type 'cygwin)
383 (setq file-notify--test-desc 489 (setq file-notify--test-tmpfile (file-notify--test-make-temp-name))
384 (file-notify-add-watch 490 (write-region
385 file-notify--test-tmpfile 491 "any text" nil file-notify--test-tmpfile nil 'no-message)
386 '(attribute-change) 'file-notify--test-event-handler)) 492 (should
387 (file-notify--test-with-events 493 (setq file-notify--test-desc
388 (if (file-remote-p temporary-file-directory) 494 (file-notify-add-watch
389 ;; In the remote case, `write-region' raises also an 495 file-notify--test-tmpfile
390 ;; `attribute-changed' event. 496 '(attribute-change) 'file-notify--test-event-handler)))
391 '(attribute-changed attribute-changed attribute-changed) 497 (file-notify--test-with-events
392 '(attribute-changed attribute-changed)) 498 (cond
393 ;; We must use short delays between the operations. 499 ;; w32notify does not distinguish between `changed' and
394 ;; Otherwise, not all events arrive us in the remote case. 500 ;; `attribute-changed'.
395 (write-region 501 ((string-equal (file-notify--test-library) "w32notify")
396 "any text" nil file-notify--test-tmpfile nil 'no-message) 502 '(changed changed changed changed))
397 (read-event nil nil 0.1) 503 ;; For kqueue and in the remote case, `write-region'
398 (set-file-modes file-notify--test-tmpfile 000) 504 ;; raises also an `attribute-changed' event.
399 (read-event nil nil 0.1) 505 ((or (string-equal (file-notify--test-library) "kqueue")
400 (set-file-times file-notify--test-tmpfile '(0 0)) 506 (file-remote-p temporary-file-directory))
401 (read-event nil nil 0.1) 507 '(attribute-changed attribute-changed attribute-changed))
402 (delete-file file-notify--test-tmpfile)) 508 (t '(attribute-changed attribute-changed)))
509 (read-event nil nil 0.1)
510 (write-region
511 "any text" nil file-notify--test-tmpfile nil 'no-message)
512 (read-event nil nil 0.1)
513 (set-file-modes file-notify--test-tmpfile 000)
514 (read-event nil nil 0.1)
515 (set-file-times file-notify--test-tmpfile '(0 0))
516 (read-event nil nil 0.1)
517 (delete-file file-notify--test-tmpfile))
403 ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. 518 ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it.
404 (let (file-notify--test-events) 519 (let (file-notify--test-events)
405 (file-notify-rm-watch file-notify--test-desc))) 520 (file-notify-rm-watch file-notify--test-desc)))
@@ -475,28 +590,31 @@ Don't wait longer than timeout seconds for the events to be delivered."
475 (should (string-match "another text" (buffer-string))) 590 (should (string-match "another text" (buffer-string)))
476 591
477 ;; Stop file notification. Autorevert shall still work via polling. 592 ;; Stop file notification. Autorevert shall still work via polling.
478 (file-notify-rm-watch auto-revert-notify-watch-descriptor) 593 ;; It doesn't work for `w32notify'.
479 (file-notify--wait-for-events 594 (unless (string-equal (file-notify--test-library) "w32notify")
480 timeout (null auto-revert-use-notify)) 595 (file-notify-rm-watch auto-revert-notify-watch-descriptor)
481 (should-not auto-revert-use-notify)
482 (should-not auto-revert-notify-watch-descriptor)
483
484 ;; Modify file. We wait for two seconds, in order to have
485 ;; another timestamp. One second seems to be too short.
486 (with-current-buffer (get-buffer-create "*Messages*")
487 (narrow-to-region (point-max) (point-max)))
488 (sleep-for 2)
489 (write-region
490 "foo bla" nil file-notify--test-tmpfile nil 'no-message)
491
492 ;; Check, that the buffer has been reverted.
493 (with-current-buffer (get-buffer-create "*Messages*")
494 (file-notify--wait-for-events 596 (file-notify--wait-for-events
495 timeout 597 timeout (null auto-revert-use-notify))
496 (string-match 598 (should-not auto-revert-use-notify)
497 (format-message "Reverting buffer `%s'." (buffer-name buf)) 599 (should-not auto-revert-notify-watch-descriptor)
498 (buffer-string)))) 600
499 (should (string-match "foo bla" (buffer-string))))) 601 ;; Modify file. We wait for two seconds, in order to
602 ;; have another timestamp. One second seems to be too
603 ;; short.
604 (with-current-buffer (get-buffer-create "*Messages*")
605 (narrow-to-region (point-max) (point-max)))
606 (sleep-for 2)
607 (write-region
608 "foo bla" nil file-notify--test-tmpfile nil 'no-message)
609
610 ;; Check, that the buffer has been reverted.
611 (with-current-buffer (get-buffer-create "*Messages*")
612 (file-notify--wait-for-events
613 timeout
614 (string-match
615 (format-message "Reverting buffer `%s'." (buffer-name buf))
616 (buffer-string))))
617 (should (string-match "foo bla" (buffer-string))))))
500 618
501 ;; Cleanup. 619 ;; Cleanup.
502 (with-current-buffer "*Messages*" (widen)) 620 (with-current-buffer "*Messages*" (widen))
@@ -509,51 +627,92 @@ Don't wait longer than timeout seconds for the events to be delivered."
509(ert-deftest file-notify-test04-file-validity () 627(ert-deftest file-notify-test04-file-validity ()
510 "Check `file-notify-valid-p' for files." 628 "Check `file-notify-valid-p' for files."
511 (skip-unless (file-notify--test-local-enabled)) 629 (skip-unless (file-notify--test-local-enabled))
512 ;; Under cygwin there are so bad timings that it doesn't make sense to test.
513 (skip-unless (not (eq system-type 'cygwin)))
514 630
515 (unwind-protect 631 (unwind-protect
516 (progn 632 (progn
517 (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) 633 (setq file-notify--test-tmpfile (file-notify--test-make-temp-name))
518 file-notify--test-desc 634 (write-region "any text" nil file-notify--test-tmpfile nil 'no-message)
519 (file-notify-add-watch 635 (should
520 file-notify--test-tmpfile 636 (setq file-notify--test-desc
521 '(change) #'file-notify--test-event-handler)) 637 (file-notify-add-watch
522 (file-notify--test-with-events '(created changed deleted) 638 file-notify--test-tmpfile
639 '(change) #'file-notify--test-event-handler)))
640 (should (file-notify-valid-p file-notify--test-desc))
641 ;; After calling `file-notify-rm-watch', the descriptor is not
642 ;; valid anymore.
643 (file-notify-rm-watch file-notify--test-desc)
644 (should-not (file-notify-valid-p file-notify--test-desc))
645 (delete-file file-notify--test-tmpfile))
646
647 ;; Cleanup.
648 (file-notify--test-cleanup))
649
650 (unwind-protect
651 (progn
652 (setq file-notify--test-tmpfile (file-notify--test-make-temp-name))
653 (write-region "any text" nil file-notify--test-tmpfile nil 'no-message)
654 (should
655 (setq file-notify--test-desc
656 (file-notify-add-watch
657 file-notify--test-tmpfile
658 '(change) #'file-notify--test-event-handler)))
659 (file-notify--test-with-events
660 (cond
661 ;; cygwin recognizes only `deleted' and `stopped' events.
662 ((eq system-type 'cygwin)
663 '(deleted stopped))
664 ;; inotify, kqueueg and gfilenotify raise just one
665 ;; `changed' event, the other backends show us two of
666 ;; them.
667 ((or (string-equal "inotify" (file-notify--test-library))
668 (string-equal "kqueue" (file-notify--test-library))
669 (string-equal "gfilenotify" (file-notify--test-library)))
670 '(changed deleted stopped))
671 (t '(changed changed deleted stopped)))
672 (read-event nil nil 0.1)
523 (should (file-notify-valid-p file-notify--test-desc)) 673 (should (file-notify-valid-p file-notify--test-desc))
524 (write-region 674 (write-region
525 "any text" nil file-notify--test-tmpfile nil 'no-message) 675 "another text" nil file-notify--test-tmpfile nil 'no-message)
676 (read-event nil nil 0.1)
526 (delete-file file-notify--test-tmpfile)) 677 (delete-file file-notify--test-tmpfile))
527 ;; After deleting the file, the descriptor is still valid. 678 ;; After deleting the file, the descriptor is not valid anymore.
528 (should (file-notify-valid-p file-notify--test-desc)) 679 (should-not (file-notify-valid-p file-notify--test-desc))
529 ;; After removing the watch, the descriptor must not be valid 680 (file-notify-rm-watch file-notify--test-desc))
530 ;; anymore.
531 (file-notify-rm-watch file-notify--test-desc)
532 (should-not (file-notify-valid-p file-notify--test-desc)))
533 681
534 ;; Cleanup. 682 ;; Cleanup.
535 (file-notify--test-cleanup)) 683 (file-notify--test-cleanup))
536 684
537 (unwind-protect 685 (unwind-protect
538 ;; The batch-mode operation of w32notify is fragile (there's no 686 ;; w32notify does not send a `stopped' event when deleting a
539 ;; input threads to send the message to). 687 ;; directory. The test does not work, therefore.
540 ;(unless (and noninteractive (eq file-notify--library 'w32notify)) 688 (unless (string-equal (file-notify--test-library) "w32notify")
541 (unless (eq file-notify--library 'w32notify) 689 (let ((temporary-file-directory
542 (let ((temporary-file-directory
543 (make-temp-file "file-notify-test-parent" t))) 690 (make-temp-file "file-notify-test-parent" t)))
544 (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) 691 (should
545 file-notify--test-desc 692 (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)
546 (file-notify-add-watch 693 file-notify--test-desc
547 file-notify--test-tmpfile 694 (file-notify-add-watch
548 '(change) #'file-notify--test-event-handler)) 695 temporary-file-directory
549 (file-notify--test-with-events '(created changed deleted stopped) 696 '(change) #'file-notify--test-event-handler)))
550 (should (file-notify-valid-p file-notify--test-desc)) 697 (file-notify--test-with-events
551 (write-region 698 (cond
552 "any text" nil file-notify--test-tmpfile nil 'no-message) 699 ;; cygwin recognizes only `deleted' and `stopped' events.
700 ((eq system-type 'cygwin)
701 '(deleted stopped))
702 ;; There are two `deleted' events, for the file and for
703 ;; the directory. Except for kqueue.
704 ((string-equal (file-notify--test-library) "kqueue")
705 '(created changed deleted stopped))
706 (t '(created changed deleted deleted stopped)))
707 (should (file-notify-valid-p file-notify--test-desc))
708 (read-event nil nil 0.1)
709 (write-region
710 "any text" nil file-notify--test-tmpfile nil 'no-message)
711 (read-event nil nil 0.1)
553 (delete-directory temporary-file-directory t)) 712 (delete-directory temporary-file-directory t))
554 ;; After deleting the parent directory, the descriptor must 713 ;; After deleting the parent directory, the descriptor must
555 ;; not be valid anymore. 714 ;; not be valid anymore.
556 (should-not (file-notify-valid-p file-notify--test-desc)))) 715 (should-not (file-notify-valid-p file-notify--test-desc))))
557 716
558 ;; Cleanup. 717 ;; Cleanup.
559 (file-notify--test-cleanup))) 718 (file-notify--test-cleanup)))
@@ -570,10 +729,11 @@ Don't wait longer than timeout seconds for the events to be delivered."
570 (setq file-notify--test-tmpfile 729 (setq file-notify--test-tmpfile
571 (file-name-as-directory (file-notify--test-make-temp-name))) 730 (file-name-as-directory (file-notify--test-make-temp-name)))
572 (make-directory file-notify--test-tmpfile) 731 (make-directory file-notify--test-tmpfile)
573 (setq file-notify--test-desc 732 (should
574 (file-notify-add-watch 733 (setq file-notify--test-desc
575 file-notify--test-tmpfile 734 (file-notify-add-watch
576 '(change) #'file-notify--test-event-handler)) 735 file-notify--test-tmpfile
736 '(change) #'file-notify--test-event-handler)))
577 (should (file-notify-valid-p file-notify--test-desc)) 737 (should (file-notify-valid-p file-notify--test-desc))
578 ;; After removing the watch, the descriptor must not be valid 738 ;; After removing the watch, the descriptor must not be valid
579 ;; anymore. 739 ;; anymore.
@@ -589,20 +749,22 @@ Don't wait longer than timeout seconds for the events to be delivered."
589 (unwind-protect 749 (unwind-protect
590 ;; The batch-mode operation of w32notify is fragile (there's no 750 ;; The batch-mode operation of w32notify is fragile (there's no
591 ;; input threads to send the message to). 751 ;; input threads to send the message to).
592 (unless (and noninteractive (eq file-notify--library 'w32notify)) 752 (unless (and noninteractive
753 (string-equal (file-notify--test-library) "w32notify"))
593 (setq file-notify--test-tmpfile 754 (setq file-notify--test-tmpfile
594 (file-name-as-directory (file-notify--test-make-temp-name))) 755 (file-name-as-directory (file-notify--test-make-temp-name)))
595 (make-directory file-notify--test-tmpfile) 756 (make-directory file-notify--test-tmpfile)
596 (setq file-notify--test-desc 757 (should
597 (file-notify-add-watch 758 (setq file-notify--test-desc
598 file-notify--test-tmpfile 759 (file-notify-add-watch
599 '(change) #'file-notify--test-event-handler)) 760 file-notify--test-tmpfile
761 '(change) #'file-notify--test-event-handler)))
600 (should (file-notify-valid-p file-notify--test-desc)) 762 (should (file-notify-valid-p file-notify--test-desc))
601 ;; After deleting the directory, the descriptor must not be 763 ;; After deleting the directory, the descriptor must not be
602 ;; valid anymore. 764 ;; valid anymore.
603 (delete-directory file-notify--test-tmpfile t) 765 (delete-directory file-notify--test-tmpfile t)
604 (file-notify--wait-for-events 766 (file-notify--wait-for-events
605 (file-notify--test-timeout) 767 (file-notify--test-timeout)
606 (not (file-notify-valid-p file-notify--test-desc))) 768 (not (file-notify-valid-p file-notify--test-desc)))
607 (should-not (file-notify-valid-p file-notify--test-desc))) 769 (should-not (file-notify-valid-p file-notify--test-desc)))
608 770
@@ -612,6 +774,61 @@ Don't wait longer than timeout seconds for the events to be delivered."
612(file-notify--deftest-remote file-notify-test05-dir-validity 774(file-notify--deftest-remote file-notify-test05-dir-validity
613 "Check `file-notify-valid-p' via file notification for remote directories.") 775 "Check `file-notify-valid-p' via file notification for remote directories.")
614 776
777(ert-deftest file-notify-test06-many-events ()
778 "Check that events are not dropped."
779 (skip-unless (file-notify--test-local-enabled))
780 ;; Under cygwin events arrive in random order. Impossible to define a test.
781 (skip-unless (not (eq system-type 'cygwin)))
782
783 (setq file-notify--test-tmpfile (file-notify--test-make-temp-name))
784 (make-directory file-notify--test-tmpfile)
785 (should
786 (setq file-notify--test-desc
787 (file-notify-add-watch
788 file-notify--test-tmpfile
789 '(change) 'file-notify--test-event-handler)))
790 (unwind-protect
791 (let ((n 1000)
792 source-file-list target-file-list
793 (default-directory file-notify--test-tmpfile))
794 (dotimes (i n)
795 ;; It matters which direction we rename, at least for
796 ;; kqueue. This backend parses directories in alphabetic
797 ;; order (x%d before y%d). So we rename both directions.
798 (if (zerop (mod i 2))
799 (progn
800 (push (expand-file-name (format "x%d" i)) source-file-list)
801 (push (expand-file-name (format "y%d" i)) target-file-list))
802 (push (expand-file-name (format "y%d" i)) source-file-list)
803 (push (expand-file-name (format "x%d" i)) target-file-list)))
804 (file-notify--test-with-events (make-list (+ n n) 'created)
805 (let ((source-file-list source-file-list)
806 (target-file-list target-file-list))
807 (while (and source-file-list target-file-list)
808 (read-event nil nil 0.1)
809 (write-region "" nil (pop source-file-list) nil 'no-message)
810 (read-event nil nil 0.1)
811 (write-region "" nil (pop target-file-list) nil 'no-message))))
812 (file-notify--test-with-events
813 (cond
814 ;; w32notify fires both `deleted' and `renamed' events.
815 ((string-equal (file-notify--test-library) "w32notify")
816 (let (r)
817 (dotimes (i n r)
818 (setq r (append '(deleted renamed) r)))))
819 (t (make-list n 'renamed)))
820 (let ((source-file-list source-file-list)
821 (target-file-list target-file-list))
822 (while (and source-file-list target-file-list)
823 (rename-file (pop source-file-list) (pop target-file-list) t))))
824 (file-notify--test-with-events (make-list n 'deleted)
825 (dolist (file target-file-list)
826 (delete-file file))))
827 (file-notify--test-cleanup)))
828
829(file-notify--deftest-remote file-notify-test06-many-events
830 "Check that events are not dropped for remote directories.")
831
615(defun file-notify-test-all (&optional interactive) 832(defun file-notify-test-all (&optional interactive)
616 "Run all tests for \\[file-notify]." 833 "Run all tests for \\[file-notify]."
617 (interactive "p") 834 (interactive "p")
@@ -622,7 +839,7 @@ Don't wait longer than timeout seconds for the events to be delivered."
622;; TODO: 839;; TODO:
623 840
624;; * For w32notify, no stopped events arrive when a directory is removed. 841;; * For w32notify, no stopped events arrive when a directory is removed.
625;; * Try to handle arriving events under cygwin reliably. 842;; * Check, why cygwin recognizes only `deleted' and `stopped' events.
626 843
627(provide 'file-notify-tests) 844(provide 'file-notify-tests)
628;;; file-notify-tests.el ends here 845;;; file-notify-tests.el ends here