From 662ee733257d573deaadd2e217894b70265fb5fe Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 9 Nov 2015 10:00:56 +0100 Subject: [PATCH 01/17] Add kqueue support * 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. * src/Makefile.in: Use NOTIFY_CFLAGS and NOTIFY_LIBS. * src/emacs.c (main): Call globals_of_kqueue and syms_of_kqueue. * src/kqueue.c: New file. * src/lisp.h: Declare extern globals_of_kqueue and syms_of_kqueue. --- configure.ac | 51 +++++--- src/Makefile.in | 11 +- src/emacs.c | 16 ++- src/kqueue.c | 339 ++++++++++++++++++++++++++++++++++++++++++++++++ src/lisp.h | 16 ++- 5 files changed, 400 insertions(+), 33 deletions(-) create mode 100644 src/kqueue.c diff --git a/configure.ac b/configure.ac index 5b2d9c7c59f..9c6db5602c7 100644 --- a/configure.ac +++ b/configure.ac @@ -355,17 +355,18 @@ OPTION_DEFAULT_ON([gnutls],[don't use -lgnutls for SSL/TLS support]) OPTION_DEFAULT_ON([zlib],[don't compile with zlib decompression support]) AC_ARG_WITH([file-notification],[AS_HELP_STRING([--with-file-notification=LIB], - [use a file notification library (LIB one of: yes, gfile, inotify, w32, no)])], + [use a file notification library (LIB one of: yes, inotify, kqueue, gfile, w32, no)])], [ case "${withval}" in y | ye | yes ) val=yes ;; n | no ) val=no ;; - g | gf | gfi | gfil | gfile ) val=gfile ;; i | in | ino | inot | inoti | inotif | inotify ) val=inotify ;; + k | kq | kqu | kque | kqueu | kqueue ) val=kqueue ;; + g | gf | gfi | gfil | gfile ) val=gfile ;; w | w3 | w32 ) val=w32 ;; * ) AC_MSG_ERROR(['--with-file-notification=$withval' is invalid; -this option's value should be 'yes', 'no', 'gfile', 'inotify' or 'w32'. +this option's value should be 'yes', 'no', 'inotify', 'kqeue', 'gfile' or 'w32'. 'yes' is a synonym for 'w32' on MS-Windows, for 'no' on Nextstep, -otherwise for the first of 'inotify' or 'gfile' that is usable.]) +otherwise for the first of 'inotify', 'kqueue' or 'gfile' that is usable.]) ;; esac with_file_notification=$val @@ -2690,12 +2691,6 @@ AC_SUBST(LIBGNUTLS_CFLAGS) NOTIFY_OBJ= NOTIFY_SUMMARY=no -dnl FIXME? Don't auto-detect on NS, but do allow someone to specify -dnl a particular library. This doesn't make much sense? -if test "${HAVE_NS}" = yes && test ${with_file_notification} = yes; then - with_file_notification=no -fi - dnl MS Windows native file monitor is available for mingw32 only. case $with_file_notification,$opsys in w32,cygwin) @@ -2726,16 +2721,34 @@ case $with_file_notification,$NOTIFY_OBJ in fi ;; esac +dnl kqueue is available on BSD-like systems. +case $with_file_notification,$NOTIFY_OBJ in + kqueue,* | yes,) + EMACS_CHECK_MODULES([KQUEUE], [libkqueue]) + if test "$HAVE_KQUEUE" = "yes"; then + AC_DEFINE(HAVE_KQUEUE, 1, [Define to 1 to use kqueue.]) + CPPFLAGS="$CPPFLAGS -I/usr/include/kqueue" + NOTIFY_CFLAGS=$KQUEUE_CFLAGS + NOTIFY_LIBS=$KQUEUE_LIBS + NOTIFY_OBJ=kqueue.o + NOTIFY_SUMMARY="yes -lkqueue" + fi ;; +esac + dnl g_file_monitor exists since glib 2.18. G_FILE_MONITOR_EVENT_MOVED dnl has been added in glib 2.24. It has been tested under dnl GNU/Linux only. case $with_file_notification,$NOTIFY_OBJ in gfile,* | yes,) - EMACS_CHECK_MODULES([GFILENOTIFY], [gio-2.0 >= 2.24]) - if test "$HAVE_GFILENOTIFY" = "yes"; then - AC_DEFINE(HAVE_GFILENOTIFY, 1, [Define to 1 if using GFile.]) - NOTIFY_OBJ=gfilenotify.o - NOTIFY_SUMMARY="yes -lgio (gfile)" + if test "${HAVE_NS}" != yes; then + EMACS_CHECK_MODULES([GFILENOTIFY], [gio-2.0 >= 2.24]) + if test "$HAVE_GFILENOTIFY" = "yes"; then + AC_DEFINE(HAVE_GFILENOTIFY, 1, [Define to 1 if using GFile.]) + NOTIFY_CFLAGS=$GFILENOTIFY_CFLAGS + NOTIFY_LIBS=$GFILENOTIFY_LIBS + NOTIFY_OBJ=gfilenotify.o + NOTIFY_SUMMARY="yes -lgio (gfile)" + fi fi ;; esac @@ -2747,9 +2760,9 @@ esac if test -n "$NOTIFY_OBJ"; then AC_DEFINE(USE_FILE_NOTIFY, 1, [Define to 1 if using file notifications.]) fi +AC_SUBST(NOTIFY_CFLAGS) +AC_SUBST(NOTIFY_LIBS) AC_SUBST(NOTIFY_OBJ) -AC_SUBST(GFILENOTIFY_CFLAGS) -AC_SUBST(GFILENOTIFY_LIBS) dnl Do not put whitespace before the #include statements below. dnl Older compilers (eg sunos4 cc) choke on it. @@ -4051,8 +4064,8 @@ OLDCFLAGS="$CFLAGS" OLDLIBS="$LIBS" CFLAGS="$CFLAGS $GTK_CFLAGS $RSVG_CFLAGS $DBUS_CFLAGS $SETTINGS_CFLAGS" LIBS="$LIBS $GTK_LIBS $RSVG_LIBS $DBUS_LIBS $SETTINGS_LIBS" -CFLAGS="$CFLAGS $GFILENOTIFY_CFLAGS $CAIRO_CFLAGS" -LIBS="$LIBS $GFILENOTIFY_LIBS $CAIRO_LIBS" +CFLAGS="$CFLAGS $NOTIFY_CFLAGS $CAIRO_CFLAGS" +LIBS="$LIBS $NOTIFY_LIBS $CAIRO_LIBS" AC_MSG_CHECKING([whether GLib is linked in]) AC_LINK_IFELSE([AC_LANG_PROGRAM( [[#include diff --git a/src/Makefile.in b/src/Makefile.in index f73575938d3..6a8571803f5 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -159,12 +159,13 @@ SETTINGS_LIBS = @SETTINGS_LIBS@ ## gtkutil.o if USE_GTK, else empty. GTK_OBJ=@GTK_OBJ@ -## gfilenotify.o if HAVE_GFILENOTIFY. ## inotify.o if HAVE_INOTIFY. +## kqueue.o if HAVE_KQUEUE. +## gfilenotify.o if HAVE_GFILENOTIFY. ## w32notify.o if HAVE_W32NOTIFY. NOTIFY_OBJ = @NOTIFY_OBJ@ -GFILENOTIFY_CFLAGS = @GFILENOTIFY_CFLAGS@ -GFILENOTIFY_LIBS = @GFILENOTIFY_LIBS@ +NOTIFY_CFLAGS = @NOTIFY_CFLAGS@ +NOTIFY_LIBS = @NOTIFY_LIBS@ ## -ltermcap, or -lncurses, or -lcurses, or "". LIBS_TERMCAP=@LIBS_TERMCAP@ @@ -354,7 +355,7 @@ ALL_CFLAGS=-Demacs $(MYCPPFLAGS) -I. -I$(srcdir) \ $(XRANDR_CFLAGS) $(XINERAMA_CFLAGS) $(XFIXES_CFLAGS) \ $(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \ $(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) \ - $(LIBGNUTLS_CFLAGS) $(GFILENOTIFY_CFLAGS) $(CAIRO_CFLAGS) \ + $(LIBGNUTLS_CFLAGS) $(NOTIFY_CFLAGS) $(CAIRO_CFLAGS) \ $(WARN_CFLAGS) $(WERROR_CFLAGS) $(CFLAGS) ALL_OBJC_CFLAGS=$(ALL_CFLAGS) $(GNU_OBJC_CFLAGS) @@ -467,7 +468,7 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE) $(LIBIMAGE) \ $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \ $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \ $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) \ - $(GFILENOTIFY_LIBS) $(LIB_MATH) $(LIBZ) + $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(leimdir)/leim-list.el: bootstrap-emacs$(EXEEXT) $(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 tzset (); #endif /* MSDOS */ +#ifdef HAVE_KQUEUE + globals_of_kqueue (); +#endif + #ifdef HAVE_GFILENOTIFY globals_of_gfilenotify (); #endif @@ -1520,14 +1524,18 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem syms_of_gnutls (); -#ifdef HAVE_GFILENOTIFY - syms_of_gfilenotify (); -#endif /* HAVE_GFILENOTIFY */ - #ifdef HAVE_INOTIFY syms_of_inotify (); #endif /* HAVE_INOTIFY */ +#ifdef HAVE_KQUEUE + syms_of_kqueue (); +#endif /* HAVE_KQUEUE */ + +#ifdef HAVE_GFILENOTIFY + syms_of_gfilenotify (); +#endif /* HAVE_GFILENOTIFY */ + #ifdef HAVE_DBUS syms_of_dbusbind (); #endif /* HAVE_DBUS */ diff --git a/src/kqueue.c b/src/kqueue.c new file mode 100644 index 00000000000..69bf5f61080 --- /dev/null +++ b/src/kqueue.c @@ -0,0 +1,339 @@ +/* Filesystem notifications support with glib API. + Copyright (C) 2013-2015 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or +(at your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . */ + +#include + +#ifdef HAVE_KQUEUE +#include +#include +#include "lisp.h" +#include "coding.h" +#include "termhooks.h" +#include "keyboard.h" + + +/* File handle for kqueue. */ +static int kqueuefd = -1; + +/* This is a list, elements are triples (DESCRIPTOR FILE FLAGS CALLBACK) */ +static Lisp_Object watch_list; + +#if 0 +/* This is the callback function for arriving signals from + g_file_monitor. It shall create a Lisp event, and put it into + Emacs input queue. */ +static gboolean +dir_monitor_callback (GFileMonitor *monitor, + GFile *file, + GFile *other_file, + GFileMonitorEvent event_type, + gpointer user_data) +{ + Lisp_Object symbol, monitor_object, watch_object, flags; + char *name = g_file_get_parse_name (file); + char *oname = other_file ? g_file_get_parse_name (other_file) : NULL; + + /* Determine event symbol. */ + switch (event_type) + { + case G_FILE_MONITOR_EVENT_CHANGED: + symbol = Qchanged; + break; + case G_FILE_MONITOR_EVENT_CHANGES_DONE_HINT: + symbol = Qchanges_done_hint; + break; + case G_FILE_MONITOR_EVENT_DELETED: + symbol = Qdeleted; + break; + case G_FILE_MONITOR_EVENT_CREATED: + symbol = Qcreated; + break; + case G_FILE_MONITOR_EVENT_ATTRIBUTE_CHANGED: + symbol = Qattribute_changed; + break; + case G_FILE_MONITOR_EVENT_PRE_UNMOUNT: + symbol = Qpre_unmount; + break; + case G_FILE_MONITOR_EVENT_UNMOUNTED: + symbol = Qunmounted; + break; + case G_FILE_MONITOR_EVENT_MOVED: + symbol = Qmoved; + break; + default: + goto cleanup; + } + + /* Determine callback function. */ + monitor_object = make_pointer_integer (monitor); + eassert (INTEGERP (monitor_object)); + watch_object = assq_no_quit (monitor_object, watch_list); + + if (CONSP (watch_object)) + { + struct input_event event; + Lisp_Object otail = oname ? list1 (build_string (oname)) : Qnil; + + /* Check, whether event_type is expected. */ + flags = XCAR (XCDR (XCDR (watch_object))); + if ((!NILP (Fmember (Qchange, flags)) && + !NILP (Fmember (symbol, list5 (Qchanged, Qchanges_done_hint, + Qdeleted, Qcreated, Qmoved)))) || + (!NILP (Fmember (Qattribute_change, flags)) && + ((EQ (symbol, Qattribute_changed))))) + { + /* Construct an event. */ + EVENT_INIT (event); + event.kind = FILE_NOTIFY_EVENT; + event.frame_or_window = Qnil; + event.arg = list2 (Fcons (monitor_object, + Fcons (symbol, + Fcons (build_string (name), + otail))), + XCAR (XCDR (XCDR (XCDR (watch_object))))); + + /* Store it into the input event queue. */ + kbd_buffer_store_event (&event); + // XD_DEBUG_MESSAGE ("%s", XD_OBJECT_TO_STRING (event.arg)); + } + + /* Cancel monitor if file or directory is deleted. */ + if (!NILP (Fmember (symbol, list2 (Qdeleted, Qmoved))) && + (strcmp (name, SSDATA (XCAR (XCDR (watch_object)))) == 0) && + !g_file_monitor_is_cancelled (monitor)) + g_file_monitor_cancel (monitor); + } + + /* Cleanup. */ + cleanup: + g_free (name); + g_free (oname); + + return TRUE; +} +#endif /* 0 */ + +DEFUN ("kqueue-add-watch", Fkqueue_add_watch, Skqueue_add_watch, 3, 3, 0, + doc: /* Add a watch for filesystem events pertaining to FILE. + +This arranges for filesystem events pertaining to FILE to be reported +to Emacs. Use `gfile-rm-watch' to cancel the watch. + +Value is a descriptor for the added watch. If the file cannot be +watched for some reason, this function signals a `file-notify-error' error. + +FLAGS is a list of conditions to set what will be watched for. It can +include the following symbols: + + `change' -- watch for file changes + `attribute-change' -- watch for file attributes changes, like + permissions or modification time + `watch-mounts' -- watch for mount events + `send-moved' -- pair `deleted' and `created' events caused by + file renames and send a single `renamed' event + instead + +When any event happens, Emacs will call the CALLBACK function passing +it a single argument EVENT, which is of the form + + (DESCRIPTOR ACTION FILE [FILE1]) + +DESCRIPTOR is the same object as the one returned by this function. +ACTION is the description of the event. It could be any one of the +following: + + `changed' -- FILE has changed + `changes-done-hint' -- a hint that this was probably the last change + in a set of changes + `deleted' -- FILE was deleted + `created' -- FILE was created + `attribute-changed' -- a FILE attribute was changed + `pre-unmount' -- the FILE location will soon be unmounted + `unmounted' -- the FILE location was unmounted + `moved' -- FILE was moved to FILE1 + +FILE is the name of the file whose event is being reported. FILE1 +will be reported only in case of the `moved' event. */) + (Lisp_Object file, Lisp_Object flags, Lisp_Object callback) +{ + Lisp_Object watch_object; + GFile *gfile; + GFileMonitor *monitor; + GFileMonitorFlags gflags = G_FILE_MONITOR_NONE; + GError *gerror = NULL; + + /* Check parameters. */ + CHECK_STRING (file); + file = Fdirectory_file_name (Fexpand_file_name (file, Qnil)); + if (NILP (Ffile_exists_p (file))) + report_file_error ("File does not exist", file); + + CHECK_LIST (flags); + + if (!FUNCTIONP (callback)) + wrong_type_argument (Qinvalid_function, callback); + + /* Create GFile name. */ + // gfile = g_file_new_for_path (SSDATA (ENCODE_FILE (file))); + + /* Assemble flags. */ + // if (!NILP (Fmember (Qwatch_mounts, flags))) + // gflags |= G_FILE_MONITOR_WATCH_MOUNTS; + // if (!NILP (Fmember (Qsend_moved, flags))) + // gflags |= G_FILE_MONITOR_SEND_MOVED; + + if (kqueuefd < 0) + { + kqueuefd = kqueue (); + if (kqueuefd < 0) + report_file_notify_error ("File watching is not available", Qnil); + watch_list = Qnil; + // add_read_fd (inotifyfd, &inotify_callback, NULL); + } + + +} +#if 0 + + mask = aspect_to_inotifymask (aspect); + encoded_file_name = ENCODE_FILE (file_name); + watchdesc = inotify_add_watch (inotifyfd, SSDATA (encoded_file_name), mask); + if (watchdesc == -1) + report_file_notify_error ("Could not add watch for file", file_name); + + /* Enable watch. */ + monitor = g_file_monitor (gfile, gflags, NULL, &gerror); + g_object_unref (gfile); + if (gerror) + { + char msg[1024]; + strcpy (msg, gerror->message); + g_error_free (gerror); + xsignal1 (Qfile_notify_error, build_string (msg)); + } + if (! monitor) + xsignal2 (Qfile_notify_error, build_string ("Cannot watch file"), file); + + Lisp_Object watch_descriptor = make_pointer_integer (monitor); + + /* Check the dicey assumption that make_pointer_integer is safe. */ + if (! INTEGERP (watch_descriptor)) + { + g_object_unref (monitor); + xsignal2 (Qfile_notify_error, build_string ("Unsupported file watcher"), + file); + } + + /* The default rate limit is 800 msec. We adapt this. */ + g_file_monitor_set_rate_limit (monitor, 100); + + /* Subscribe to the "changed" signal. */ + g_signal_connect (monitor, "changed", + (GCallback) dir_monitor_callback, NULL); + + /* Store watch object in watch list. */ + watch_object = list4 (watch_descriptor, file, flags, callback); + watch_list = Fcons (watch_object, watch_list); + + return watch_descriptor; +} + +DEFUN ("gfile-rm-watch", Fgfile_rm_watch, Sgfile_rm_watch, 1, 1, 0, + doc: /* Remove an existing WATCH-DESCRIPTOR. + +WATCH-DESCRIPTOR should be an object returned by `gfile-add-watch'. */) + (Lisp_Object watch_descriptor) +{ + Lisp_Object watch_object = assq_no_quit (watch_descriptor, watch_list); + + if (! CONSP (watch_object)) + xsignal2 (Qfile_notify_error, build_string ("Not a watch descriptor"), + watch_descriptor); + + eassert (INTEGERP (watch_descriptor)); + GFileMonitor *monitor = XINTPTR (watch_descriptor); + if (!g_file_monitor_is_cancelled (monitor) && + !g_file_monitor_cancel (monitor)) + xsignal2 (Qfile_notify_error, build_string ("Could not rm watch"), + watch_descriptor); + + /* Remove watch descriptor from watch list. */ + watch_list = Fdelq (watch_object, watch_list); + + /* Cleanup. */ + g_object_unref (monitor); + + return Qt; +} + +DEFUN ("gfile-valid-p", Fgfile_valid_p, Sgfile_valid_p, 1, 1, 0, + doc: /* "Check a watch specified by its WATCH-DESCRIPTOR. + +WATCH-DESCRIPTOR should be an object returned by `gfile-add-watch'. + +A watch can become invalid if the file or directory it watches is +deleted, or if the watcher thread exits abnormally for any other +reason. Removing the watch by calling `gfile-rm-watch' also makes it +invalid. */) + (Lisp_Object watch_descriptor) +{ + Lisp_Object watch_object = Fassoc (watch_descriptor, watch_list); + if (NILP (watch_object)) + return Qnil; + else + { + GFileMonitor *monitor = XINTPTR (watch_descriptor); + return g_file_monitor_is_cancelled (monitor) ? Qnil : Qt; + } +} +#endif /* 0 */ + + +void +globals_of_kqueue (void) +{ + watch_list = Qnil; +} + +void +syms_of_kqueue (void) +{ + defsubr (&Skqueue_add_watch); + // defsubr (&Skqueue_rm_watch); + // defsubr (&Skqueue_valid_p); + + /* Filter objects. */ + DEFSYM (Qchange, "change"); + DEFSYM (Qattribute_change, "attribute-change"); + DEFSYM (Qwatch_mounts, "watch-mounts"); /* G_FILE_MONITOR_WATCH_MOUNTS */ + DEFSYM (Qsend_moved, "send-moved"); /* G_FILE_MONITOR_SEND_MOVED */ + + /* Event types. */ + DEFSYM (Qdelete, "delete"); /* NOTE_DELETE */ + DEFSYM (Qwrite, "write"); /* NOTE_WRITE */ + DEFSYM (Qextend, "extend"); /* NOTE_EXTEND */ + DEFSYM (Qattrib, "attrib"); /* NOTE_ATTRIB */ + DEFSYM (Qlink, "link"); /* NOTE_LINK */ + DEFSYM (Qrename, "rename"); /* NOTE_RENAME */ + + staticpro (&watch_list); + + Fprovide (intern_c_string ("kqueue"), Qnil); +} + +#endif /* HAVE_KQUEUE */ diff --git a/src/lisp.h b/src/lisp.h index c782f0dd003..b34a852439c 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4258,17 +4258,23 @@ extern void init_font (void); extern void syms_of_fontset (void); #endif +/* Defined in inotify.c */ +#ifdef HAVE_INOTIFY +extern void syms_of_inotify (void); +#endif + +/* Defined in kqueue.c */ +#ifdef HAVE_KQUEUE +extern void globals_of_kqueue (void); +extern void syms_of_kqueue (void); +#endif + /* Defined in gfilenotify.c */ #ifdef HAVE_GFILENOTIFY extern void globals_of_gfilenotify (void); extern void syms_of_gfilenotify (void); #endif -/* Defined in inotify.c */ -#ifdef HAVE_INOTIFY -extern void syms_of_inotify (void); -#endif - #ifdef HAVE_W32NOTIFY /* Defined on w32notify.c. */ extern void syms_of_w32notify (void); From 0198c3066e8866d464690a9a7924d42e9c2663bf Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 9 Nov 2015 20:26:10 +0100 Subject: [PATCH 02/17] Work on 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. * src/keyboard.c (make_lispy_event): Check also for HAVE_KQUEUE. --- lisp/filenotify.el | 40 ++++--- src/keyboard.c | 4 +- src/kqueue.c | 264 +++++++++++++++++---------------------------- 3 files changed, 122 insertions(+), 186 deletions(-) diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 4c5d43fb44e..f7c97569825 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -22,15 +22,16 @@ ;;; Commentary ;; This package is an abstraction layer from the different low-level -;; file notification packages `gfilenotify', `inotify' and +;; file notification packages `inotify', `kqueue', `gfilenotify' and ;; `w32notify'. ;;; Code: (defconst file-notify--library (cond - ((featurep 'gfilenotify) 'gfilenotify) ((featurep 'inotify) 'inotify) + ((featurep 'kqueue) 'kqueue) + ((featurep 'gfilenotify) 'gfilenotify) ((featurep 'w32notify) 'w32notify)) "Non-nil when Emacs has been compiled with file notification support. The value is the name of the low-level file notification package @@ -40,8 +41,8 @@ could use another implementation.") (defvar file-notify-descriptors (make-hash-table :test 'equal) "Hash table for registered file notification descriptors. A key in this hash table is the descriptor as returned from -`gfilenotify', `inotify', `w32notify' or a file name handler. -The value in the hash table is a list +`inotify', `kqueue', `gfilenotify', `w32notify' or a file name +handler. The value in the hash table is a list (DIR (FILE . CALLBACK) (FILE . CALLBACK) ...) @@ -76,7 +77,8 @@ WHAT is a file or directory name to be removed, needed just for `inotify'." (remhash desc file-notify-descriptors) (puthash desc registered file-notify-descriptors)))))) -;; This function is used by `gfilenotify', `inotify' and `w32notify' events. +;; This function is used by `inotify', `kqueue', `gfilenotify' and +;; `w32notify' events. ;;;###autoload (defun file-notify-handle-event (event) "Handle file system monitoring event. @@ -159,7 +161,7 @@ EVENT is the cadr of the event in `file-notify-handle-event' (setq actions nil)) ;; Loop over actions. In fact, more than one action happens only - ;; for `inotify'. + ;; for `inotify' and `kqueue'. (dolist (action actions) ;; Send pending event, if it doesn't match. @@ -184,19 +186,17 @@ EVENT is the cadr of the event in `file-notify-handle-event' ;; Map action. We ignore all events which cannot be mapped. (setq action (cond - ;; gfilenotify. - ((memq action '(attribute-changed changed created deleted)) + ((memq action + '(attribute-changed changed created deleted renamed)) action) ((eq action 'moved) (setq file1 (file-notify--event-file1-name event)) 'renamed) - - ;; inotify, w32notify. ((eq action 'ignored) (setq stopped t actions nil)) - ((eq action 'attrib) 'attribute-changed) + ((memq action '(attrib link)) 'attribute-changed) ((memq action '(create added)) 'created) - ((memq action '(modify modified)) 'changed) + ((memq action '(modify modified write)) 'changed) ((memq action '(delete delete-self move-self removed)) 'deleted) ;; Make the event pending. ((memq action '(moved-from renamed-from)) @@ -275,8 +275,8 @@ EVENT is the cadr of the event in `file-notify-handle-event' (file-notify--rm-descriptor (file-notify--descriptor desc file) file))))) -;; `gfilenotify' and `w32notify' return a unique descriptor for every -;; `file-notify-add-watch', while `inotify' returns a unique +;; `kqueue', `gfilenotify' and `w32notify' return a unique descriptor +;; for every `file-notify-add-watch', while `inotify' returns a unique ;; descriptor per inode only. (defun file-notify-add-watch (file flags callback) "Add a watch for filesystem events pertaining to FILE. @@ -349,8 +349,9 @@ FILE is the name of the file whose event is being reported." ;; Determine low-level function to be called. (setq func (cond - ((eq file-notify--library 'gfilenotify) 'gfile-add-watch) ((eq file-notify--library 'inotify) 'inotify-add-watch) + ((eq file-notify--library 'kqueue) 'kqueue-add-watch) + ((eq file-notify--library 'gfilenotify) 'gfile-add-watch) ((eq file-notify--library 'w32notify) 'w32notify-add-watch))) ;; Determine respective flags. @@ -362,11 +363,14 @@ FILE is the name of the file whose event is being reported." (cond ((eq file-notify--library 'inotify) '(create delete delete-self modify move-self move)) + ((eq file-notify--library 'kqueue) + '(delete write extend rename)) ((eq file-notify--library 'w32notify) '(file-name directory-name size last-write-time))))) (when (memq 'attribute-change flags) (push (cond ((eq file-notify--library 'inotify) 'attrib) + ((eq file-notify--library 'kqueue) 'attrib) ((eq file-notify--library 'w32notify) 'attributes)) l-flags))) @@ -410,8 +414,9 @@ DESCRIPTOR should be an object returned by `file-notify-add-watch'." (funcall (cond - ((eq file-notify--library 'gfilenotify) 'gfile-rm-watch) ((eq file-notify--library 'inotify) 'inotify-rm-watch) + ((eq file-notify--library 'kqueue) 'kqueue-rm-watch) + ((eq file-notify--library 'gfilenotify) 'gfile-rm-watch) ((eq file-notify--library 'w32notify) 'w32notify-rm-watch)) desc)) (file-notify-error nil))) @@ -441,8 +446,9 @@ DESCRIPTOR should be an object returned by `file-notify-add-watch'." (funcall handler 'file-notify-valid-p descriptor) (funcall (cond - ((eq file-notify--library 'gfilenotify) 'gfile-valid-p) ((eq file-notify--library 'inotify) 'inotify-valid-p) + ((eq file-notify--library 'kqueue) 'kqueue-valid-p) + ((eq file-notify--library 'gfilenotify) 'gfile-valid-p) ((eq file-notify--library 'w32notify) 'w32notify-valid-p)) desc)) t)))) diff --git a/src/keyboard.c b/src/keyboard.c index 851207874db..a6ada2106fb 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -5951,12 +5951,12 @@ make_lispy_event (struct input_event *event) } #endif /* HAVE_DBUS */ -#if defined HAVE_GFILENOTIFY || defined HAVE_INOTIFY +#if defined HAVE_INOTIFY || defined HAVE_KQUEUE || defined HAVE_GFILENOTIFY case FILE_NOTIFY_EVENT: { return Fcons (Qfile_notify, event->arg); } -#endif /* defined HAVE_GFILENOTIFY || defined HAVE_INOTIFY */ +#endif /* HAVE_INOTIFY || HAVE_KQUEUE || HAVE_GFILENOTIFY */ case CONFIG_CHANGED_EVENT: return list3 (Qconfig_changed_event, diff --git a/src/kqueue.c b/src/kqueue.c index 69bf5f61080..a4c3892e9f2 100644 --- a/src/kqueue.c +++ b/src/kqueue.c @@ -21,10 +21,10 @@ along with GNU Emacs. If not, see . */ #ifdef HAVE_KQUEUE #include #include +#include #include "lisp.h" -#include "coding.h" -#include "termhooks.h" #include "keyboard.h" +#include "process.h" /* File handle for kqueue. */ @@ -33,149 +33,103 @@ static int kqueuefd = -1; /* This is a list, elements are triples (DESCRIPTOR FILE FLAGS CALLBACK) */ static Lisp_Object watch_list; -#if 0 -/* This is the callback function for arriving signals from - g_file_monitor. It shall create a Lisp event, and put it into - Emacs input queue. */ -static gboolean -dir_monitor_callback (GFileMonitor *monitor, - GFile *file, - GFile *other_file, - GFileMonitorEvent event_type, - gpointer user_data) +/* This is the callback function for arriving input on kqueuefd. It + shall create a Lisp event, and put it into Emacs input queue. */ +static void +kqueue_callback (int fd, void *data) { - Lisp_Object symbol, monitor_object, watch_object, flags; - char *name = g_file_get_parse_name (file); - char *oname = other_file ? g_file_get_parse_name (other_file) : NULL; + for (;;) { + struct kevent kev; + struct input_event event; + Lisp_Object monitor_object, watch_object, name, callback, actions; - /* Determine event symbol. */ - switch (event_type) - { - case G_FILE_MONITOR_EVENT_CHANGED: - symbol = Qchanged; - break; - case G_FILE_MONITOR_EVENT_CHANGES_DONE_HINT: - symbol = Qchanges_done_hint; - break; - case G_FILE_MONITOR_EVENT_DELETED: - symbol = Qdeleted; - break; - case G_FILE_MONITOR_EVENT_CREATED: - symbol = Qcreated; - break; - case G_FILE_MONITOR_EVENT_ATTRIBUTE_CHANGED: - symbol = Qattribute_changed; - break; - case G_FILE_MONITOR_EVENT_PRE_UNMOUNT: - symbol = Qpre_unmount; - break; - case G_FILE_MONITOR_EVENT_UNMOUNTED: - symbol = Qunmounted; - break; - case G_FILE_MONITOR_EVENT_MOVED: - symbol = Qmoved; - break; - default: - goto cleanup; + static const struct timespec nullts = { 0, 0 }; + int ret = kevent (kqueuefd, NULL, 0, &kev, 1, NULL); + if (ret < 1) { + /* All events read. */ + return; } - /* Determine callback function. */ - monitor_object = make_pointer_integer (monitor); - eassert (INTEGERP (monitor_object)); - watch_object = assq_no_quit (monitor_object, watch_list); + /* Determine file name and callback function. */ + monitor_object = make_number (kev.ident); + watch_object = assq_no_quit (monitor_object, watch_list); - if (CONSP (watch_object)) - { - struct input_event event; - Lisp_Object otail = oname ? list1 (build_string (oname)) : Qnil; + if (CONSP (watch_object)) { + name = XCAR (XCDR (watch_object)); + callback = XCAR (XCDR (XCDR (XCDR (watch_object)))); + } + else + continue; - /* Check, whether event_type is expected. */ - flags = XCAR (XCDR (XCDR (watch_object))); - if ((!NILP (Fmember (Qchange, flags)) && - !NILP (Fmember (symbol, list5 (Qchanged, Qchanges_done_hint, - Qdeleted, Qcreated, Qmoved)))) || - (!NILP (Fmember (Qattribute_change, flags)) && - ((EQ (symbol, Qattribute_changed))))) - { - /* Construct an event. */ - EVENT_INIT (event); - event.kind = FILE_NOTIFY_EVENT; - event.frame_or_window = Qnil; - event.arg = list2 (Fcons (monitor_object, - Fcons (symbol, - Fcons (build_string (name), - otail))), - XCAR (XCDR (XCDR (XCDR (watch_object))))); + /* Determine event actions. */ + actions = Qnil; + if (kev.fflags & NOTE_DELETE) + actions = Fcons (Qdelete, actions); + if (kev.fflags & NOTE_WRITE) + actions = Fcons (Qwrite, actions); + if (kev.fflags & NOTE_EXTEND) + actions = Fcons (Qextend, actions); + if (kev.fflags & NOTE_ATTRIB) + actions = Fcons (Qattrib, actions); + if (kev.fflags & NOTE_LINK) + actions = Fcons (Qlink, actions); + if (kev.fflags & NOTE_RENAME) + actions = Fcons (Qrename, actions); - /* Store it into the input event queue. */ - kbd_buffer_store_event (&event); - // XD_DEBUG_MESSAGE ("%s", XD_OBJECT_TO_STRING (event.arg)); - } + if (!NILP (actions)) { + /* Construct an event. */ + EVENT_INIT (event); + event.kind = FILE_NOTIFY_EVENT; + event.frame_or_window = Qnil; + event.arg = list2 (Fcons (monitor_object, + Fcons (actions, Fcons (name, Qnil))), + callback); - /* Cancel monitor if file or directory is deleted. */ - if (!NILP (Fmember (symbol, list2 (Qdeleted, Qmoved))) && - (strcmp (name, SSDATA (XCAR (XCDR (watch_object)))) == 0) && - !g_file_monitor_is_cancelled (monitor)) - g_file_monitor_cancel (monitor); + /* Store it into the input event queue. */ + kbd_buffer_store_event (&event); } - /* Cleanup. */ - cleanup: - g_free (name); - g_free (oname); - - return TRUE; + /* Cancel monitor if file or directory is deleted. */ + /* TODO: Implement it. */ + } + return; } -#endif /* 0 */ DEFUN ("kqueue-add-watch", Fkqueue_add_watch, Skqueue_add_watch, 3, 3, 0, doc: /* Add a watch for filesystem events pertaining to FILE. This arranges for filesystem events pertaining to FILE to be reported -to Emacs. Use `gfile-rm-watch' to cancel the watch. +to Emacs. Use `kqueue-rm-watch' to cancel the watch. Value is a descriptor for the added watch. If the file cannot be watched for some reason, this function signals a `file-notify-error' error. -FLAGS is a list of conditions to set what will be watched for. It can -include the following symbols: +FLAGS is a list of events to be watched for. It can include the +following symbols: - `change' -- watch for file changes - `attribute-change' -- watch for file attributes changes, like - permissions or modification time - `watch-mounts' -- watch for mount events - `send-moved' -- pair `deleted' and `created' events caused by - file renames and send a single `renamed' event - instead + `delete' -- FILE was deleted + `write' -- FILE has changed + `extend' -- FILE was extended + `attrib' -- a FILE attribute was changed + `link' -- a FILE's link count was changed + `rename' -- FILE was moved to FILE1 When any event happens, Emacs will call the CALLBACK function passing it a single argument EVENT, which is of the form - (DESCRIPTOR ACTION FILE [FILE1]) + (DESCRIPTOR ACTIONS FILE [FILE1]) DESCRIPTOR is the same object as the one returned by this function. -ACTION is the description of the event. It could be any one of the -following: - - `changed' -- FILE has changed - `changes-done-hint' -- a hint that this was probably the last change - in a set of changes - `deleted' -- FILE was deleted - `created' -- FILE was created - `attribute-changed' -- a FILE attribute was changed - `pre-unmount' -- the FILE location will soon be unmounted - `unmounted' -- the FILE location was unmounted - `moved' -- FILE was moved to FILE1 +ACTIONS is a list of events. FILE is the name of the file whose event is being reported. FILE1 -will be reported only in case of the `moved' event. */) +will be reported only in case of the `rename' event. */) (Lisp_Object file, Lisp_Object flags, Lisp_Object callback) { Lisp_Object watch_object; - GFile *gfile; - GFileMonitor *monitor; - GFileMonitorFlags gflags = G_FILE_MONITOR_NONE; - GError *gerror = NULL; + int fd; + u_short fflags = 0; + struct kevent ev; /* Check parameters. */ CHECK_STRING (file); @@ -183,80 +137,62 @@ will be reported only in case of the `moved' event. */) if (NILP (Ffile_exists_p (file))) report_file_error ("File does not exist", file); + /* TODO: Directories shall be supported as well. */ + if (!NILP (Ffile_directory_p (file))) + report_file_error ("Directory watching is not supported (yet)", file); + CHECK_LIST (flags); if (!FUNCTIONP (callback)) wrong_type_argument (Qinvalid_function, callback); - /* Create GFile name. */ - // gfile = g_file_new_for_path (SSDATA (ENCODE_FILE (file))); - - /* Assemble flags. */ - // if (!NILP (Fmember (Qwatch_mounts, flags))) - // gflags |= G_FILE_MONITOR_WATCH_MOUNTS; - // if (!NILP (Fmember (Qsend_moved, flags))) - // gflags |= G_FILE_MONITOR_SEND_MOVED; - if (kqueuefd < 0) { + /* Create kqueue descriptor. */ kqueuefd = kqueue (); if (kqueuefd < 0) report_file_notify_error ("File watching is not available", Qnil); + + /* Start monitoring for possible I/O. */ + add_read_fd (kqueuefd, kqueue_callback, NULL); //data); + watch_list = Qnil; - // add_read_fd (inotifyfd, &inotify_callback, NULL); } + /* Open file. */ + file = ENCODE_FILE (file); + fd = emacs_open (SSDATA (file), O_NONBLOCK | O_BINARY | O_RDONLY, 0); + if (fd == -1) + report_file_error ("File cannot be opened", file); -} -#if 0 + /* Assemble filter flags */ + if (!NILP (Fmember (Qdelete, flags))) fflags |= NOTE_DELETE; + if (!NILP (Fmember (Qwrite, flags))) fflags |= NOTE_WRITE; + if (!NILP (Fmember (Qextend, flags))) fflags |= NOTE_EXTEND; + if (!NILP (Fmember (Qattrib, flags))) fflags |= NOTE_ATTRIB; + if (!NILP (Fmember (Qlink, flags))) fflags |= NOTE_LINK; + if (!NILP (Fmember (Qrename, flags))) fflags |= NOTE_RENAME; - mask = aspect_to_inotifymask (aspect); - encoded_file_name = ENCODE_FILE (file_name); - watchdesc = inotify_add_watch (inotifyfd, SSDATA (encoded_file_name), mask); - if (watchdesc == -1) - report_file_notify_error ("Could not add watch for file", file_name); + /* Register event. */ + EV_SET (&ev, fd, EVFILT_VNODE, EV_ADD | EV_ENABLE | EV_CLEAR, + fflags, 0, NULL); - /* Enable watch. */ - monitor = g_file_monitor (gfile, gflags, NULL, &gerror); - g_object_unref (gfile); - if (gerror) - { - char msg[1024]; - strcpy (msg, gerror->message); - g_error_free (gerror); - xsignal1 (Qfile_notify_error, build_string (msg)); - } - if (! monitor) - xsignal2 (Qfile_notify_error, build_string ("Cannot watch file"), file); - - Lisp_Object watch_descriptor = make_pointer_integer (monitor); - - /* Check the dicey assumption that make_pointer_integer is safe. */ - if (! INTEGERP (watch_descriptor)) - { - g_object_unref (monitor); - xsignal2 (Qfile_notify_error, build_string ("Unsupported file watcher"), - file); - } - - /* The default rate limit is 800 msec. We adapt this. */ - g_file_monitor_set_rate_limit (monitor, 100); - - /* Subscribe to the "changed" signal. */ - g_signal_connect (monitor, "changed", - (GCallback) dir_monitor_callback, NULL); + if (kevent (kqueuefd, &ev, 1, NULL, 0, NULL) < 0) + report_file_error ("Cannot watch file", file); /* Store watch object in watch list. */ + Lisp_Object watch_descriptor = make_number (fd); watch_object = list4 (watch_descriptor, file, flags, callback); watch_list = Fcons (watch_object, watch_list); return watch_descriptor; } -DEFUN ("gfile-rm-watch", Fgfile_rm_watch, Sgfile_rm_watch, 1, 1, 0, +#if 0 +DEFUN ("kqueue-rm-watch", Fkqueue_rm_watch, Skqueue_rm_watch, 1, 1, 0, doc: /* Remove an existing WATCH-DESCRIPTOR. -WATCH-DESCRIPTOR should be an object returned by `gfile-add-watch'. */) +WATCH-DESCRIPTOR should be an object returned by `kqueue-add-watch'. */) (Lisp_Object watch_descriptor) { Lisp_Object watch_object = assq_no_quit (watch_descriptor, watch_list); @@ -317,12 +253,6 @@ syms_of_kqueue (void) // defsubr (&Skqueue_rm_watch); // defsubr (&Skqueue_valid_p); - /* Filter objects. */ - DEFSYM (Qchange, "change"); - DEFSYM (Qattribute_change, "attribute-change"); - DEFSYM (Qwatch_mounts, "watch-mounts"); /* G_FILE_MONITOR_WATCH_MOUNTS */ - DEFSYM (Qsend_moved, "send-moved"); /* G_FILE_MONITOR_SEND_MOVED */ - /* Event types. */ DEFSYM (Qdelete, "delete"); /* NOTE_DELETE */ DEFSYM (Qwrite, "write"); /* NOTE_WRITE */ From bd377a57b1e6fbd46cb63a0999c89e1242463b96 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 11 Nov 2015 09:22:06 +0100 Subject: [PATCH 03/17] Continue kqueue implementation * lisp/filenotify.el (file-notify-handle-event) (file-notify-callback): Enable trace messages. * src/kqueue.c: Include also . (kqueue_callback): Remove watch in case of NOTE_DELETE or NOTE_RENAME. (Fkqueue_rm_watch, Fkqueue_valid_p): New functions. (syms_of_kqueue): Add them. --- lisp/filenotify.el | 4 +-- src/kqueue.c | 80 ++++++++++++++++++++++++---------------------- 2 files changed, 43 insertions(+), 41 deletions(-) diff --git a/lisp/filenotify.el b/lisp/filenotify.el index f7c97569825..029fcf82da8 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -88,7 +88,7 @@ If EVENT is a filewatch event, call its callback. It has the format Otherwise, signal a `file-notify-error'." (interactive "e") - ;;(message "file-notify-handle-event %S" event) + (message "file-notify-handle-event %S" event) (if (and (eq (car event) 'file-notify) (>= (length event) 3)) (funcall (nth 2 event) (nth 1 event)) @@ -236,7 +236,7 @@ EVENT is the cadr of the event in `file-notify-handle-event' (setq pending-event nil)) ;; Check for stopped. - ;;(message "file-notify-callback %S %S" file registered) + (message "file-notify-callback %S %S" file registered) (setq stopped (or diff --git a/src/kqueue.c b/src/kqueue.c index a4c3892e9f2..c2e859f8db9 100644 --- a/src/kqueue.c +++ b/src/kqueue.c @@ -20,6 +20,7 @@ along with GNU Emacs. If not, see . */ #ifdef HAVE_KQUEUE #include +#include #include #include #include "lisp.h" @@ -41,9 +42,9 @@ kqueue_callback (int fd, void *data) for (;;) { struct kevent kev; struct input_event event; - Lisp_Object monitor_object, watch_object, name, callback, actions; + Lisp_Object monitor_object, watch_object, file, callback, actions; - static const struct timespec nullts = { 0, 0 }; + /* Read one event. */ int ret = kevent (kqueuefd, NULL, 0, &kev, 1, NULL); if (ret < 1) { /* All events read. */ @@ -55,7 +56,7 @@ kqueue_callback (int fd, void *data) watch_object = assq_no_quit (monitor_object, watch_list); if (CONSP (watch_object)) { - name = XCAR (XCDR (watch_object)); + file = XCAR (XCDR (watch_object)); callback = XCAR (XCDR (XCDR (XCDR (watch_object)))); } else @@ -76,13 +77,13 @@ kqueue_callback (int fd, void *data) if (kev.fflags & NOTE_RENAME) actions = Fcons (Qrename, actions); - if (!NILP (actions)) { + if (! NILP (actions)) { /* Construct an event. */ EVENT_INIT (event); event.kind = FILE_NOTIFY_EVENT; event.frame_or_window = Qnil; event.arg = list2 (Fcons (monitor_object, - Fcons (actions, Fcons (name, Qnil))), + Fcons (actions, Fcons (file, Qnil))), callback); /* Store it into the input event queue. */ @@ -90,7 +91,8 @@ kqueue_callback (int fd, void *data) } /* Cancel monitor if file or directory is deleted. */ - /* TODO: Implement it. */ + if (kev.fflags & (NOTE_DELETE | NOTE_RENAME)) + Fkqueue_rm_watch (monitor_object); } return; } @@ -101,7 +103,7 @@ DEFUN ("kqueue-add-watch", Fkqueue_add_watch, Skqueue_add_watch, 3, 3, 0, This arranges for filesystem events pertaining to FILE to be reported to Emacs. Use `kqueue-rm-watch' to cancel the watch. -Value is a descriptor for the added watch. If the file cannot be +Returned value is a descriptor for the added watch. If the file cannot be watched for some reason, this function signals a `file-notify-error' error. FLAGS is a list of events to be watched for. It can include the @@ -138,12 +140,12 @@ will be reported only in case of the `rename' event. */) report_file_error ("File does not exist", file); /* TODO: Directories shall be supported as well. */ - if (!NILP (Ffile_directory_p (file))) + if (! NILP (Ffile_directory_p (file))) report_file_error ("Directory watching is not supported (yet)", file); CHECK_LIST (flags); - if (!FUNCTIONP (callback)) + if (! FUNCTIONP (callback)) wrong_type_argument (Qinvalid_function, callback); if (kqueuefd < 0) @@ -166,16 +168,16 @@ will be reported only in case of the `rename' event. */) report_file_error ("File cannot be opened", file); /* Assemble filter flags */ - if (!NILP (Fmember (Qdelete, flags))) fflags |= NOTE_DELETE; - if (!NILP (Fmember (Qwrite, flags))) fflags |= NOTE_WRITE; - if (!NILP (Fmember (Qextend, flags))) fflags |= NOTE_EXTEND; - if (!NILP (Fmember (Qattrib, flags))) fflags |= NOTE_ATTRIB; - if (!NILP (Fmember (Qlink, flags))) fflags |= NOTE_LINK; - if (!NILP (Fmember (Qrename, flags))) fflags |= NOTE_RENAME; + if (! NILP (Fmember (Qdelete, flags))) fflags |= NOTE_DELETE; + if (! NILP (Fmember (Qwrite, flags))) fflags |= NOTE_WRITE; + if (! NILP (Fmember (Qextend, flags))) fflags |= NOTE_EXTEND; + if (! NILP (Fmember (Qattrib, flags))) fflags |= NOTE_ATTRIB; + if (! NILP (Fmember (Qlink, flags))) fflags |= NOTE_LINK; + if (! NILP (Fmember (Qrename, flags))) fflags |= NOTE_RENAME; /* Register event. */ - EV_SET (&ev, fd, EVFILT_VNODE, EV_ADD | EV_ENABLE | EV_CLEAR, - fflags, 0, NULL); + EV_SET (&ev, fd, EVFILT_VNODE, EV_ADD | EV_ENABLE | EV_CLEAR, + fflags, 0, NULL); if (kevent (kqueuefd, &ev, 1, NULL, 0, NULL) < 0) report_file_error ("Cannot watch file", file); @@ -188,7 +190,6 @@ will be reported only in case of the `rename' event. */) return watch_descriptor; } -#if 0 DEFUN ("kqueue-rm-watch", Fkqueue_rm_watch, Skqueue_rm_watch, 1, 1, 0, doc: /* Remove an existing WATCH-DESCRIPTOR. @@ -202,42 +203,35 @@ WATCH-DESCRIPTOR should be an object returned by `kqueue-add-watch'. */) watch_descriptor); eassert (INTEGERP (watch_descriptor)); - GFileMonitor *monitor = XINTPTR (watch_descriptor); - if (!g_file_monitor_is_cancelled (monitor) && - !g_file_monitor_cancel (monitor)) - xsignal2 (Qfile_notify_error, build_string ("Could not rm watch"), - watch_descriptor); + int fd = XINT (watch_descriptor); + if ( fd >= 0) + emacs_close (fd); /* Remove watch descriptor from watch list. */ watch_list = Fdelq (watch_object, watch_list); - /* Cleanup. */ - g_object_unref (monitor); + if (NILP (watch_list) && (kqueuefd >= 0)) { + delete_read_fd (kqueuefd); + emacs_close (kqueuefd); + kqueuefd = -1; + } return Qt; } -DEFUN ("gfile-valid-p", Fgfile_valid_p, Sgfile_valid_p, 1, 1, 0, +DEFUN ("kqueue-valid-p", Fkqueue_valid_p, Skqueue_valid_p, 1, 1, 0, doc: /* "Check a watch specified by its WATCH-DESCRIPTOR. -WATCH-DESCRIPTOR should be an object returned by `gfile-add-watch'. +WATCH-DESCRIPTOR should be an object returned by `kqueue-add-watch'. A watch can become invalid if the file or directory it watches is deleted, or if the watcher thread exits abnormally for any other -reason. Removing the watch by calling `gfile-rm-watch' also makes it +reason. Removing the watch by calling `kqueue-rm-watch' also makes it invalid. */) (Lisp_Object watch_descriptor) { - Lisp_Object watch_object = Fassoc (watch_descriptor, watch_list); - if (NILP (watch_object)) - return Qnil; - else - { - GFileMonitor *monitor = XINTPTR (watch_descriptor); - return g_file_monitor_is_cancelled (monitor) ? Qnil : Qt; - } + return NILP (assq_no_quit (watch_descriptor, watch_list)) ? Qnil : Qt; } -#endif /* 0 */ void @@ -250,8 +244,8 @@ void syms_of_kqueue (void) { defsubr (&Skqueue_add_watch); - // defsubr (&Skqueue_rm_watch); - // defsubr (&Skqueue_valid_p); + defsubr (&Skqueue_rm_watch); + defsubr (&Skqueue_valid_p); /* Event types. */ DEFSYM (Qdelete, "delete"); /* NOTE_DELETE */ @@ -267,3 +261,11 @@ syms_of_kqueue (void) } #endif /* HAVE_KQUEUE */ + +/* TODO + * Implement watching directories. + * Add FILE1 in case of `rename'. */ + +/* PROBLEMS + * https://bugs.launchpad.net/ubuntu/+source/libkqueue/+bug/1514837 + prevents tests on Ubuntu. */ From 84cadc60a7cd4695b9d9e086fd8d68803388dea8 Mon Sep 17 00:00:00 2001 From: Wolfgang Jenkner Date: Wed, 11 Nov 2015 16:07:50 +0100 Subject: [PATCH 04/17] Build fixes for kqueue support. * src/kqueue.c (Fkqueue_add_watch): O_BINARY is not a POSIX open(3) flag. * configure.ac (HAVE_KQUEUE): There is no pkg-config module for native kqueue on *BSD. --- configure.ac | 7 +++++++ src/kqueue.c | 2 +- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index 9c6db5602c7..f9274d7ad1f 100644 --- a/configure.ac +++ b/configure.ac @@ -2732,6 +2732,13 @@ case $with_file_notification,$NOTIFY_OBJ in NOTIFY_LIBS=$KQUEUE_LIBS NOTIFY_OBJ=kqueue.o NOTIFY_SUMMARY="yes -lkqueue" + else + AC_SEARCH_LIBS(kqueue, []) + if test "$ac_cv_search_kqueue" != no; then + AC_DEFINE(HAVE_KQUEUE, 1, [Define to 1 to use kqueue.]) + NOTIFY_OBJ=kqueue.o + NOTIFY_SUMMARY="yes (kqueue)" + fi fi ;; esac diff --git a/src/kqueue.c b/src/kqueue.c index c2e859f8db9..d2f3d37e19c 100644 --- a/src/kqueue.c +++ b/src/kqueue.c @@ -163,7 +163,7 @@ will be reported only in case of the `rename' event. */) /* Open file. */ file = ENCODE_FILE (file); - fd = emacs_open (SSDATA (file), O_NONBLOCK | O_BINARY | O_RDONLY, 0); + fd = emacs_open (SSDATA (file), O_NONBLOCK | O_RDONLY, 0); if (fd == -1) report_file_error ("File cannot be opened", file); From 978f5b0a705c459fc708b7adacdac2b00c759422 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 14 Nov 2015 11:51:28 +0000 Subject: [PATCH 05/17] Implement directory events * lisp/filenotify.el (file-notify-handle-event) (file-notify-callback): Remove traces. * src/kqueue.c: Include . (kqueue_generate_event, kqueue_compare_dir_list): New functions. (kqueue_callback): Use them. Call kevent() with a zero timeout. (Fkqueue_add_watch): Adapt docstring. Support directory events. Compute initial directory listing. Close file descriptor in case of errors. (syms_of_kqueue): Declare Qcreate. --- lisp/filenotify.el | 4 +- src/kqueue.c | 149 ++++++++++++++++++++++++++++++++++++--------- 2 files changed, 121 insertions(+), 32 deletions(-) diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 029fcf82da8..f7c97569825 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -88,7 +88,7 @@ If EVENT is a filewatch event, call its callback. It has the format Otherwise, signal a `file-notify-error'." (interactive "e") - (message "file-notify-handle-event %S" event) + ;;(message "file-notify-handle-event %S" event) (if (and (eq (car event) 'file-notify) (>= (length event) 3)) (funcall (nth 2 event) (nth 1 event)) @@ -236,7 +236,7 @@ EVENT is the cadr of the event in `file-notify-handle-event' (setq pending-event nil)) ;; Check for stopped. - (message "file-notify-callback %S %S" file registered) + ;;(message "file-notify-callback %S %S" file registered) (setq stopped (or diff --git a/src/kqueue.c b/src/kqueue.c index d2f3d37e19c..0425a142a98 100644 --- a/src/kqueue.c +++ b/src/kqueue.c @@ -1,5 +1,5 @@ -/* Filesystem notifications support with glib API. - Copyright (C) 2013-2015 Free Software Foundation, Inc. +/* Filesystem notifications support with kqueue API. + Copyright (C) 2015 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -22,6 +22,7 @@ along with GNU Emacs. If not, see . */ #include #include #include +#include #include #include "lisp.h" #include "keyboard.h" @@ -31,9 +32,97 @@ along with GNU Emacs. If not, see . */ /* File handle for kqueue. */ static int kqueuefd = -1; -/* This is a list, elements are triples (DESCRIPTOR FILE FLAGS CALLBACK) */ +/* This is a list, elements are (DESCRIPTOR FILE FLAGS CALLBACK [DIRLIST]) */ static Lisp_Object watch_list; +/* Generate a file notification event. */ +static void +kqueue_generate_event +(Lisp_Object ident, Lisp_Object actions, Lisp_Object file, Lisp_Object callback) +{ + struct input_event event; + EVENT_INIT (event); + event.kind = FILE_NOTIFY_EVENT; + event.frame_or_window = Qnil; + event.arg = list2 (Fcons (ident, Fcons (actions, Fcons (file, Qnil))), + callback); + + /* Store it into the input event queue. */ + kbd_buffer_store_event (&event); +} + +/* This compares two directory listings in case of a `write' event for + a directory. The old directory listing is stored in watch_object, + it will be replaced by a new directory listing at the end. */ +static void +kqueue_compare_dir_list (Lisp_Object watch_object) +{ + Lisp_Object dir, callback, old_dl, new_dl, dl, actions; + + dir = XCAR (XCDR (watch_object)); + callback = XCAR (XCDR (XCDR (XCDR (watch_object)))); + old_dl = XCAR (XCDR (XCDR (XCDR (XCDR (watch_object))))); + new_dl = directory_files_internal (dir, Qnil, Qnil, Qnil, 1, Qnil); + + for (dl = old_dl; ! NILP (dl); dl = XCDR (dl)) { + Lisp_Object old_entry, new_entry; + old_entry = XCAR (dl); + new_entry = Fassoc (XCAR (old_entry), new_dl); + + /* We ignore "." and "..". */ + if ((strcmp (".", SSDATA (XCAR (old_entry))) == 0) || + (strcmp ("..", SSDATA (XCAR (old_entry))) == 0)) + continue; + + /* A file has disappeared. */ + if (NILP (new_entry)) + kqueue_generate_event + (XCAR (watch_object), Fcons (Qdelete, Qnil), + XCAR (old_entry), callback); + + else { + /* A file has changed. We compare last modification time. */ + if (NILP + (Fequal + (XCAR (XCDR (XCDR (XCDR (XCDR (XCDR (XCDR (old_entry))))))), + XCAR (XCDR (XCDR (XCDR (XCDR (XCDR (XCDR (new_entry)))))))))) + kqueue_generate_event + (XCAR (watch_object), Fcons (Qwrite, Qnil), + XCAR (old_entry), callback); + + /* A file attribute has changed. We compare last status change time. */ + if (NILP + (Fequal + (XCAR (XCDR (XCDR (XCDR (XCDR (XCDR (XCDR (XCDR (old_entry)))))))), + XCAR (XCDR (XCDR (XCDR (XCDR (XCDR (XCDR (XCDR (new_entry))))))))))) + kqueue_generate_event + (XCAR (watch_object), Fcons (Qattrib, Qnil), + XCAR (old_entry), callback); + } + } + + for (dl = new_dl; ! NILP (dl); dl = XCDR (dl)) { + Lisp_Object old_entry, new_entry; + new_entry = XCAR (dl); + old_entry = Fassoc (XCAR (new_entry), old_dl); + + /* We ignore "." and "..". */ + if ((strcmp (".", SSDATA (XCAR (new_entry))) == 0) || + (strcmp ("..", SSDATA (XCAR (new_entry))) == 0)) + continue; + + /* A new file has appeared. */ + if (NILP (old_entry)) + kqueue_generate_event + (XCAR (watch_object), Fcons (Qcreate, Qnil), + XCAR (new_entry), callback); + } + + /* Replace directory listing with the new one. */ + XSETCDR (XCDR (XCDR (XCDR (watch_object))), Fcons (new_dl, Qnil)); + return; +} + /* This is the callback function for arriving input on kqueuefd. It shall create a Lisp event, and put it into Emacs input queue. */ static void @@ -41,11 +130,11 @@ kqueue_callback (int fd, void *data) { for (;;) { struct kevent kev; - struct input_event event; - Lisp_Object monitor_object, watch_object, file, callback, actions; + static const struct timespec nullts = { 0, 0 }; + Lisp_Object monitor_object, watch_object, file, callback, dirp, actions; /* Read one event. */ - int ret = kevent (kqueuefd, NULL, 0, &kev, 1, NULL); + int ret = kevent (kqueuefd, NULL, 0, &kev, 1, &nullts); if (ret < 1) { /* All events read. */ return; @@ -58,6 +147,7 @@ kqueue_callback (int fd, void *data) if (CONSP (watch_object)) { file = XCAR (XCDR (watch_object)); callback = XCAR (XCDR (XCDR (XCDR (watch_object)))); + dirp = XCDR (XCDR (XCDR (XCDR (watch_object)))); } else continue; @@ -66,8 +156,12 @@ kqueue_callback (int fd, void *data) actions = Qnil; if (kev.fflags & NOTE_DELETE) actions = Fcons (Qdelete, actions); - if (kev.fflags & NOTE_WRITE) - actions = Fcons (Qwrite, actions); + if (kev.fflags & NOTE_WRITE) { + if (NILP (dirp)) + actions = Fcons (Qwrite, actions); + else + kqueue_compare_dir_list (watch_object); + } if (kev.fflags & NOTE_EXTEND) actions = Fcons (Qextend, actions); if (kev.fflags & NOTE_ATTRIB) @@ -77,18 +171,9 @@ kqueue_callback (int fd, void *data) if (kev.fflags & NOTE_RENAME) actions = Fcons (Qrename, actions); - if (! NILP (actions)) { - /* Construct an event. */ - EVENT_INIT (event); - event.kind = FILE_NOTIFY_EVENT; - event.frame_or_window = Qnil; - event.arg = list2 (Fcons (monitor_object, - Fcons (actions, Fcons (file, Qnil))), - callback); - - /* Store it into the input event queue. */ - kbd_buffer_store_event (&event); - } + /* Construct an event. */ + if (! NILP (actions)) + kqueue_generate_event (monitor_object, actions, file, callback); /* Cancel monitor if file or directory is deleted. */ if (kev.fflags & (NOTE_DELETE | NOTE_RENAME)) @@ -109,6 +194,7 @@ watched for some reason, this function signals a `file-notify-error' error. FLAGS is a list of events to be watched for. It can include the following symbols: + `create' -- FILE was created `delete' -- FILE was deleted `write' -- FILE has changed `extend' -- FILE was extended @@ -128,7 +214,7 @@ FILE is the name of the file whose event is being reported. FILE1 will be reported only in case of the `rename' event. */) (Lisp_Object file, Lisp_Object flags, Lisp_Object callback) { - Lisp_Object watch_object; + Lisp_Object watch_object, dir_list; int fd; u_short fflags = 0; struct kevent ev; @@ -139,10 +225,6 @@ will be reported only in case of the `rename' event. */) if (NILP (Ffile_exists_p (file))) report_file_error ("File does not exist", file); - /* TODO: Directories shall be supported as well. */ - if (! NILP (Ffile_directory_p (file))) - report_file_error ("Directory watching is not supported (yet)", file); - CHECK_LIST (flags); if (! FUNCTIONP (callback)) @@ -156,14 +238,14 @@ will be reported only in case of the `rename' event. */) report_file_notify_error ("File watching is not available", Qnil); /* Start monitoring for possible I/O. */ - add_read_fd (kqueuefd, kqueue_callback, NULL); //data); + add_read_fd (kqueuefd, kqueue_callback, NULL); watch_list = Qnil; } /* Open file. */ file = ENCODE_FILE (file); - fd = emacs_open (SSDATA (file), O_NONBLOCK | O_RDONLY, 0); + fd = emacs_open (SSDATA (file), O_RDONLY, 0); if (fd == -1) report_file_error ("File cannot be opened", file); @@ -179,12 +261,19 @@ will be reported only in case of the `rename' event. */) EV_SET (&ev, fd, EVFILT_VNODE, EV_ADD | EV_ENABLE | EV_CLEAR, fflags, 0, NULL); - if (kevent (kqueuefd, &ev, 1, NULL, 0, NULL) < 0) + if (kevent (kqueuefd, &ev, 1, NULL, 0, NULL) < 0) { + emacs_close (fd); report_file_error ("Cannot watch file", file); + } /* Store watch object in watch list. */ Lisp_Object watch_descriptor = make_number (fd); - watch_object = list4 (watch_descriptor, file, flags, callback); + if (NILP (Ffile_directory_p (file))) + watch_object = list4 (watch_descriptor, file, flags, callback); + else { + dir_list = directory_files_internal (file, Qnil, Qnil, Qnil, 1, Qnil); + watch_object = list5 (watch_descriptor, file, flags, callback, dir_list); + } watch_list = Fcons (watch_object, watch_list); return watch_descriptor; @@ -248,6 +337,7 @@ syms_of_kqueue (void) defsubr (&Skqueue_valid_p); /* Event types. */ + DEFSYM (Qcreate, "create"); DEFSYM (Qdelete, "delete"); /* NOTE_DELETE */ DEFSYM (Qwrite, "write"); /* NOTE_WRITE */ DEFSYM (Qextend, "extend"); /* NOTE_EXTEND */ @@ -263,7 +353,6 @@ syms_of_kqueue (void) #endif /* HAVE_KQUEUE */ /* TODO - * Implement watching directories. * Add FILE1 in case of `rename'. */ /* PROBLEMS From 54e22f958b2e277830a01a5a1b0fe51ce1b6f405 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 15 Nov 2015 17:45:32 +0000 Subject: [PATCH 06/17] More work on kqueue * lisp/filenotify.el (file-notify-callback): Handle also the `rename' event from kqueue. (file-notify-add-watch): Do not register an entry twice. * src/kqueue.c (kqueue_directory_listing): New function. (kqueue_generate_event): New argument FILE1. Adapt callees. (kqueue_compare_dir_list): Rewrite in order to make it more robust. --- lisp/filenotify.el | 21 +++-- src/kqueue.c | 188 +++++++++++++++++++++++++++++++++------------ 2 files changed, 148 insertions(+), 61 deletions(-) diff --git a/lisp/filenotify.el b/lisp/filenotify.el index f7c97569825..23029427760 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -189,7 +189,7 @@ EVENT is the cadr of the event in `file-notify-handle-event' ((memq action '(attribute-changed changed created deleted renamed)) action) - ((eq action 'moved) + ((memq action '(moved rename)) (setq file1 (file-notify--event-file1-name event)) 'renamed) ((eq action 'ignored) @@ -329,7 +329,7 @@ FILE is the name of the file whose event is being reported." (if (file-directory-p file) file (file-name-directory file)))) - desc func l-flags registered) + desc func l-flags registered entry) (unless (file-directory-p dir) (signal 'file-notify-error `("Directory does not exist" ,dir))) @@ -378,18 +378,15 @@ FILE is the name of the file whose event is being reported." (setq desc (funcall func dir l-flags 'file-notify-callback))) ;; Modify `file-notify-descriptors'. - (setq registered (gethash desc file-notify-descriptors)) - (puthash - desc - `(,dir - (,(unless (file-directory-p file) (file-name-nondirectory file)) - . ,callback) - . ,(cdr registered)) - file-notify-descriptors) + (setq file (unless (file-directory-p file) (file-name-nondirectory file)) + desc (file-notify--descriptor desc file) + registered (gethash desc file-notify-descriptors) + entry `(,file . ,callback)) + (unless (member entry (cdr registered)) + (puthash desc `(,dir ,entry . ,(cdr registered)) file-notify-descriptors)) ;; Return descriptor. - (file-notify--descriptor - desc (unless (file-directory-p file) (file-name-nondirectory file))))) + desc)) (defun file-notify-rm-watch (descriptor) "Remove an existing watch specified by its DESCRIPTOR. diff --git a/src/kqueue.c b/src/kqueue.c index 0425a142a98..2097b7ed492 100644 --- a/src/kqueue.c +++ b/src/kqueue.c @@ -35,16 +35,42 @@ static int kqueuefd = -1; /* This is a list, elements are (DESCRIPTOR FILE FLAGS CALLBACK [DIRLIST]) */ static Lisp_Object watch_list; +/* Generate a temporary list from the directory_files_internal output. + Items are (INODE FILE_NAME LAST_MOD LAST_STATUS_MOD SIZE). */ +Lisp_Object +kqueue_directory_listing (Lisp_Object directory_files) +{ + Lisp_Object dl, result = Qnil; + for (dl = directory_files; ! NILP (dl); dl = XCDR (dl)) { + result = Fcons + (list5 (/* inode. */ + XCAR (Fnthcdr (make_number (11), XCAR (dl))), + /* filename. */ + XCAR (XCAR (dl)), + /* last modification time. */ + XCAR (Fnthcdr (make_number (6), XCAR (dl))), + /* last status change time. */ + XCAR (Fnthcdr (make_number (7), XCAR (dl))), + /* size. */ + XCAR (Fnthcdr (make_number (8), XCAR (dl)))), + result); + } + return result; +} + /* Generate a file notification event. */ static void kqueue_generate_event -(Lisp_Object ident, Lisp_Object actions, Lisp_Object file, Lisp_Object callback) +(Lisp_Object ident, Lisp_Object actions, Lisp_Object file, Lisp_Object file1, Lisp_Object callback) { struct input_event event; EVENT_INIT (event); event.kind = FILE_NOTIFY_EVENT; event.frame_or_window = Qnil; - event.arg = list2 (Fcons (ident, Fcons (actions, Fcons (file, Qnil))), + event.arg = list2 (Fcons (ident, Fcons (actions, + NILP (file1) + ? Fcons (file, Qnil) + : list2 (file, file1))), callback); /* Store it into the input event queue. */ @@ -53,73 +79,140 @@ kqueue_generate_event /* This compares two directory listings in case of a `write' event for a directory. The old directory listing is stored in watch_object, - it will be replaced by a new directory listing at the end. */ + it will be replaced by a new directory listing at the end of this + function. */ static void -kqueue_compare_dir_list (Lisp_Object watch_object) +kqueue_compare_dir_list +(Lisp_Object watch_object) { - Lisp_Object dir, callback, old_dl, new_dl, dl, actions; + Lisp_Object dir, callback, actions; + Lisp_Object old_directory_files, old_dl, new_directory_files, new_dl, dl; dir = XCAR (XCDR (watch_object)); - callback = XCAR (XCDR (XCDR (XCDR (watch_object)))); - old_dl = XCAR (XCDR (XCDR (XCDR (XCDR (watch_object))))); - new_dl = directory_files_internal (dir, Qnil, Qnil, Qnil, 1, Qnil); + callback = XCAR (Fnthcdr (make_number (3), watch_object)); + old_directory_files = XCAR (Fnthcdr (make_number (4), watch_object)); + old_dl = kqueue_directory_listing (old_directory_files); + new_directory_files = + directory_files_internal (dir, Qnil, Qnil, Qnil, 1, Qnil); + new_dl = kqueue_directory_listing (new_directory_files); - for (dl = old_dl; ! NILP (dl); dl = XCDR (dl)) { + /* Parse through the old list. */ + dl = old_dl; + while (1) { Lisp_Object old_entry, new_entry; - old_entry = XCAR (dl); - new_entry = Fassoc (XCAR (old_entry), new_dl); + if (NILP (dl)) + break; /* We ignore "." and "..". */ - if ((strcmp (".", SSDATA (XCAR (old_entry))) == 0) || - (strcmp ("..", SSDATA (XCAR (old_entry))) == 0)) - continue; + old_entry = XCAR (dl); + if ((strcmp (".", SSDATA (XCAR (XCDR (old_entry)))) == 0) || + (strcmp ("..", SSDATA (XCAR (XCDR (old_entry)))) == 0)) + goto the_end; - /* A file has disappeared. */ - if (NILP (new_entry)) - kqueue_generate_event - (XCAR (watch_object), Fcons (Qdelete, Qnil), - XCAR (old_entry), callback); + /* Search for an entry with the same inode. */ + new_entry = Fassoc (XCAR (old_entry), new_dl); + if (! NILP (Fequal (old_entry, new_entry))) { + /* Both entries are identical. Nothing happens. */ + new_dl = Fdelq (new_entry, new_dl); + goto the_end; + } - else { - /* A file has changed. We compare last modification time. */ - if (NILP - (Fequal - (XCAR (XCDR (XCDR (XCDR (XCDR (XCDR (XCDR (old_entry))))))), - XCAR (XCDR (XCDR (XCDR (XCDR (XCDR (XCDR (new_entry)))))))))) + if (! NILP (new_entry)) { + /* Both entries have the same inode. */ + if (strcmp (SSDATA (XCAR (XCDR (old_entry))), + SSDATA (XCAR (XCDR (new_entry)))) == 0) { + /* Both entries have the same file name. */ + if (! NILP (Fequal (XCAR (Fnthcdr (make_number (2), old_entry)), + XCAR (Fnthcdr (make_number (2), new_entry))))) + /* Modification time has been changed, the file has been written. */ + kqueue_generate_event + (XCAR (watch_object), Fcons (Qwrite, Qnil), + XCAR (XCDR (old_entry)), Qnil, callback); + if (! NILP (Fequal (XCAR (Fnthcdr (make_number (3), old_entry)), + XCAR (Fnthcdr (make_number (3), new_entry))))) + /* Status change time has been changed, the file attributes + have changed. */ + kqueue_generate_event + (XCAR (watch_object), Fcons (Qattrib, Qnil), + XCAR (XCDR (old_entry)), Qnil, callback); + + } else { + /* The file has been renamed. */ + kqueue_generate_event + (XCAR (watch_object), Fcons (Qrename, Qnil), + XCAR (XCDR (old_entry)), XCAR (XCDR (new_entry)), callback); + } + new_dl = Fdelq (new_entry, new_dl); + goto the_end; + } + + /* Search, whether there is a file with the same name (with + another inode). */ + Lisp_Object dl1; + for (dl1 = new_dl; ! NILP (dl1); dl1 = XCDR (dl1)) { + new_entry = XCAR (dl1); + if (strcmp (SSDATA (XCAR (XCDR (old_entry))), + SSDATA (XCAR (XCDR (new_entry)))) == 0) { kqueue_generate_event (XCAR (watch_object), Fcons (Qwrite, Qnil), - XCAR (old_entry), callback); - - /* A file attribute has changed. We compare last status change time. */ - if (NILP - (Fequal - (XCAR (XCDR (XCDR (XCDR (XCDR (XCDR (XCDR (XCDR (old_entry)))))))), - XCAR (XCDR (XCDR (XCDR (XCDR (XCDR (XCDR (XCDR (new_entry))))))))))) - kqueue_generate_event - (XCAR (watch_object), Fcons (Qattrib, Qnil), - XCAR (old_entry), callback); + XCAR (XCDR (old_entry)), Qnil, callback); + new_dl = Fdelq (new_entry, new_dl); + goto the_end; + } } + + /* A file has been deleted. */ + kqueue_generate_event + (XCAR (watch_object), Fcons (Qdelete, Qnil), + XCAR (XCDR (old_entry)), Qnil, callback); + + the_end: + dl = XCDR (dl); + old_dl = Fdelq (old_entry, old_dl); } - for (dl = new_dl; ! NILP (dl); dl = XCDR (dl)) { - Lisp_Object old_entry, new_entry; - new_entry = XCAR (dl); - old_entry = Fassoc (XCAR (new_entry), old_dl); + /* Parse through the shortened new list. */ + dl = new_dl; + while (1) { + Lisp_Object new_entry; + if (NILP (dl)) + break; /* We ignore "." and "..". */ - if ((strcmp (".", SSDATA (XCAR (new_entry))) == 0) || - (strcmp ("..", SSDATA (XCAR (new_entry))) == 0)) + new_entry = XCAR (dl); + if ((strcmp (".", SSDATA (XCAR (XCDR (new_entry)))) == 0) || + (strcmp ("..", SSDATA (XCAR (XCDR (new_entry)))) == 0)) { + dl = XCDR (dl); + new_dl = Fdelq (new_entry, new_dl); continue; + } /* A new file has appeared. */ - if (NILP (old_entry)) + kqueue_generate_event + (XCAR (watch_object), Fcons (Qcreate, Qnil), + XCAR (XCDR (new_entry)), Qnil, callback); + + /* Check size of that file. */ + Lisp_Object size = XCAR (Fnthcdr (make_number (4), new_entry)); + if (FLOATP (size) || (XINT (size) > 0)) kqueue_generate_event - (XCAR (watch_object), Fcons (Qcreate, Qnil), - XCAR (new_entry), callback); + (XCAR (watch_object), Fcons (Qwrite, Qnil), + XCAR (XCDR (new_entry)), Qnil, callback); + + dl = XCDR (dl); + new_dl = Fdelq (new_entry, new_dl); } + /* At this point, both old_dl and new_dl shall be empty. Let's make + a check for this (might be removed once the code is stable). */ + if (! NILP (old_dl)) + report_file_error ("Old list not empty", old_dl); + if (! NILP (new_dl)) + report_file_error ("New list not empty", new_dl); + /* Replace directory listing with the new one. */ - XSETCDR (XCDR (XCDR (XCDR (watch_object))), Fcons (new_dl, Qnil)); + XSETCDR (XCDR (XCDR (XCDR (watch_object))), + Fcons (new_directory_files, Qnil)); return; } @@ -173,7 +266,7 @@ kqueue_callback (int fd, void *data) /* Construct an event. */ if (! NILP (actions)) - kqueue_generate_event (monitor_object, actions, file, callback); + kqueue_generate_event (monitor_object, actions, file, Qnil, callback); /* Cancel monitor if file or directory is deleted. */ if (kev.fflags & (NOTE_DELETE | NOTE_RENAME)) @@ -352,9 +445,6 @@ syms_of_kqueue (void) #endif /* HAVE_KQUEUE */ -/* TODO - * Add FILE1 in case of `rename'. */ - /* PROBLEMS * https://bugs.launchpad.net/ubuntu/+source/libkqueue/+bug/1514837 prevents tests on Ubuntu. */ From 71d88ecab786e8df1490c1dbb8cba3479c29ca12 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 16 Nov 2015 08:20:22 +0100 Subject: [PATCH 07/17] * lisp/filenotify.el (file-notify-add-watch): Fix thinko. --- lisp/filenotify.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 23029427760..eb869cf66a9 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -379,14 +379,14 @@ FILE is the name of the file whose event is being reported." ;; Modify `file-notify-descriptors'. (setq file (unless (file-directory-p file) (file-name-nondirectory file)) - desc (file-notify--descriptor desc file) + desc (if (consp desc) (car desc) desc) registered (gethash desc file-notify-descriptors) entry `(,file . ,callback)) (unless (member entry (cdr registered)) (puthash desc `(,dir ,entry . ,(cdr registered)) file-notify-descriptors)) ;; Return descriptor. - desc)) + (file-notify--descriptor desc file))) (defun file-notify-rm-watch (descriptor) "Remove an existing watch specified by its DESCRIPTOR. From 30bd630da3ffe0e7a46566fed3ddf4e61abcb737 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 16 Nov 2015 09:47:26 +0000 Subject: [PATCH 08/17] Finish implementation in kqueue.c * src/kqueue.c (kqueue_directory_listing, kqueue_callback): Simplify access to list. (kqueue_compare_dir_list): Simplify access to list. Raise `delete' event if directory does not exist any longer. Otherwise, wait until directory contents has changed. Fix error in check. --- src/kqueue.c | 58 +++++++++++++++++++++++++++++++--------------------- 1 file changed, 35 insertions(+), 23 deletions(-) diff --git a/src/kqueue.c b/src/kqueue.c index 2097b7ed492..dfd91397370 100644 --- a/src/kqueue.c +++ b/src/kqueue.c @@ -32,11 +32,11 @@ along with GNU Emacs. If not, see . */ /* File handle for kqueue. */ static int kqueuefd = -1; -/* This is a list, elements are (DESCRIPTOR FILE FLAGS CALLBACK [DIRLIST]) */ +/* This is a list, elements are (DESCRIPTOR FILE FLAGS CALLBACK [DIRLIST]). */ static Lisp_Object watch_list; /* Generate a temporary list from the directory_files_internal output. - Items are (INODE FILE_NAME LAST_MOD LAST_STATUS_MOD SIZE). */ + Items are (INODE FILE-NAME LAST-MOD LAST-STATUS-MOD SIZE). */ Lisp_Object kqueue_directory_listing (Lisp_Object directory_files) { @@ -44,15 +44,15 @@ kqueue_directory_listing (Lisp_Object directory_files) for (dl = directory_files; ! NILP (dl); dl = XCDR (dl)) { result = Fcons (list5 (/* inode. */ - XCAR (Fnthcdr (make_number (11), XCAR (dl))), + Fnth (make_number (11), XCAR (dl)), /* filename. */ XCAR (XCAR (dl)), /* last modification time. */ - XCAR (Fnthcdr (make_number (6), XCAR (dl))), + Fnth (make_number (6), XCAR (dl)), /* last status change time. */ - XCAR (Fnthcdr (make_number (7), XCAR (dl))), + Fnth (make_number (7), XCAR (dl)), /* size. */ - XCAR (Fnthcdr (make_number (8), XCAR (dl)))), + Fnth (make_number (8), XCAR (dl))), result); } return result; @@ -89,11 +89,23 @@ kqueue_compare_dir_list Lisp_Object old_directory_files, old_dl, new_directory_files, new_dl, dl; dir = XCAR (XCDR (watch_object)); - callback = XCAR (Fnthcdr (make_number (3), watch_object)); - old_directory_files = XCAR (Fnthcdr (make_number (4), watch_object)); + callback = Fnth (make_number (3), watch_object); + + old_directory_files = Fnth (make_number (4), watch_object); old_dl = kqueue_directory_listing (old_directory_files); - new_directory_files = - directory_files_internal (dir, Qnil, Qnil, Qnil, 1, Qnil); + + /* Sometimes, the directory write event is triggered when the change + is not visible yet in the directory itself. So we must wait a + little bit. */ + if (NILP (Ffile_directory_p (dir))) { + kqueue_generate_event + (XCAR (watch_object), Fcons (Qdelete, Qnil), dir, Qnil, callback); + return; + } + do { + new_directory_files = + directory_files_internal (dir, Qnil, Qnil, Qnil, 1, Qnil); + } while (! NILP (Fequal (old_directory_files, new_directory_files))); new_dl = kqueue_directory_listing (new_directory_files); /* Parse through the old list. */ @@ -117,21 +129,21 @@ kqueue_compare_dir_list goto the_end; } + /* Both entries have the same inode. */ if (! NILP (new_entry)) { - /* Both entries have the same inode. */ + /* Both entries have the same file name. */ if (strcmp (SSDATA (XCAR (XCDR (old_entry))), SSDATA (XCAR (XCDR (new_entry)))) == 0) { - /* Both entries have the same file name. */ - if (! NILP (Fequal (XCAR (Fnthcdr (make_number (2), old_entry)), - XCAR (Fnthcdr (make_number (2), new_entry))))) - /* Modification time has been changed, the file has been written. */ + /* Modification time has been changed, the file has been written. */ + if (NILP (Fequal (Fnth (make_number (2), old_entry), + Fnth (make_number (2), new_entry)))) kqueue_generate_event (XCAR (watch_object), Fcons (Qwrite, Qnil), XCAR (XCDR (old_entry)), Qnil, callback); - if (! NILP (Fequal (XCAR (Fnthcdr (make_number (3), old_entry)), - XCAR (Fnthcdr (make_number (3), new_entry))))) - /* Status change time has been changed, the file attributes - have changed. */ + /* Status change time has been changed, the file attributes + have changed. */ + if (NILP (Fequal (Fnth (make_number (3), old_entry), + Fnth (make_number (3), new_entry)))) kqueue_generate_event (XCAR (watch_object), Fcons (Qattrib, Qnil), XCAR (XCDR (old_entry)), Qnil, callback); @@ -193,7 +205,7 @@ kqueue_compare_dir_list XCAR (XCDR (new_entry)), Qnil, callback); /* Check size of that file. */ - Lisp_Object size = XCAR (Fnthcdr (make_number (4), new_entry)); + Lisp_Object size = Fnth (make_number (4), new_entry); if (FLOATP (size) || (XINT (size) > 0)) kqueue_generate_event (XCAR (watch_object), Fcons (Qwrite, Qnil), @@ -211,7 +223,7 @@ kqueue_compare_dir_list report_file_error ("New list not empty", new_dl); /* Replace directory listing with the new one. */ - XSETCDR (XCDR (XCDR (XCDR (watch_object))), + XSETCDR (Fnthcdr (make_number (3), watch_object), Fcons (new_directory_files, Qnil)); return; } @@ -239,8 +251,8 @@ kqueue_callback (int fd, void *data) if (CONSP (watch_object)) { file = XCAR (XCDR (watch_object)); - callback = XCAR (XCDR (XCDR (XCDR (watch_object)))); - dirp = XCDR (XCDR (XCDR (XCDR (watch_object)))); + callback = Fnth (make_number (3), watch_object); + dirp = Fnth (make_number (4), watch_object); } else continue; From b5804c3a08cca4082bb2bcff1ab70c94ba0c7b96 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 16 Nov 2015 14:43:14 +0100 Subject: [PATCH 09/17] Doc changes for kqueue * doc/lispref/os.texi (File Notifications): Add kqueue as backend. Fix some glitches in the example. --- doc/lispref/os.texi | 41 ++++++++++++++++++++++------------------- 1 file changed, 22 insertions(+), 19 deletions(-) diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 7050df86a18..666a05dac9b 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -2566,9 +2566,9 @@ specification prior to @samp{"1.0"}. Several operating systems support watching of filesystems for changes of files. If configured properly, Emacs links a respective library -like @file{gfilenotify}, @file{inotify}, or @file{w32notify} -statically. These libraries enable watching of filesystems on the -local machine. +like @file{inotify}, @file{kqueue}, @file{gfilenotify}, or +@file{w32notify} statically. These libraries enable watching of +filesystems on the local machine. It is also possible to watch filesystems on remote machines, @pxref{Remote Files,, Remote Files, emacs, The GNU Emacs Manual} @@ -2639,7 +2639,8 @@ watching @var{file} has been stopped Note that the @file{w32notify} library does not report @code{attribute-changed} events. When some file's attribute, like permissions or modification time, has changed, this library reports a -@code{changed} event. +@code{changed} event. Likewise, the @file{kqueue} library does not +report reliably file attribute changes when watching a directory. The @code{stopped} event reports, that watching the file has been stopped. This could be because @code{file-notify-rm-watch} was called @@ -2678,7 +2679,7 @@ being reported. For example: @group (write-region "bla" nil "/tmp/foo") @result{} Event (35025468 created "/tmp/.#foo") - Event (35025468 changed "/tmp/foo") [2 times] + Event (35025468 changed "/tmp/foo") Event (35025468 deleted "/tmp/.#foo") @end group @@ -2724,14 +2725,14 @@ also makes it invalid. @example @group (make-directory "/tmp/foo") - @result{} nil + @result{} Event (35025468 created "/tmp/foo") @end group @group (setq desc (file-notify-add-watch "/tmp/foo" '(change) 'my-notify-callback)) - @result{} 35025468 + @result{} 11359632 @end group @group @@ -2741,32 +2742,34 @@ also makes it invalid. @group (write-region "bla" nil "/tmp/foo/bla") - @result{} Event (35025468 created "/tmp/foo/.#bla") - Event (35025468 created "/tmp/foo/bla") - Event (35025468 changed "/tmp/foo/bla") - Event (35025468 changed "/tmp/foo/.#bla") + @result{} Event (11359632 created "/tmp/foo/.#bla") + Event (11359632 created "/tmp/foo/bla") + Event (11359632 changed "/tmp/foo/bla") + Event (11359632 deleted "/tmp/foo/.#bla") @end group @group ;; Deleting a file in the directory doesn't invalidate the watch. (delete-file "/tmp/foo/bla") - @result{} Event (35025468 deleted "/tmp/foo/bla") + @result{} Event (11359632 deleted "/tmp/foo/bla") @end group @group (write-region "bla" nil "/tmp/foo/bla") - @result{} Event (35025468 created "/tmp/foo/.#bla") - Event (35025468 created "/tmp/foo/bla") - Event (35025468 changed "/tmp/foo/bla") - Event (35025468 changed "/tmp/foo/.#bla") + @result{} Event (11359632 created "/tmp/foo/.#bla") + Event (11359632 created "/tmp/foo/bla") + Event (11359632 changed "/tmp/foo/bla") + Event (11359632 deleted "/tmp/foo/.#bla") @end group @group ;; Deleting the directory invalidates the watch. +;; Events arrive for different watch descriptors. (delete-directory "/tmp/foo" 'recursive) - @result{} Event (35025468 deleted "/tmp/foo/bla") - Event (35025468 deleted "/tmp/foo") - Event (35025468 stopped "/tmp/foo") + @result{} Event (35025468 deleted "/tmp/foo") + Event (11359632 deleted "/tmp/foo/bla") + Event (11359632 deleted "/tmp/foo") + Event (11359632 stopped "/tmp/foo") @end group @group From bad2b4dbc6dee26bde4b2da73cf9c295f0a31f97 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 17 Nov 2015 15:46:29 +0000 Subject: [PATCH 10/17] Code cleanup of kqueue.c * src/kqueue.c (kqueue_directory_listing): Skip "." and "..". (kqueue_compare_dir_list): Do not loop when calling directory_files_internal. Remove checks for "." and "..", this is done in kqueue_directory_listing now. (Fkqueue_add_watch): Check for proper emacs_open flags. --- src/kqueue.c | 109 +++++++++++++++++++++++++++------------------------ 1 file changed, 57 insertions(+), 52 deletions(-) diff --git a/src/kqueue.c b/src/kqueue.c index dfd91397370..5caef67b92a 100644 --- a/src/kqueue.c +++ b/src/kqueue.c @@ -35,13 +35,19 @@ static int kqueuefd = -1; /* This is a list, elements are (DESCRIPTOR FILE FLAGS CALLBACK [DIRLIST]). */ static Lisp_Object watch_list; -/* Generate a temporary list from the directory_files_internal output. +/* Generate a list from the directory_files_internal output. Items are (INODE FILE-NAME LAST-MOD LAST-STATUS-MOD SIZE). */ Lisp_Object kqueue_directory_listing (Lisp_Object directory_files) { Lisp_Object dl, result = Qnil; + for (dl = directory_files; ! NILP (dl); dl = XCDR (dl)) { + /* We ignore "." and "..". */ + if ((strcmp (".", SSDATA (XCAR (XCAR (dl)))) == 0) || + (strcmp ("..", SSDATA (XCAR (XCAR (dl)))) == 0)) + continue; + result = Fcons (list5 (/* inode. */ Fnth (make_number (11), XCAR (dl)), @@ -61,7 +67,8 @@ kqueue_directory_listing (Lisp_Object directory_files) /* Generate a file notification event. */ static void kqueue_generate_event -(Lisp_Object ident, Lisp_Object actions, Lisp_Object file, Lisp_Object file1, Lisp_Object callback) +(Lisp_Object ident, Lisp_Object actions, Lisp_Object file, Lisp_Object file1, + Lisp_Object callback) { struct input_event event; EVENT_INIT (event); @@ -78,14 +85,15 @@ kqueue_generate_event } /* This compares two directory listings in case of a `write' event for - a directory. The old directory listing is stored in watch_object, - it will be replaced by a new directory listing at the end of this + a directory. Generate resulting file notification events. The old + directory listing is retrieved from watch_object, it will be + replaced by the new directory listing at the end of this function. */ static void kqueue_compare_dir_list (Lisp_Object watch_object) { - Lisp_Object dir, callback, actions; + Lisp_Object dir, callback; Lisp_Object old_directory_files, old_dl, new_directory_files, new_dl, dl; dir = XCAR (XCDR (watch_object)); @@ -94,37 +102,28 @@ kqueue_compare_dir_list old_directory_files = Fnth (make_number (4), watch_object); old_dl = kqueue_directory_listing (old_directory_files); - /* Sometimes, the directory write event is triggered when the change - is not visible yet in the directory itself. So we must wait a - little bit. */ + /* When the directory is not accessible anymore, it has been deleted. */ if (NILP (Ffile_directory_p (dir))) { kqueue_generate_event (XCAR (watch_object), Fcons (Qdelete, Qnil), dir, Qnil, callback); return; } - do { - new_directory_files = - directory_files_internal (dir, Qnil, Qnil, Qnil, 1, Qnil); - } while (! NILP (Fequal (old_directory_files, new_directory_files))); + new_directory_files = + directory_files_internal (dir, Qnil, Qnil, Qnil, 1, Qnil); new_dl = kqueue_directory_listing (new_directory_files); /* Parse through the old list. */ dl = old_dl; while (1) { - Lisp_Object old_entry, new_entry; + Lisp_Object old_entry, new_entry, dl1; if (NILP (dl)) break; - /* We ignore "." and "..". */ - old_entry = XCAR (dl); - if ((strcmp (".", SSDATA (XCAR (XCDR (old_entry)))) == 0) || - (strcmp ("..", SSDATA (XCAR (XCDR (old_entry)))) == 0)) - goto the_end; - /* Search for an entry with the same inode. */ + old_entry = XCAR (dl); new_entry = Fassoc (XCAR (old_entry), new_dl); if (! NILP (Fequal (old_entry, new_entry))) { - /* Both entries are identical. Nothing happens. */ + /* Both entries are identical. Nothing to do. */ new_dl = Fdelq (new_entry, new_dl); goto the_end; } @@ -158,9 +157,8 @@ kqueue_compare_dir_list goto the_end; } - /* Search, whether there is a file with the same name (with - another inode). */ - Lisp_Object dl1; + /* Search, whether there is a file with the same name but another + inode. */ for (dl1 = new_dl; ! NILP (dl1); dl1 = XCDR (dl1)) { new_entry = XCAR (dl1); if (strcmp (SSDATA (XCAR (XCDR (old_entry))), @@ -173,7 +171,7 @@ kqueue_compare_dir_list } } - /* A file has been deleted. */ + /* The file has been deleted. */ kqueue_generate_event (XCAR (watch_object), Fcons (Qdelete, Qnil), XCAR (XCDR (old_entry)), Qnil, callback); @@ -183,23 +181,15 @@ kqueue_compare_dir_list old_dl = Fdelq (old_entry, old_dl); } - /* Parse through the shortened new list. */ + /* Parse through the resulting new list. */ dl = new_dl; while (1) { Lisp_Object new_entry; if (NILP (dl)) break; - /* We ignore "." and "..". */ - new_entry = XCAR (dl); - if ((strcmp (".", SSDATA (XCAR (XCDR (new_entry)))) == 0) || - (strcmp ("..", SSDATA (XCAR (XCDR (new_entry)))) == 0)) { - dl = XCDR (dl); - new_dl = Fdelq (new_entry, new_dl); - continue; - } - /* A new file has appeared. */ + new_entry = XCAR (dl); kqueue_generate_event (XCAR (watch_object), Fcons (Qcreate, Qnil), XCAR (XCDR (new_entry)), Qnil, callback); @@ -222,21 +212,21 @@ kqueue_compare_dir_list if (! NILP (new_dl)) report_file_error ("New list not empty", new_dl); - /* Replace directory listing with the new one. */ + /* Replace old directory listing with the new one. */ XSETCDR (Fnthcdr (make_number (3), watch_object), Fcons (new_directory_files, Qnil)); return; } /* This is the callback function for arriving input on kqueuefd. It - shall create a Lisp event, and put it into Emacs input queue. */ + shall create a Lisp event, and put it into the Emacs input queue. */ static void kqueue_callback (int fd, void *data) { for (;;) { struct kevent kev; static const struct timespec nullts = { 0, 0 }; - Lisp_Object monitor_object, watch_object, file, callback, dirp, actions; + Lisp_Object descriptor, watch_object, file, callback, actions; /* Read one event. */ int ret = kevent (kqueuefd, NULL, 0, &kev, 1, &nullts); @@ -245,14 +235,13 @@ kqueue_callback (int fd, void *data) return; } - /* Determine file name and callback function. */ - monitor_object = make_number (kev.ident); - watch_object = assq_no_quit (monitor_object, watch_list); + /* Determine descriptor, file name and callback function. */ + descriptor = make_number (kev.ident); + watch_object = assq_no_quit (descriptor, watch_list); if (CONSP (watch_object)) { file = XCAR (XCDR (watch_object)); callback = Fnth (make_number (3), watch_object); - dirp = Fnth (make_number (4), watch_object); } else continue; @@ -262,7 +251,8 @@ kqueue_callback (int fd, void *data) if (kev.fflags & NOTE_DELETE) actions = Fcons (Qdelete, actions); if (kev.fflags & NOTE_WRITE) { - if (NILP (dirp)) + /* Check, whether this is a directory event. */ + if (NILP (Fnth (make_number (4), watch_object))) actions = Fcons (Qwrite, actions); else kqueue_compare_dir_list (watch_object); @@ -273,16 +263,19 @@ kqueue_callback (int fd, void *data) actions = Fcons (Qattrib, actions); if (kev.fflags & NOTE_LINK) actions = Fcons (Qlink, actions); + /* It would be useful to know the target of the rename operation. + At this point, it is not possible. Happens only when the upper + directory is monitored. */ if (kev.fflags & NOTE_RENAME) actions = Fcons (Qrename, actions); - /* Construct an event. */ + /* Create the event. */ if (! NILP (actions)) - kqueue_generate_event (monitor_object, actions, file, Qnil, callback); + kqueue_generate_event (descriptor, actions, file, Qnil, callback); - /* Cancel monitor if file or directory is deleted. */ + /* Cancel monitor if file or directory is deleted or renamed. */ if (kev.fflags & (NOTE_DELETE | NOTE_RENAME)) - Fkqueue_rm_watch (monitor_object); + Fkqueue_rm_watch (descriptor); } return; } @@ -316,13 +309,14 @@ DESCRIPTOR is the same object as the one returned by this function. ACTIONS is a list of events. FILE is the name of the file whose event is being reported. FILE1 -will be reported only in case of the `rename' event. */) +will be reported only in case of the `rename' event. This is possible +only when the upper directory of the renamed file is watched. */) (Lisp_Object file, Lisp_Object flags, Lisp_Object callback) { Lisp_Object watch_object, dir_list; - int fd; + int fd, oflags; u_short fflags = 0; - struct kevent ev; + struct kevent kev; /* Check parameters. */ CHECK_STRING (file); @@ -350,7 +344,18 @@ will be reported only in case of the `rename' event. */) /* Open file. */ file = ENCODE_FILE (file); - fd = emacs_open (SSDATA (file), O_RDONLY, 0); + oflags = O_NONBLOCK; +#if O_EVTONLY + oflags |= O_EVTONLY; +#else + oflags |= O_RDONLY; +#endif +#if O_SYMLINK + oflags |= O_SYMLINK; +#else + oflags |= O_NOFOLLOW; +#endif + fd = emacs_open (SSDATA (file), oflags, 0); if (fd == -1) report_file_error ("File cannot be opened", file); @@ -363,10 +368,10 @@ will be reported only in case of the `rename' event. */) if (! NILP (Fmember (Qrename, flags))) fflags |= NOTE_RENAME; /* Register event. */ - EV_SET (&ev, fd, EVFILT_VNODE, EV_ADD | EV_ENABLE | EV_CLEAR, + EV_SET (&kev, fd, EVFILT_VNODE, EV_ADD | EV_ENABLE | EV_CLEAR, fflags, 0, NULL); - if (kevent (kqueuefd, &ev, 1, NULL, 0, NULL) < 0) { + if (kevent (kqueuefd, &kev, 1, NULL, 0, NULL) < 0) { emacs_close (fd); report_file_error ("Cannot watch file", file); } From 5f08a72c8bf88d4f6f564c5890ec937f59605463 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 18 Nov 2015 13:47:25 +0000 Subject: [PATCH 11/17] Further fixes for kqueue. * lisp/filenotify.el (file-notify-callback): Raise also event if directory name matches. (file-notify-add-watch): Add `create' to the flags for `kqueue'. * src/kqueue.c (kqueue_generate_event): Use watch_object as argument instead of ident. Remove callback argument. Adapt callees. Check actions whether they are monitored flags. * test/automated/file-notify-tests.el (file-notify--test-library): New defun. (file-notify-test00-availability, file-notify-test02-events) (file-notify-test04-file-validity) (file-notify-test05-dir-validity): Use it. (file-notify-test02-events, file-notify-test04-file-validity): Add `read-event' calls between different file actions, in order to give the backends a chance to rais an event. Needed especially for kqueue. In case of deleting a directory, there are two `deleted' events. --- lisp/filenotify.el | 6 ++- src/kqueue.c | 81 ++++++++++++++++------------- test/automated/file-notify-tests.el | 59 +++++++++++++++------ 3 files changed, 91 insertions(+), 55 deletions(-) diff --git a/lisp/filenotify.el b/lisp/filenotify.el index eb869cf66a9..5072bf414bf 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -258,6 +258,10 @@ EVENT is the cadr of the event in `file-notify-handle-event' ;; File matches. (string-equal (nth 0 entry) (file-name-nondirectory file)) + ;; Directory matches. + (string-equal + (file-name-nondirectory file) + (file-name-nondirectory (car registered))) ;; File1 matches. (and (stringp file1) (string-equal @@ -364,7 +368,7 @@ FILE is the name of the file whose event is being reported." ((eq file-notify--library 'inotify) '(create delete delete-self modify move-self move)) ((eq file-notify--library 'kqueue) - '(delete write extend rename)) + '(create delete write extend rename)) ((eq file-notify--library 'w32notify) '(file-name directory-name size last-write-time))))) (when (memq 'attribute-change flags) diff --git a/src/kqueue.c b/src/kqueue.c index 5caef67b92a..e2c9dabcb20 100644 --- a/src/kqueue.c +++ b/src/kqueue.c @@ -67,21 +67,39 @@ kqueue_directory_listing (Lisp_Object directory_files) /* Generate a file notification event. */ static void kqueue_generate_event -(Lisp_Object ident, Lisp_Object actions, Lisp_Object file, Lisp_Object file1, - Lisp_Object callback) +(Lisp_Object watch_object, Lisp_Object actions, + Lisp_Object file, Lisp_Object file1) { + Lisp_Object flags, action, entry; struct input_event event; - EVENT_INIT (event); - event.kind = FILE_NOTIFY_EVENT; - event.frame_or_window = Qnil; - event.arg = list2 (Fcons (ident, Fcons (actions, - NILP (file1) - ? Fcons (file, Qnil) - : list2 (file, file1))), - callback); + + /* Check, whether all actions shall be monitored. */ + flags = Fnth (make_number (2), watch_object); + action = actions; + do { + if (NILP (action)) + break; + entry = XCAR (action); + if (NILP (Fmember (entry, flags))) { + action = XCDR (action); + actions = Fdelq (entry, actions); + } else + action = XCDR (action); + } while (1); /* Store it into the input event queue. */ - kbd_buffer_store_event (&event); + if (! NILP (actions)) { + EVENT_INIT (event); + event.kind = FILE_NOTIFY_EVENT; + event.frame_or_window = Qnil; + event.arg = list2 (Fcons (XCAR (watch_object), + Fcons (actions, + NILP (file1) + ? Fcons (file, Qnil) + : list2 (file, file1))), + Fnth (make_number (3), watch_object)); + kbd_buffer_store_event (&event); + } } /* This compares two directory listings in case of a `write' event for @@ -93,19 +111,16 @@ static void kqueue_compare_dir_list (Lisp_Object watch_object) { - Lisp_Object dir, callback; - Lisp_Object old_directory_files, old_dl, new_directory_files, new_dl, dl; + Lisp_Object dir, old_directory_files, old_dl, new_directory_files, new_dl, dl; dir = XCAR (XCDR (watch_object)); - callback = Fnth (make_number (3), watch_object); old_directory_files = Fnth (make_number (4), watch_object); old_dl = kqueue_directory_listing (old_directory_files); /* When the directory is not accessible anymore, it has been deleted. */ if (NILP (Ffile_directory_p (dir))) { - kqueue_generate_event - (XCAR (watch_object), Fcons (Qdelete, Qnil), dir, Qnil, callback); + kqueue_generate_event (watch_object, Fcons (Qdelete, Qnil), dir, Qnil); return; } new_directory_files = @@ -137,21 +152,20 @@ kqueue_compare_dir_list if (NILP (Fequal (Fnth (make_number (2), old_entry), Fnth (make_number (2), new_entry)))) kqueue_generate_event - (XCAR (watch_object), Fcons (Qwrite, Qnil), - XCAR (XCDR (old_entry)), Qnil, callback); + (watch_object, Fcons (Qwrite, Qnil), XCAR (XCDR (old_entry)), Qnil); /* Status change time has been changed, the file attributes have changed. */ if (NILP (Fequal (Fnth (make_number (3), old_entry), Fnth (make_number (3), new_entry)))) kqueue_generate_event - (XCAR (watch_object), Fcons (Qattrib, Qnil), - XCAR (XCDR (old_entry)), Qnil, callback); + (watch_object, Fcons (Qattrib, Qnil), + XCAR (XCDR (old_entry)), Qnil); } else { /* The file has been renamed. */ kqueue_generate_event - (XCAR (watch_object), Fcons (Qrename, Qnil), - XCAR (XCDR (old_entry)), XCAR (XCDR (new_entry)), callback); + (watch_object, Fcons (Qrename, Qnil), + XCAR (XCDR (old_entry)), XCAR (XCDR (new_entry))); } new_dl = Fdelq (new_entry, new_dl); goto the_end; @@ -164,8 +178,7 @@ kqueue_compare_dir_list if (strcmp (SSDATA (XCAR (XCDR (old_entry))), SSDATA (XCAR (XCDR (new_entry)))) == 0) { kqueue_generate_event - (XCAR (watch_object), Fcons (Qwrite, Qnil), - XCAR (XCDR (old_entry)), Qnil, callback); + (watch_object, Fcons (Qwrite, Qnil), XCAR (XCDR (old_entry)), Qnil); new_dl = Fdelq (new_entry, new_dl); goto the_end; } @@ -173,8 +186,7 @@ kqueue_compare_dir_list /* The file has been deleted. */ kqueue_generate_event - (XCAR (watch_object), Fcons (Qdelete, Qnil), - XCAR (XCDR (old_entry)), Qnil, callback); + (watch_object, Fcons (Qdelete, Qnil), XCAR (XCDR (old_entry)), Qnil); the_end: dl = XCDR (dl); @@ -191,15 +203,13 @@ kqueue_compare_dir_list /* A new file has appeared. */ new_entry = XCAR (dl); kqueue_generate_event - (XCAR (watch_object), Fcons (Qcreate, Qnil), - XCAR (XCDR (new_entry)), Qnil, callback); + (watch_object, Fcons (Qcreate, Qnil), XCAR (XCDR (new_entry)), Qnil); /* Check size of that file. */ Lisp_Object size = Fnth (make_number (4), new_entry); if (FLOATP (size) || (XINT (size) > 0)) kqueue_generate_event - (XCAR (watch_object), Fcons (Qwrite, Qnil), - XCAR (XCDR (new_entry)), Qnil, callback); + (watch_object, Fcons (Qwrite, Qnil), XCAR (XCDR (new_entry)), Qnil); dl = XCDR (dl); new_dl = Fdelq (new_entry, new_dl); @@ -226,7 +236,7 @@ kqueue_callback (int fd, void *data) for (;;) { struct kevent kev; static const struct timespec nullts = { 0, 0 }; - Lisp_Object descriptor, watch_object, file, callback, actions; + Lisp_Object descriptor, watch_object, file, actions; /* Read one event. */ int ret = kevent (kqueuefd, NULL, 0, &kev, 1, &nullts); @@ -235,14 +245,11 @@ kqueue_callback (int fd, void *data) return; } - /* Determine descriptor, file name and callback function. */ + /* Determine descriptor and file name. */ descriptor = make_number (kev.ident); watch_object = assq_no_quit (descriptor, watch_list); - - if (CONSP (watch_object)) { + if (CONSP (watch_object)) file = XCAR (XCDR (watch_object)); - callback = Fnth (make_number (3), watch_object); - } else continue; @@ -271,7 +278,7 @@ kqueue_callback (int fd, void *data) /* Create the event. */ if (! NILP (actions)) - kqueue_generate_event (descriptor, actions, file, Qnil, callback); + kqueue_generate_event (watch_object, actions, file, Qnil); /* Cancel monitor if file or directory is deleted or renamed. */ if (kev.fflags & (NOTE_DELETE | NOTE_RENAME)) diff --git a/test/automated/file-notify-tests.el b/test/automated/file-notify-tests.el index 67e929a6477..6946541b909 100644 --- a/test/automated/file-notify-tests.el +++ b/test/automated/file-notify-tests.el @@ -133,6 +133,18 @@ being the result.") ;; Return result. (cdr file-notify--test-remote-enabled-checked)) +(defun file-notify--test-library () + "The used libray for the test, as string. +In the remote case, it is the process name which runs on the +remote host, or nil." + (if (null (file-remote-p temporary-file-directory)) + (symbol-name file-notify--library) + (and (consp file-notify--test-remote-enabled-checked) + (processp (cdr file-notify--test-remote-enabled-checked)) + (replace-regexp-in-string + "<[[:digit:]]+>\\'" "" + (process-name (cdr file-notify--test-remote-enabled-checked)))))) + (defmacro file-notify--deftest-remote (test docstring) "Define ert `TEST-remote' for remote files." (declare (indent 1)) @@ -150,12 +162,7 @@ being the result.") "Test availability of `file-notify'." (skip-unless (file-notify--test-local-enabled)) ;; Report the native library which has been used. - (if (null (file-remote-p temporary-file-directory)) - (message "Local library: `%s'" file-notify--library) - (message "Remote command: `%s'" - (replace-regexp-in-string - "<[[:digit:]]+>\\'" "" - (process-name (cdr file-notify--test-remote-enabled-checked))))) + (message "Library: `%s'" (file-notify--test-library)) (should (setq file-notify--test-desc (file-notify-add-watch temporary-file-directory '(change) 'ignore))) @@ -311,6 +318,7 @@ Don't wait longer than timeout seconds for the events to be delivered." (file-notify--test-with-events '(created changed deleted) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) + (read-event nil nil 0.1) (delete-file file-notify--test-tmpfile)) ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. (let (file-notify--test-events) @@ -319,7 +327,7 @@ Don't wait longer than timeout seconds for the events to be delivered." ;; Check creation, change and deletion. There must be a ;; `stopped' event when deleting the directory. It doesn't ;; work for w32notify. - (unless (eq file-notify--library 'w32notify) + (unless (string-equal (file-notify--test-library) "w32notify") (make-directory file-notify--test-tmpfile) (setq file-notify--test-desc (file-notify-add-watch @@ -327,11 +335,14 @@ Don't wait longer than timeout seconds for the events to be delivered." '(change) 'file-notify--test-event-handler)) (file-notify--test-with-events ;; There are two `deleted' events, for the file and for - ;; the directory. - '(created changed deleted deleted stopped) + ;; the directory. Except for kqueue. + (if (string-equal (file-notify--test-library) "kqueue") + '(created changed deleted stopped) + '(created changed deleted deleted stopped)) (write-region "any text" nil (expand-file-name "foo" file-notify--test-tmpfile) nil 'no-message) + (read-event nil nil 0.1) (delete-directory file-notify--test-tmpfile 'recursive)) ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. (let (file-notify--test-events) @@ -346,17 +357,21 @@ Don't wait longer than timeout seconds for the events to be delivered." (file-notify--test-with-events ;; w32notify does not distinguish between `changed' and ;; `attribute-changed'. - (if (eq file-notify--library 'w32notify) + (if (string-equal (file-notify--test-library) "w32notify") '(created changed changed deleted) '(created changed deleted)) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) + (read-event nil nil 0.1) (copy-file file-notify--test-tmpfile file-notify--test-tmpfile1) ;; The next two events shall not be visible. + (read-event nil nil 0.1) (set-file-modes file-notify--test-tmpfile 000) - (read-event nil nil 0.1) ; In order to distinguish the events. + (read-event nil nil 0.1) (set-file-times file-notify--test-tmpfile '(0 0)) + (read-event nil nil 0.1) (delete-file file-notify--test-tmpfile) + (read-event nil nil 0.1) (delete-file file-notify--test-tmpfile1)) ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. (let (file-notify--test-events) @@ -371,15 +386,18 @@ Don't wait longer than timeout seconds for the events to be delivered." (file-notify--test-with-events '(created changed renamed) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) + (read-event nil nil 0.1) (rename-file file-notify--test-tmpfile file-notify--test-tmpfile1) ;; After the rename, we won't get events anymore. + (read-event nil nil 0.1) (delete-file file-notify--test-tmpfile1)) ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. (let (file-notify--test-events) (file-notify-rm-watch file-notify--test-desc)) - ;; Check attribute change. It doesn't work for w32notify. - (unless (eq file-notify--library 'w32notify) + ;; Check attribute change. It doesn't work for kqueue and w32notify. + (unless (or (string-equal (file-notify--test-library) "kqueue") + (string-equal (file-notify--test-library) "w32notify")) (setq file-notify--test-desc (file-notify-add-watch file-notify--test-tmpfile @@ -523,6 +541,7 @@ Don't wait longer than timeout seconds for the events to be delivered." (should (file-notify-valid-p file-notify--test-desc)) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) + (read-event nil nil 0.1) (delete-file file-notify--test-tmpfile)) ;; After deleting the file, the descriptor is still valid. (should (file-notify-valid-p file-notify--test-desc)) @@ -537,8 +556,7 @@ Don't wait longer than timeout seconds for the events to be delivered." (unwind-protect ;; The batch-mode operation of w32notify is fragile (there's no ;; input threads to send the message to). - ;(unless (and noninteractive (eq file-notify--library 'w32notify)) - (unless (eq file-notify--library 'w32notify) + (unless (string-equal (file-notify--test-library) "w32notify") (let ((temporary-file-directory (make-temp-file "file-notify-test-parent" t))) (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) @@ -546,10 +564,16 @@ Don't wait longer than timeout seconds for the events to be delivered." (file-notify-add-watch file-notify--test-tmpfile '(change) #'file-notify--test-event-handler)) - (file-notify--test-with-events '(created changed deleted stopped) + (file-notify--test-with-events + ;; There are two `deleted' events, for the file and for + ;; the directory. Except for kqueue. + (if (string-equal (file-notify--test-library) "kqueue") + '(created changed deleted stopped) + '(created changed deleted deleted stopped)) (should (file-notify-valid-p file-notify--test-desc)) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) + (read-event nil nil 0.1) (delete-directory temporary-file-directory t)) ;; After deleting the parent directory, the descriptor must ;; not be valid anymore. @@ -589,7 +613,8 @@ Don't wait longer than timeout seconds for the events to be delivered." (unwind-protect ;; The batch-mode operation of w32notify is fragile (there's no ;; input threads to send the message to). - (unless (and noninteractive (eq file-notify--library 'w32notify)) + (unless (and noninteractive + (string-equal (file-notify--test-library) "w32notify")) (setq file-notify--test-tmpfile (file-name-as-directory (file-notify--test-make-temp-name))) (make-directory file-notify--test-tmpfile) From 0d45fc135cb2ac17aa776cc5bd5b339bf20514ae Mon Sep 17 00:00:00 2001 From: Wolfgang Jenkner Date: Wed, 18 Nov 2015 19:24:27 +0100 Subject: [PATCH 12/17] New test with a larger number of events. * test/automated/file-notify-tests.el (file-notify--test-with-events): Make timeout heuristically depend on the number of events. (file-notify-test06-many-events): Use it for new test. --- test/automated/file-notify-tests.el | 41 ++++++++++++++++++++++++++++- 1 file changed, 40 insertions(+), 1 deletion(-) diff --git a/test/automated/file-notify-tests.el b/test/automated/file-notify-tests.el index 6946541b909..f0068c547a5 100644 --- a/test/automated/file-notify-tests.el +++ b/test/automated/file-notify-tests.el @@ -293,7 +293,8 @@ Don't wait longer than timeout seconds for the events to be delivered." (let (file-notify--test-events) ,@body (file-notify--wait-for-events - (file-notify--test-timeout) + ;; More events need more time. Use some fudge factor. + (* (ceiling (length ,events) 100) (file-notify--test-timeout)) (= (length ,events) (length file-notify--test-events))) (should (equal ,events (mapcar #'cadr file-notify--test-events))) (setq ,outer (append ,outer file-notify--test-events))) @@ -637,6 +638,44 @@ Don't wait longer than timeout seconds for the events to be delivered." (file-notify--deftest-remote file-notify-test05-dir-validity "Check `file-notify-valid-p' via file notification for remote directories.") +(ert-deftest file-notify-test06-many-events () + "Check that events are not dropped." + (skip-unless (file-notify--test-local-enabled)) + ;; Under cygwin there are so bad timings that it doesn't make sense to test. + (skip-unless (not (eq system-type 'cygwin))) + (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)) + (make-directory file-notify--test-tmpfile) + (setq file-notify--test-desc + (file-notify-add-watch + file-notify--test-tmpfile + '(change) 'file-notify--test-event-handler)) + (unwind-protect + (let ((n 1000) + x-file-list y-file-list + (default-directory file-notify--test-tmpfile)) + (dotimes (i n) + (push (expand-file-name (format "x%d" i)) x-file-list) + (push (expand-file-name (format "y%d" i)) y-file-list)) + (file-notify--test-with-events (make-list (+ n n) 'created) + (dolist (file x-file-list) + (write-region "" nil file nil 'no-message)) + (dolist (file y-file-list) + (write-region "" nil file nil 'no-message))) + (file-notify--test-with-events (cond + ;; XXX Different results? + ((featurep 'kqueue) + (append (make-list n 'changed) + (make-list n 'deleted))) + (t (make-list n 'renamed))) + (let ((x-file-list x-file-list) + (y-file-list y-file-list)) + (while (and x-file-list y-file-list) + (rename-file (pop x-file-list) (pop y-file-list) t)))) + (file-notify--test-with-events (make-list n 'deleted) + (dolist (file y-file-list) + (delete-file file)))) + (file-notify--test-cleanup))) + (defun file-notify-test-all (&optional interactive) "Run all tests for \\[file-notify]." (interactive "p") From a81fe30a764c117e87e9da13f19b46d0ba6d35a8 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 19 Nov 2015 09:58:08 +0000 Subject: [PATCH 13/17] Handle more complex rename operation in kqueue * src/kqueue.c (pending_events): New variable. (kqueue_compare_dir_list): Handle more complex rename operation. (globals_of_kqueue): Initialize pending_events. * test/automated/file-notify-tests.el (file-notify-test06-many-events): Adapt expected events in the `rename-file' case. (file-notify-test06-many-events-remote): Declare. --- src/kqueue.c | 25 +++++++++++++++++++------ test/automated/file-notify-tests.el | 10 ++++------ 2 files changed, 23 insertions(+), 12 deletions(-) diff --git a/src/kqueue.c b/src/kqueue.c index e2c9dabcb20..fa541764169 100644 --- a/src/kqueue.c +++ b/src/kqueue.c @@ -35,6 +35,10 @@ static int kqueuefd = -1; /* This is a list, elements are (DESCRIPTOR FILE FLAGS CALLBACK [DIRLIST]). */ static Lisp_Object watch_list; +/* Pending events, being the target of a rename operation. + Items are (INODE FILE-NAME LAST-MOD LAST-STATUS-MOD SIZE). */ +static Lisp_Object pending_events; + /* Generate a list from the directory_files_internal output. Items are (INODE FILE-NAME LAST-MOD LAST-STATUS-MOD SIZE). */ Lisp_Object @@ -136,7 +140,7 @@ kqueue_compare_dir_list /* Search for an entry with the same inode. */ old_entry = XCAR (dl); - new_entry = Fassoc (XCAR (old_entry), new_dl); + new_entry = assq_no_quit (XCAR (old_entry), new_dl); if (! NILP (Fequal (old_entry, new_entry))) { /* Both entries are identical. Nothing to do. */ new_dl = Fdelq (new_entry, new_dl); @@ -177,16 +181,24 @@ kqueue_compare_dir_list new_entry = XCAR (dl1); if (strcmp (SSDATA (XCAR (XCDR (old_entry))), SSDATA (XCAR (XCDR (new_entry)))) == 0) { - kqueue_generate_event - (watch_object, Fcons (Qwrite, Qnil), XCAR (XCDR (old_entry)), Qnil); + pending_events = Fcons (new_entry, pending_events); new_dl = Fdelq (new_entry, new_dl); goto the_end; } } - /* The file has been deleted. */ - kqueue_generate_event - (watch_object, Fcons (Qdelete, Qnil), XCAR (XCDR (old_entry)), Qnil); + new_entry = assq_no_quit (XCAR (old_entry), pending_events); + if (NILP (new_entry)) + /* The file has been deleted. */ + kqueue_generate_event + (watch_object, Fcons (Qdelete, Qnil), XCAR (XCDR (old_entry)), Qnil); + else { + /* The file has been renamed. */ + kqueue_generate_event + (watch_object, Fcons (Qrename, Qnil), + XCAR (XCDR (old_entry)), XCAR (XCDR (new_entry))); + new_dl = Fdelq (new_entry, new_dl); + } the_end: dl = XCDR (dl); @@ -444,6 +456,7 @@ void globals_of_kqueue (void) { watch_list = Qnil; + pending_events = Qnil; } void diff --git a/test/automated/file-notify-tests.el b/test/automated/file-notify-tests.el index f0068c547a5..b9cd192dd19 100644 --- a/test/automated/file-notify-tests.el +++ b/test/automated/file-notify-tests.el @@ -661,12 +661,7 @@ Don't wait longer than timeout seconds for the events to be delivered." (write-region "" nil file nil 'no-message)) (dolist (file y-file-list) (write-region "" nil file nil 'no-message))) - (file-notify--test-with-events (cond - ;; XXX Different results? - ((featurep 'kqueue) - (append (make-list n 'changed) - (make-list n 'deleted))) - (t (make-list n 'renamed))) + (file-notify--test-with-events (make-list n 'renamed) (let ((x-file-list x-file-list) (y-file-list y-file-list)) (while (and x-file-list y-file-list) @@ -676,6 +671,9 @@ Don't wait longer than timeout seconds for the events to be delivered." (delete-file file)))) (file-notify--test-cleanup))) +(file-notify--deftest-remote file-notify-test06-many-events + "Check that events are not dropped remote directories.") + (defun file-notify-test-all (&optional interactive) "Run all tests for \\[file-notify]." (interactive "p") From 4e4180a478aba1f3b66adaab8c0284d215ad6e03 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 19 Nov 2015 16:56:28 +0100 Subject: [PATCH 14/17] Improve loops in file-notify-test06-many-events * test/automated/file-notify-tests.el (file-notify-test06-many-events): Use `read-event' pauses for the `write-file' loops; otherwise events are lost in inotify and gfilenotify cases. --- test/automated/file-notify-tests.el | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/test/automated/file-notify-tests.el b/test/automated/file-notify-tests.el index b9cd192dd19..81fb42e13b1 100644 --- a/test/automated/file-notify-tests.el +++ b/test/automated/file-notify-tests.el @@ -657,10 +657,12 @@ Don't wait longer than timeout seconds for the events to be delivered." (push (expand-file-name (format "x%d" i)) x-file-list) (push (expand-file-name (format "y%d" i)) y-file-list)) (file-notify--test-with-events (make-list (+ n n) 'created) - (dolist (file x-file-list) - (write-region "" nil file nil 'no-message)) - (dolist (file y-file-list) - (write-region "" nil file nil 'no-message))) + (let ((x-file-list x-file-list) + (y-file-list y-file-list)) + (while (and x-file-list y-file-list) + (write-region "" nil (pop x-file-list) nil 'no-message) + (read-event nil nil 0.1) + (write-region "" nil (pop y-file-list) nil 'no-message)))) (file-notify--test-with-events (make-list n 'renamed) (let ((x-file-list x-file-list) (y-file-list y-file-list)) @@ -672,7 +674,7 @@ Don't wait longer than timeout seconds for the events to be delivered." (file-notify--test-cleanup))) (file-notify--deftest-remote file-notify-test06-many-events - "Check that events are not dropped remote directories.") + "Check that events are not dropped for remote directories.") (defun file-notify-test-all (&optional interactive) "Run all tests for \\[file-notify]." From 83d429b0ad0d73df68b79dd94d7c95256e01fdc0 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 19 Nov 2015 18:49:33 +0000 Subject: [PATCH 15/17] Continie with pending events * src/kqueue.c (pending_events): Remove global variable. (kqueue_compare_dir_list): Create `write' event for not used pending events. (globals_of_kqueue): Remove initialization of pending_events. --- src/kqueue.c | 45 +++++++++++++++++++++++++++++++-------------- 1 file changed, 31 insertions(+), 14 deletions(-) diff --git a/src/kqueue.c b/src/kqueue.c index fa541764169..ca0e3e7e1ca 100644 --- a/src/kqueue.c +++ b/src/kqueue.c @@ -35,10 +35,6 @@ static int kqueuefd = -1; /* This is a list, elements are (DESCRIPTOR FILE FLAGS CALLBACK [DIRLIST]). */ static Lisp_Object watch_list; -/* Pending events, being the target of a rename operation. - Items are (INODE FILE-NAME LAST-MOD LAST-STATUS-MOD SIZE). */ -static Lisp_Object pending_events; - /* Generate a list from the directory_files_internal output. Items are (INODE FILE-NAME LAST-MOD LAST-STATUS-MOD SIZE). */ Lisp_Object @@ -115,9 +111,11 @@ static void kqueue_compare_dir_list (Lisp_Object watch_object) { - Lisp_Object dir, old_directory_files, old_dl, new_directory_files, new_dl, dl; + Lisp_Object dir, pending_events; + Lisp_Object old_directory_files, old_dl, new_directory_files, new_dl, dl; dir = XCAR (XCDR (watch_object)); + pending_events = Qnil; old_directory_files = Fnth (make_number (4), watch_object); old_dl = kqueue_directory_listing (old_directory_files); @@ -198,6 +196,7 @@ kqueue_compare_dir_list (watch_object, Fcons (Qrename, Qnil), XCAR (XCDR (old_entry)), XCAR (XCDR (new_entry))); new_dl = Fdelq (new_entry, new_dl); + pending_events = Fdelq (new_entry, pending_events); } the_end: @@ -208,31 +207,50 @@ kqueue_compare_dir_list /* Parse through the resulting new list. */ dl = new_dl; while (1) { - Lisp_Object new_entry; + Lisp_Object entry; if (NILP (dl)) break; /* A new file has appeared. */ - new_entry = XCAR (dl); + entry = XCAR (dl); kqueue_generate_event - (watch_object, Fcons (Qcreate, Qnil), XCAR (XCDR (new_entry)), Qnil); + (watch_object, Fcons (Qcreate, Qnil), XCAR (XCDR (entry)), Qnil); /* Check size of that file. */ - Lisp_Object size = Fnth (make_number (4), new_entry); + Lisp_Object size = Fnth (make_number (4), entry); if (FLOATP (size) || (XINT (size) > 0)) kqueue_generate_event - (watch_object, Fcons (Qwrite, Qnil), XCAR (XCDR (new_entry)), Qnil); + (watch_object, Fcons (Qwrite, Qnil), XCAR (XCDR (entry)), Qnil); dl = XCDR (dl); - new_dl = Fdelq (new_entry, new_dl); + new_dl = Fdelq (entry, new_dl); } - /* At this point, both old_dl and new_dl shall be empty. Let's make - a check for this (might be removed once the code is stable). */ + /* Parse through the resulting pending_events_list. */ + dl = pending_events; + while (1) { + Lisp_Object entry; + if (NILP (dl)) + break; + + /* A file is still pending. Assume it was a write. */ + entry = XCAR (dl); + kqueue_generate_event + (watch_object, Fcons (Qwrite, Qnil), XCAR (XCDR (entry)), Qnil); + + dl = XCDR (dl); + pending_events = Fdelq (entry, pending_events); + } + + /* At this point, old_dl, new_dl and pending_events shall be empty. + Let's make a check for this (might be removed once the code is + stable). */ if (! NILP (old_dl)) report_file_error ("Old list not empty", old_dl); if (! NILP (new_dl)) report_file_error ("New list not empty", new_dl); + if (! NILP (pending_events)) + report_file_error ("Pending events not empty", new_dl); /* Replace old directory listing with the new one. */ XSETCDR (Fnthcdr (make_number (3), watch_object), @@ -456,7 +474,6 @@ void globals_of_kqueue (void) { watch_list = Qnil; - pending_events = Qnil; } void From 8eca1d457083c8b1f46f8addbc695a6119ffb9ad Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 20 Nov 2015 18:06:42 +0000 Subject: [PATCH 16/17] Rework file notifications, kqueue has problems with directory monitors * lisp/filenotify.el (file-notify-add-watch): Call the native add-watch function on the file, not on the dir. * src/kqueue.c (kqueue_compare_dir_list): Make also bookkeeping about already deleted entries. * test/automated/auto-revert-tests.el (auto-revert-test01-auto-revert-several-files): Do not call "cp -f" since this deletes the target file first. * test/automated/file-notify-tests.el (file-notify--test-event-test): Make stronger checks. (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-test06-many-events): Ler rename work in both directions. --- lisp/filenotify.el | 6 +- src/kqueue.c | 48 +++-- test/automated/auto-revert-tests.el | 2 +- test/automated/file-notify-tests.el | 295 ++++++++++++++++------------ 4 files changed, 203 insertions(+), 148 deletions(-) diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 5072bf414bf..0d7a2b914c6 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -236,7 +236,7 @@ EVENT is the cadr of the event in `file-notify-handle-event' (setq pending-event nil)) ;; Check for stopped. - ;;(message "file-notify-callback %S %S" file registered) + ;;(message "file-notify-callback %S %S %S" file file1 registered) (setq stopped (or @@ -342,7 +342,7 @@ FILE is the name of the file whose event is being reported." ;; A file name handler could exist even if there is no local ;; file notification support. (setq desc (funcall - handler 'file-notify-add-watch dir flags callback)) + handler 'file-notify-add-watch file flags callback)) ;; Check, whether Emacs has been compiled with file notification ;; support. @@ -379,7 +379,7 @@ FILE is the name of the file whose event is being reported." l-flags))) ;; Call low-level function. - (setq desc (funcall func dir l-flags 'file-notify-callback))) + (setq desc (funcall func file l-flags 'file-notify-callback))) ;; Modify `file-notify-descriptors'. (setq file (unless (file-directory-p file) (file-name-nondirectory file)) diff --git a/src/kqueue.c b/src/kqueue.c index ca0e3e7e1ca..1830040637e 100644 --- a/src/kqueue.c +++ b/src/kqueue.c @@ -111,11 +111,12 @@ static void kqueue_compare_dir_list (Lisp_Object watch_object) { - Lisp_Object dir, pending_events; + Lisp_Object dir, pending_dl, deleted_dl; Lisp_Object old_directory_files, old_dl, new_directory_files, new_dl, dl; dir = XCAR (XCDR (watch_object)); - pending_events = Qnil; + pending_dl = Qnil; + deleted_dl = Qnil; old_directory_files = Fnth (make_number (4), watch_object); old_dl = kqueue_directory_listing (old_directory_files); @@ -168,6 +169,7 @@ kqueue_compare_dir_list kqueue_generate_event (watch_object, Fcons (Qrename, Qnil), XCAR (XCDR (old_entry)), XCAR (XCDR (new_entry))); + deleted_dl = Fcons (new_entry, deleted_dl); } new_dl = Fdelq (new_entry, new_dl); goto the_end; @@ -179,24 +181,35 @@ kqueue_compare_dir_list new_entry = XCAR (dl1); if (strcmp (SSDATA (XCAR (XCDR (old_entry))), SSDATA (XCAR (XCDR (new_entry)))) == 0) { - pending_events = Fcons (new_entry, pending_events); + pending_dl = Fcons (new_entry, pending_dl); new_dl = Fdelq (new_entry, new_dl); goto the_end; } } - new_entry = assq_no_quit (XCAR (old_entry), pending_events); - if (NILP (new_entry)) + /* Check, whether this a pending file. */ + new_entry = assq_no_quit (XCAR (old_entry), pending_dl); + + if (NILP (new_entry)) { + /* Check, whether this is an already deleted file (by rename). */ + for (dl1 = deleted_dl; ! NILP (dl1); dl1 = XCDR (dl1)) { + new_entry = XCAR (dl1); + if (strcmp (SSDATA (XCAR (XCDR (old_entry))), + SSDATA (XCAR (XCDR (new_entry)))) == 0) { + deleted_dl = Fdelq (new_entry, deleted_dl); + goto the_end; + } + } /* The file has been deleted. */ kqueue_generate_event (watch_object, Fcons (Qdelete, Qnil), XCAR (XCDR (old_entry)), Qnil); - else { + + } else { /* The file has been renamed. */ kqueue_generate_event (watch_object, Fcons (Qrename, Qnil), XCAR (XCDR (old_entry)), XCAR (XCDR (new_entry))); - new_dl = Fdelq (new_entry, new_dl); - pending_events = Fdelq (new_entry, pending_events); + pending_dl = Fdelq (new_entry, pending_dl); } the_end: @@ -226,8 +239,8 @@ kqueue_compare_dir_list new_dl = Fdelq (entry, new_dl); } - /* Parse through the resulting pending_events_list. */ - dl = pending_events; + /* Parse through the resulting pending_dl list. */ + dl = pending_dl; while (1) { Lisp_Object entry; if (NILP (dl)) @@ -239,18 +252,21 @@ kqueue_compare_dir_list (watch_object, Fcons (Qwrite, Qnil), XCAR (XCDR (entry)), Qnil); dl = XCDR (dl); - pending_events = Fdelq (entry, pending_events); + pending_dl = Fdelq (entry, pending_dl); } - /* At this point, old_dl, new_dl and pending_events shall be empty. - Let's make a check for this (might be removed once the code is - stable). */ + /* At this point, old_dl, new_dl and pending_dl shall be empty. + deleted_dl might not be empty when there was a rename to a + nonexisting file. Let's make a check for this (might be removed + once the code is stable). */ if (! NILP (old_dl)) report_file_error ("Old list not empty", old_dl); if (! NILP (new_dl)) report_file_error ("New list not empty", new_dl); - if (! NILP (pending_events)) - report_file_error ("Pending events not empty", new_dl); + if (! NILP (pending_dl)) + report_file_error ("Pending events list not empty", pending_dl); + // if (! NILP (deleted_dl)) + // report_file_error ("Deleted events list not empty", deleted_dl); /* Replace old directory listing with the new one. */ XSETCDR (Fnthcdr (make_number (3), watch_object), 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 @@ ;; Strange, that `copy-directory' does not work as expected. ;; The following shell command is not portable on all ;; platforms, unfortunately. - (shell-command (format "%s -f %s/* %s" cp tmpdir2 tmpdir1)) + (shell-command (format "%s %s/* %s" cp tmpdir2 tmpdir1)) ;; Check, that the buffers have been reverted. (dolist (buf (list buf1 buf2)) diff --git a/test/automated/file-notify-tests.el b/test/automated/file-notify-tests.el index 81fb42e13b1..7bacddd8855 100644 --- a/test/automated/file-notify-tests.el +++ b/test/automated/file-notify-tests.el @@ -196,12 +196,13 @@ remote host, or nil." (file-notify-add-watch temporary-file-directory '(change attribute-change) 'ignore))) (file-notify-rm-watch file-notify--test-desc) - ;; The file does not need to exist, just the upper directory. + (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) (should (setq file-notify--test-desc (file-notify-add-watch file-notify--test-tmpfile '(change attribute-change) 'ignore))) (file-notify-rm-watch file-notify--test-desc) + (delete-file file-notify--test-tmpfile) ;; Check error handling. (should-error (file-notify-add-watch 1 2 3 4) @@ -242,16 +243,17 @@ is bound somewhere." (should (or (string-equal (file-notify--event-file-name file-notify--test-event) file-notify--test-tmpfile) - (string-equal (directory-file-name - (file-name-directory - (file-notify--event-file-name file-notify--test-event))) - file-notify--test-tmpfile))) + (string-equal (file-notify--event-file-name file-notify--test-event) + file-notify--test-tmpfile1) + (string-equal (file-notify--event-file-name file-notify--test-event) + temporary-file-directory))) ;; Check the second file name if exists. (when (eq (nth 1 file-notify--test-event) 'renamed) (should - (string-equal - (file-notify--event-file1-name file-notify--test-event) - file-notify--test-tmpfile1)))) + (or (string-equal (file-notify--event-file1-name file-notify--test-event) + file-notify--test-tmpfile1) + (string-equal (file-notify--event-file1-name file-notify--test-event) + temporary-file-directory))))) (defun file-notify--test-event-handler (event) "Run a test over FILE-NOTIFY--TEST-EVENT. @@ -306,103 +308,111 @@ Don't wait longer than timeout seconds for the events to be delivered." ;; Under cygwin there are so bad timings that it doesn't make sense to test. (skip-unless (not (eq system-type 'cygwin))) - (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) - file-notify--test-tmpfile1 (file-notify--test-make-temp-name)) - (unwind-protect (progn - ;; Check creation, change and deletion. - (setq file-notify--test-desc - (file-notify-add-watch - file-notify--test-tmpfile - '(change) 'file-notify--test-event-handler)) - (file-notify--test-with-events '(created changed deleted) + ;; Check file change and deletion. + (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)) + (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) + (should + (setq file-notify--test-desc + (file-notify-add-watch + file-notify--test-tmpfile + '(change) 'file-notify--test-event-handler))) + (file-notify--test-with-events '(changed deleted) (write-region - "any text" nil file-notify--test-tmpfile nil 'no-message) - (read-event nil nil 0.1) + "another text" nil file-notify--test-tmpfile nil 'no-message) (delete-file file-notify--test-tmpfile)) ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. (let (file-notify--test-events) (file-notify-rm-watch file-notify--test-desc)) - ;; Check creation, change and deletion. There must be a - ;; `stopped' event when deleting the directory. It doesn't - ;; work for w32notify. + ;; Check file creation, change and deletion when watching a + ;; directory. There must be a `stopped' event when deleting + ;; the directory. It doesn't work for w32notify. (unless (string-equal (file-notify--test-library) "w32notify") - (make-directory file-notify--test-tmpfile) - (setq file-notify--test-desc - (file-notify-add-watch - file-notify--test-tmpfile - '(change) 'file-notify--test-event-handler)) + (let ((temporary-file-directory + (make-temp-file "file-notify-test-parent" t))) + (should + (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) + file-notify--test-desc + (file-notify-add-watch + temporary-file-directory + '(change) 'file-notify--test-event-handler))) + (file-notify--test-with-events + ;; There are two `deleted' events, for the file and + ;; for the directory. Except for kqueue. + (if (string-equal (file-notify--test-library) "kqueue") + '(created changed deleted stopped) + '(created changed deleted deleted stopped)) + (write-region + "any text" nil file-notify--test-tmpfile nil 'no-message) + (read-event nil nil 0.1) + (delete-directory temporary-file-directory 'recursive)) + ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. + (let (file-notify--test-events) + (file-notify-rm-watch file-notify--test-desc)))) + + ;; Check copy of files inside a directory. + (let ((temporary-file-directory + (make-temp-file "file-notify-test-parent" t))) + (should + (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) + file-notify--test-tmpfile1 (file-notify--test-make-temp-name) + file-notify--test-desc + (file-notify-add-watch + temporary-file-directory + '(change) 'file-notify--test-event-handler))) (file-notify--test-with-events - ;; There are two `deleted' events, for the file and for - ;; the directory. Except for kqueue. - (if (string-equal (file-notify--test-library) "kqueue") - '(created changed deleted stopped) - '(created changed deleted deleted stopped)) + ;; w32notify does not distinguish between `changed' and + ;; `attribute-changed'. + (if (string-equal (file-notify--test-library) "w32notify") + '(created changed changed deleted) + '(created changed created changed deleted stopped)) (write-region - "any text" nil (expand-file-name "foo" file-notify--test-tmpfile) - nil 'no-message) + "any text" nil file-notify--test-tmpfile nil 'no-message) (read-event nil nil 0.1) - (delete-directory file-notify--test-tmpfile 'recursive)) + (copy-file file-notify--test-tmpfile file-notify--test-tmpfile1) + ;; The next two events shall not be visible. + (read-event nil nil 0.1) + (set-file-modes file-notify--test-tmpfile 000) + (read-event nil nil 0.1) + (set-file-times file-notify--test-tmpfile '(0 0)) + (read-event nil nil 0.1) + (delete-directory temporary-file-directory 'recursive)) ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. (let (file-notify--test-events) (file-notify-rm-watch file-notify--test-desc))) - ;; Check copy. - (setq file-notify--test-desc - (file-notify-add-watch - file-notify--test-tmpfile - '(change) 'file-notify--test-event-handler)) - (should file-notify--test-desc) - (file-notify--test-with-events - ;; w32notify does not distinguish between `changed' and - ;; `attribute-changed'. - (if (string-equal (file-notify--test-library) "w32notify") - '(created changed changed deleted) - '(created changed deleted)) - (write-region - "any text" nil file-notify--test-tmpfile nil 'no-message) - (read-event nil nil 0.1) - (copy-file file-notify--test-tmpfile file-notify--test-tmpfile1) - ;; The next two events shall not be visible. - (read-event nil nil 0.1) - (set-file-modes file-notify--test-tmpfile 000) - (read-event nil nil 0.1) - (set-file-times file-notify--test-tmpfile '(0 0)) - (read-event nil nil 0.1) - (delete-file file-notify--test-tmpfile) - (read-event nil nil 0.1) - (delete-file file-notify--test-tmpfile1)) - ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. - (let (file-notify--test-events) - (file-notify-rm-watch file-notify--test-desc)) - - ;; Check rename. - (setq file-notify--test-desc - (file-notify-add-watch - file-notify--test-tmpfile - '(change) 'file-notify--test-event-handler)) - (should file-notify--test-desc) - (file-notify--test-with-events '(created changed renamed) - (write-region - "any text" nil file-notify--test-tmpfile nil 'no-message) - (read-event nil nil 0.1) - (rename-file file-notify--test-tmpfile file-notify--test-tmpfile1) - ;; After the rename, we won't get events anymore. - (read-event nil nil 0.1) - (delete-file file-notify--test-tmpfile1)) - ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. - (let (file-notify--test-events) - (file-notify-rm-watch file-notify--test-desc)) + ;; Check rename of files inside a directory. + (let ((temporary-file-directory + (make-temp-file "file-notify-test-parent" t))) + (should + (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) + file-notify--test-tmpfile1 (file-notify--test-make-temp-name) + file-notify--test-desc + (file-notify-add-watch + temporary-file-directory + '(change) 'file-notify--test-event-handler))) + (file-notify--test-with-events '(created changed renamed) + (write-region + "any text" nil file-notify--test-tmpfile nil 'no-message) + (read-event nil nil 0.1) + (rename-file file-notify--test-tmpfile file-notify--test-tmpfile1) + ;; After the rename, we won't get events anymore. + (read-event nil nil 0.1) + (delete-directory temporary-file-directory 'recursive)) + ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. + (let (file-notify--test-events) + (file-notify-rm-watch file-notify--test-desc))) ;; Check attribute change. It doesn't work for kqueue and w32notify. (unless (or (string-equal (file-notify--test-library) "kqueue") (string-equal (file-notify--test-library) "w32notify")) - (setq file-notify--test-desc - (file-notify-add-watch - file-notify--test-tmpfile - '(attribute-change) 'file-notify--test-event-handler)) + (should + (setq file-notify--test-desc + (file-notify-add-watch + file-notify--test-tmpfile + '(attribute-change) 'file-notify--test-event-handler))) (file-notify--test-with-events (if (file-remote-p temporary-file-directory) ;; In the remote case, `write-region' raises also an @@ -533,23 +543,41 @@ Don't wait longer than timeout seconds for the events to be delivered." (unwind-protect (progn - (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) - file-notify--test-desc - (file-notify-add-watch - file-notify--test-tmpfile - '(change) #'file-notify--test-event-handler)) - (file-notify--test-with-events '(created changed deleted) + (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)) + (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) + (should + (setq file-notify--test-desc + (file-notify-add-watch + file-notify--test-tmpfile + '(change) #'file-notify--test-event-handler))) + (should (file-notify-valid-p file-notify--test-desc)) + ;; After calling `file-notify-rm-watch', the descriptor is not + ;; valid anymore. + (file-notify-rm-watch file-notify--test-desc) + (should-not (file-notify-valid-p file-notify--test-desc)) + (delete-file file-notify--test-tmpfile)) + + ;; Cleanup. + (file-notify--test-cleanup)) + + (unwind-protect + (progn + (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)) + (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) + (should + (setq file-notify--test-desc + (file-notify-add-watch + file-notify--test-tmpfile + '(change) #'file-notify--test-event-handler))) + (file-notify--test-with-events '(changed deleted) (should (file-notify-valid-p file-notify--test-desc)) (write-region - "any text" nil file-notify--test-tmpfile nil 'no-message) + "another text" nil file-notify--test-tmpfile nil 'no-message) (read-event nil nil 0.1) (delete-file file-notify--test-tmpfile)) - ;; After deleting the file, the descriptor is still valid. - (should (file-notify-valid-p file-notify--test-desc)) - ;; After removing the watch, the descriptor must not be valid - ;; anymore. - (file-notify-rm-watch file-notify--test-desc) - (should-not (file-notify-valid-p file-notify--test-desc))) + ;; After deleting the file, the descriptor is not valid anymore. + (should-not (file-notify-valid-p file-notify--test-desc)) + (file-notify-rm-watch file-notify--test-desc)) ;; Cleanup. (file-notify--test-cleanup)) @@ -560,11 +588,12 @@ Don't wait longer than timeout seconds for the events to be delivered." (unless (string-equal (file-notify--test-library) "w32notify") (let ((temporary-file-directory (make-temp-file "file-notify-test-parent" t))) - (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) - file-notify--test-desc - (file-notify-add-watch - file-notify--test-tmpfile - '(change) #'file-notify--test-event-handler)) + (should + (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) + file-notify--test-desc + (file-notify-add-watch + temporary-file-directory + '(change) #'file-notify--test-event-handler))) (file-notify--test-with-events ;; There are two `deleted' events, for the file and for ;; the directory. Except for kqueue. @@ -595,10 +624,11 @@ Don't wait longer than timeout seconds for the events to be delivered." (setq file-notify--test-tmpfile (file-name-as-directory (file-notify--test-make-temp-name))) (make-directory file-notify--test-tmpfile) - (setq file-notify--test-desc - (file-notify-add-watch - file-notify--test-tmpfile - '(change) #'file-notify--test-event-handler)) + (should + (setq file-notify--test-desc + (file-notify-add-watch + file-notify--test-tmpfile + '(change) #'file-notify--test-event-handler))) (should (file-notify-valid-p file-notify--test-desc)) ;; After removing the watch, the descriptor must not be valid ;; anymore. @@ -619,10 +649,11 @@ Don't wait longer than timeout seconds for the events to be delivered." (setq file-notify--test-tmpfile (file-name-as-directory (file-notify--test-make-temp-name))) (make-directory file-notify--test-tmpfile) - (setq file-notify--test-desc - (file-notify-add-watch - file-notify--test-tmpfile - '(change) #'file-notify--test-event-handler)) + (should + (setq file-notify--test-desc + (file-notify-add-watch + file-notify--test-tmpfile + '(change) #'file-notify--test-event-handler))) (should (file-notify-valid-p file-notify--test-desc)) ;; After deleting the directory, the descriptor must not be ;; valid anymore. @@ -645,31 +676,39 @@ Don't wait longer than timeout seconds for the events to be delivered." (skip-unless (not (eq system-type 'cygwin))) (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)) (make-directory file-notify--test-tmpfile) - (setq file-notify--test-desc - (file-notify-add-watch - file-notify--test-tmpfile - '(change) 'file-notify--test-event-handler)) + (should + (setq file-notify--test-desc + (file-notify-add-watch + file-notify--test-tmpfile + '(change) 'file-notify--test-event-handler))) (unwind-protect (let ((n 1000) - x-file-list y-file-list + source-file-list target-file-list (default-directory file-notify--test-tmpfile)) (dotimes (i n) - (push (expand-file-name (format "x%d" i)) x-file-list) - (push (expand-file-name (format "y%d" i)) y-file-list)) + ;; It matters which direction we rename, at least for + ;; kqueue. This backend parses directories in alphabetic + ;; order (x%d before y%d). So we rename both directions. + (if (zerop (mod i 2)) + (progn + (push (expand-file-name (format "x%d" i)) source-file-list) + (push (expand-file-name (format "y%d" i)) target-file-list)) + (push (expand-file-name (format "y%d" i)) source-file-list) + (push (expand-file-name (format "x%d" i)) target-file-list))) (file-notify--test-with-events (make-list (+ n n) 'created) - (let ((x-file-list x-file-list) - (y-file-list y-file-list)) - (while (and x-file-list y-file-list) - (write-region "" nil (pop x-file-list) nil 'no-message) + (let ((source-file-list source-file-list) + (target-file-list target-file-list)) + (while (and source-file-list target-file-list) + (write-region "" nil (pop source-file-list) nil 'no-message) (read-event nil nil 0.1) - (write-region "" nil (pop y-file-list) nil 'no-message)))) + (write-region "" nil (pop target-file-list) nil 'no-message)))) (file-notify--test-with-events (make-list n 'renamed) - (let ((x-file-list x-file-list) - (y-file-list y-file-list)) - (while (and x-file-list y-file-list) - (rename-file (pop x-file-list) (pop y-file-list) t)))) + (let ((source-file-list source-file-list) + (target-file-list target-file-list)) + (while (and source-file-list target-file-list) + (rename-file (pop source-file-list) (pop target-file-list) t)))) (file-notify--test-with-events (make-list n 'deleted) - (dolist (file y-file-list) + (dolist (file target-file-list) (delete-file file)))) (file-notify--test-cleanup))) From 15e7544bc4a5b38d7e2c28043b3b70eaef1ea5f5 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 25 Nov 2015 15:00:06 +0100 Subject: [PATCH 17/17] Some final fixes in file notification before merging with master * lisp/filenotify.el (file-notify--rm-descriptor): Remove WHAT arg. (file-notify-callback): Improve check for `stopped' event. Call `file-notify-rm-watch' rather than `file-notify--rm-descriptor'. (file-notify-add-watch): In case FILE is not a directory, call the file monitor for the kqueue backend. Otherwise, call the directory monitor for the upper directory. * 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. * test/automated/file-notify-tests.el (file-notify--test-timeout): Use different timeouts for different libraries. (file-notify--test-with-events): Suppress lock files. Flush outstanding events before running the body. (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): Rename into both directions. --- lisp/filenotify.el | 36 ++-- src/inotify.c | 9 +- test/automated/file-notify-tests.el | 308 +++++++++++++++++++--------- 3 files changed, 239 insertions(+), 114 deletions(-) diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 0d7a2b914c6..b6c1f686fe1 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -49,17 +49,16 @@ handler. The value in the hash table is a list Several values for a given DIR happen only for `inotify', when different files from the same directory are watched.") -(defun file-notify--rm-descriptor (descriptor &optional what) +(defun file-notify--rm-descriptor (descriptor) "Remove DESCRIPTOR from `file-notify-descriptors'. DESCRIPTOR should be an object returned by `file-notify-add-watch'. -If it is registered in `file-notify-descriptors', a stopped event is sent. -WHAT is a file or directory name to be removed, needed just for `inotify'." +If it is registered in `file-notify-descriptors', a stopped event is sent." (let* ((desc (if (consp descriptor) (car descriptor) descriptor)) (file (if (consp descriptor) (cdr descriptor))) (registered (gethash desc file-notify-descriptors)) (dir (car registered))) - (when (and (consp registered) (or (null what) (string-equal dir what))) + (when (consp registered) ;; Send `stopped' event. (dolist (entry (cdr registered)) (funcall (cdr entry) @@ -236,7 +235,6 @@ EVENT is the cadr of the event in `file-notify-handle-event' (setq pending-event nil)) ;; Check for stopped. - ;;(message "file-notify-callback %S %S %S" file file1 registered) (setq stopped (or @@ -244,10 +242,13 @@ EVENT is the cadr of the event in `file-notify-handle-event' (and (memq action '(deleted renamed)) (= (length (cdr registered)) 1) - (string-equal - (file-name-nondirectory file) - (or (file-name-nondirectory (car registered)) - (car (cadr registered))))))) + (or + (string-equal + (file-name-nondirectory file) + (file-name-nondirectory (car registered))) + (string-equal + (file-name-nondirectory file) + (car (cadr registered))))))) ;; Apply callback. (when (and action @@ -266,6 +267,9 @@ EVENT is the cadr of the event in `file-notify-handle-event' (and (stringp file1) (string-equal (nth 0 entry) (file-name-nondirectory file1))))) + ;;(message + ;;"file-notify-callback %S %S %S %S %S" + ;;(file-notify--descriptor desc file) action file file1 registered) (if file1 (funcall callback @@ -276,8 +280,7 @@ EVENT is the cadr of the event in `file-notify-handle-event' ;; Modify `file-notify-descriptors'. (when stopped - (file-notify--rm-descriptor - (file-notify--descriptor desc file) file))))) + (file-notify-rm-watch (file-notify--descriptor desc file)))))) ;; `kqueue', `gfilenotify' and `w32notify' return a unique descriptor ;; for every `file-notify-add-watch', while `inotify' returns a unique @@ -342,7 +345,12 @@ FILE is the name of the file whose event is being reported." ;; A file name handler could exist even if there is no local ;; file notification support. (setq desc (funcall - handler 'file-notify-add-watch file flags callback)) + handler 'file-notify-add-watch + ;; kqueue does not report file changes in + ;; directory monitor. So we must watch the file + ;; itself. + (if (eq file-notify--library 'kqueue) file dir) + flags callback)) ;; Check, whether Emacs has been compiled with file notification ;; support. @@ -379,7 +387,9 @@ FILE is the name of the file whose event is being reported." l-flags))) ;; Call low-level function. - (setq desc (funcall func file l-flags 'file-notify-callback))) + (setq desc (funcall + func (if (eq file-notify--library 'kqueue) file dir) + l-flags 'file-notify-callback))) ;; Modify `file-notify-descriptors'. (setq file (unless (file-directory-p file) (file-name-nondirectory file)) 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 . */ static int inotifyfd = -1; /* Assoc list of files being watched. - Format: - (watch-descriptor . callback) + Format: (watch-descriptor name callback) */ static Lisp_Object watch_list; @@ -106,12 +105,14 @@ inotifyevent_to_event (Lisp_Object watch_object, struct inotify_event const *ev) name = make_unibyte_string (ev->name, min (len, ev->len)); name = DECODE_FILE (name); } + else + name = XCAR (XCDR (watch_object)); return list2 (list4 (make_watch_descriptor (ev->wd), mask_to_aspects (ev->mask), name, make_number (ev->cookie)), - XCDR (watch_object)); + Fnth (make_number (2), watch_object)); } /* 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 watch_list = Fdelete (watch_object, watch_list); /* Store watch object in watch list. */ - watch_object = Fcons (watch_descriptor, callback); + watch_object = list3 (watch_descriptor, encoded_file_name, callback); watch_list = Fcons (watch_object, watch_list); return watch_descriptor; diff --git a/test/automated/file-notify-tests.el b/test/automated/file-notify-tests.el index 7bacddd8855..b665dddb631 100644 --- a/test/automated/file-notify-tests.el +++ b/test/automated/file-notify-tests.el @@ -65,7 +65,11 @@ (defun file-notify--test-timeout () "Timeout to wait for arriving events, in seconds." - (if (file-remote-p temporary-file-directory) 6 3)) + (cond + ((file-remote-p temporary-file-directory) 6) + ((string-equal (file-notify--test-library) "w32notify") 20) + ((eq system-type 'cygwin) 10) + (t 3))) (defun file-notify--test-cleanup () "Cleanup after a test." @@ -262,7 +266,7 @@ and the event to `file-notify--test-events'." (let* ((file-notify--test-event event) (result (ert-run-test (make-ert-test :body 'file-notify--test-event-test)))) - ;; Do not add temporary files, this would confuse the checks. + ;; Do not add lock files, this would confuse the checks. (unless (string-match (regexp-quote ".#") (file-notify--event-file-name file-notify--test-event)) @@ -289,9 +293,14 @@ TIMEOUT is the maximum time to wait for, in seconds." Don't wait longer than timeout seconds for the events to be delivered." (declare (indent 1)) (let ((outer (make-symbol "outer"))) - `(let ((,outer file-notify--test-events)) + `(let ((,outer file-notify--test-events) + create-lockfiles) (setq file-notify--test-expected-events (append file-notify--test-expected-events ,events)) + ;; Flush pending events. + (file-notify--wait-for-events + (file-notify--test-timeout) + (input-pending-p)) (let (file-notify--test-events) ,@body (file-notify--wait-for-events @@ -305,11 +314,34 @@ Don't wait longer than timeout seconds for the events to be delivered." (ert-deftest file-notify-test02-events () "Check file creation/change/removal notifications." (skip-unless (file-notify--test-local-enabled)) - ;; Under cygwin there are so bad timings that it doesn't make sense to test. - (skip-unless (not (eq system-type 'cygwin))) (unwind-protect (progn + ;; Check file creation, change and deletion. It doesn't work + ;; for cygwin and kqueue, because we don't use an implicit + ;; directory monitor (kqueue), or the timings are too bad (cygwin). + (unless (or (eq system-type 'cygwin) + (string-equal (file-notify--test-library) "kqueue")) + (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)) + (should + (setq file-notify--test-desc + (file-notify-add-watch + file-notify--test-tmpfile + '(change) 'file-notify--test-event-handler))) + (file-notify--test-with-events + (cond + ;; cygwin recognizes only `deleted' and `stopped' events. + ((eq system-type 'cygwin) + '(deleted stopped)) + (t '(created changed deleted stopped))) + (write-region + "another text" nil file-notify--test-tmpfile nil 'no-message) + (read-event nil nil 0.1) + (delete-file file-notify--test-tmpfile)) + ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. + (let (file-notify--test-events) + (file-notify-rm-watch file-notify--test-desc))) + ;; Check file change and deletion. (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) @@ -318,9 +350,23 @@ Don't wait longer than timeout seconds for the events to be delivered." (file-notify-add-watch file-notify--test-tmpfile '(change) 'file-notify--test-event-handler))) - (file-notify--test-with-events '(changed deleted) + (file-notify--test-with-events + (cond + ;; cygwin recognizes only `deleted' and `stopped' events. + ((eq system-type 'cygwin) + '(deleted stopped)) + ;; inotify, kqueueg and gfilenotify raise just one + ;; `changed' event, the other backends show us two of + ;; them. + ((or (string-equal "inotify" (file-notify--test-library)) + (string-equal "kqueue" (file-notify--test-library)) + (string-equal "gfilenotify" (file-notify--test-library))) + '(changed deleted stopped)) + (t '(changed changed deleted stopped))) + (read-event nil nil 0.1) (write-region "another text" nil file-notify--test-tmpfile nil 'no-message) + (read-event nil nil 0.1) (delete-file file-notify--test-tmpfile)) ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. (let (file-notify--test-events) @@ -328,29 +374,37 @@ Don't wait longer than timeout seconds for the events to be delivered." ;; Check file creation, change and deletion when watching a ;; directory. There must be a `stopped' event when deleting - ;; the directory. It doesn't work for w32notify. - (unless (string-equal (file-notify--test-library) "w32notify") - (let ((temporary-file-directory - (make-temp-file "file-notify-test-parent" t))) - (should - (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) - file-notify--test-desc - (file-notify-add-watch - temporary-file-directory - '(change) 'file-notify--test-event-handler))) - (file-notify--test-with-events - ;; There are two `deleted' events, for the file and - ;; for the directory. Except for kqueue. - (if (string-equal (file-notify--test-library) "kqueue") - '(created changed deleted stopped) - '(created changed deleted deleted stopped)) - (write-region - "any text" nil file-notify--test-tmpfile nil 'no-message) - (read-event nil nil 0.1) - (delete-directory temporary-file-directory 'recursive)) - ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. - (let (file-notify--test-events) - (file-notify-rm-watch file-notify--test-desc)))) + ;; the directory. + (let ((temporary-file-directory + (make-temp-file "file-notify-test-parent" t))) + (should + (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) + file-notify--test-desc + (file-notify-add-watch + temporary-file-directory + '(change) 'file-notify--test-event-handler))) + (file-notify--test-with-events + (cond + ;; w32notify does raise a `stopped' event when a + ;; watched directory is deleted. + ((string-equal (file-notify--test-library) "w32notify") + '(created changed deleted)) + ;; cygwin recognizes only `deleted' and `stopped' events. + ((eq system-type 'cygwin) + '(deleted stopped)) + ;; There are two `deleted' events, for the file and for + ;; the directory. Except for kqueue. + ((string-equal (file-notify--test-library) "kqueue") + '(created changed deleted stopped)) + (t '(created changed deleted deleted stopped))) + (read-event nil nil 0.1) + (write-region + "any text" nil file-notify--test-tmpfile nil 'no-message) + (read-event nil nil 0.1) + (delete-directory temporary-file-directory 'recursive)) + ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. + (let (file-notify--test-events) + (file-notify-rm-watch file-notify--test-desc))) ;; Check copy of files inside a directory. (let ((temporary-file-directory @@ -363,11 +417,22 @@ Don't wait longer than timeout seconds for the events to be delivered." temporary-file-directory '(change) 'file-notify--test-event-handler))) (file-notify--test-with-events - ;; w32notify does not distinguish between `changed' and - ;; `attribute-changed'. - (if (string-equal (file-notify--test-library) "w32notify") - '(created changed changed deleted) + (cond + ;; w32notify does not distinguish between `changed' and + ;; `attribute-changed'. + ((string-equal (file-notify--test-library) "w32notify") + '(created changed created changed changed changed changed + deleted deleted)) + ;; cygwin recognizes only `deleted' and `stopped' events. + ((eq system-type 'cygwin) + '(deleted stopped)) + ;; There are three `deleted' events, for two files and + ;; for the directory. Except for kqueue. + ((string-equal (file-notify--test-library) "kqueue") '(created changed created changed deleted stopped)) + (t '(created changed created changed + deleted deleted deleted stopped))) + (read-event nil nil 0.1) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) (read-event nil nil 0.1) @@ -393,7 +458,21 @@ Don't wait longer than timeout seconds for the events to be delivered." (file-notify-add-watch temporary-file-directory '(change) 'file-notify--test-event-handler))) - (file-notify--test-with-events '(created changed renamed) + (file-notify--test-with-events + (cond + ;; w32notify does not distinguish between `changed' and + ;; `attribute-changed'. + ((string-equal (file-notify--test-library) "w32notify") + '(created changed renamed deleted)) + ;; cygwin recognizes only `deleted' and `stopped' events. + ((eq system-type 'cygwin) + '(deleted stopped)) + ;; There are two `deleted' events, for the file and for + ;; the directory. Except for kqueue. + ((string-equal (file-notify--test-library) "kqueue") + '(created changed renamed deleted stopped)) + (t '(created changed renamed deleted deleted stopped))) + (read-event nil nil 0.1) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) (read-event nil nil 0.1) @@ -405,30 +484,37 @@ Don't wait longer than timeout seconds for the events to be delivered." (let (file-notify--test-events) (file-notify-rm-watch file-notify--test-desc))) - ;; Check attribute change. It doesn't work for kqueue and w32notify. - (unless (or (string-equal (file-notify--test-library) "kqueue") - (string-equal (file-notify--test-library) "w32notify")) + ;; Check attribute change. Does not work for cygwin. + (unless (eq system-type 'cygwin) + (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)) + (write-region + "any text" nil file-notify--test-tmpfile nil 'no-message) (should (setq file-notify--test-desc (file-notify-add-watch file-notify--test-tmpfile '(attribute-change) 'file-notify--test-event-handler))) - (file-notify--test-with-events - (if (file-remote-p temporary-file-directory) - ;; In the remote case, `write-region' raises also an - ;; `attribute-changed' event. - '(attribute-changed attribute-changed attribute-changed) - '(attribute-changed attribute-changed)) - ;; We must use short delays between the operations. - ;; Otherwise, not all events arrive us in the remote case. - (write-region - "any text" nil file-notify--test-tmpfile nil 'no-message) - (read-event nil nil 0.1) - (set-file-modes file-notify--test-tmpfile 000) - (read-event nil nil 0.1) - (set-file-times file-notify--test-tmpfile '(0 0)) - (read-event nil nil 0.1) - (delete-file file-notify--test-tmpfile)) + (file-notify--test-with-events + (cond + ;; w32notify does not distinguish between `changed' and + ;; `attribute-changed'. + ((string-equal (file-notify--test-library) "w32notify") + '(changed changed changed changed)) + ;; For kqueue and in the remote case, `write-region' + ;; raises also an `attribute-changed' event. + ((or (string-equal (file-notify--test-library) "kqueue") + (file-remote-p temporary-file-directory)) + '(attribute-changed attribute-changed attribute-changed)) + (t '(attribute-changed attribute-changed))) + (read-event nil nil 0.1) + (write-region + "any text" nil file-notify--test-tmpfile nil 'no-message) + (read-event nil nil 0.1) + (set-file-modes file-notify--test-tmpfile 000) + (read-event nil nil 0.1) + (set-file-times file-notify--test-tmpfile '(0 0)) + (read-event nil nil 0.1) + (delete-file file-notify--test-tmpfile)) ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. (let (file-notify--test-events) (file-notify-rm-watch file-notify--test-desc))) @@ -504,28 +590,31 @@ Don't wait longer than timeout seconds for the events to be delivered." (should (string-match "another text" (buffer-string))) ;; Stop file notification. Autorevert shall still work via polling. - (file-notify-rm-watch auto-revert-notify-watch-descriptor) - (file-notify--wait-for-events - timeout (null auto-revert-use-notify)) - (should-not auto-revert-use-notify) - (should-not auto-revert-notify-watch-descriptor) - - ;; Modify file. We wait for two seconds, in order to have - ;; another timestamp. One second seems to be too short. - (with-current-buffer (get-buffer-create "*Messages*") - (narrow-to-region (point-max) (point-max))) - (sleep-for 2) - (write-region - "foo bla" nil file-notify--test-tmpfile nil 'no-message) - - ;; Check, that the buffer has been reverted. - (with-current-buffer (get-buffer-create "*Messages*") + ;; It doesn't work for `w32notify'. + (unless (string-equal (file-notify--test-library) "w32notify") + (file-notify-rm-watch auto-revert-notify-watch-descriptor) (file-notify--wait-for-events - timeout - (string-match - (format-message "Reverting buffer `%s'." (buffer-name buf)) - (buffer-string)))) - (should (string-match "foo bla" (buffer-string))))) + timeout (null auto-revert-use-notify)) + (should-not auto-revert-use-notify) + (should-not auto-revert-notify-watch-descriptor) + + ;; Modify file. We wait for two seconds, in order to + ;; have another timestamp. One second seems to be too + ;; short. + (with-current-buffer (get-buffer-create "*Messages*") + (narrow-to-region (point-max) (point-max))) + (sleep-for 2) + (write-region + "foo bla" nil file-notify--test-tmpfile nil 'no-message) + + ;; Check, that the buffer has been reverted. + (with-current-buffer (get-buffer-create "*Messages*") + (file-notify--wait-for-events + timeout + (string-match + (format-message "Reverting buffer `%s'." (buffer-name buf)) + (buffer-string)))) + (should (string-match "foo bla" (buffer-string)))))) ;; Cleanup. (with-current-buffer "*Messages*" (widen)) @@ -538,8 +627,6 @@ Don't wait longer than timeout seconds for the events to be delivered." (ert-deftest file-notify-test04-file-validity () "Check `file-notify-valid-p' for files." (skip-unless (file-notify--test-local-enabled)) - ;; Under cygwin there are so bad timings that it doesn't make sense to test. - (skip-unless (not (eq system-type 'cygwin))) (unwind-protect (progn @@ -569,7 +656,20 @@ Don't wait longer than timeout seconds for the events to be delivered." (file-notify-add-watch file-notify--test-tmpfile '(change) #'file-notify--test-event-handler))) - (file-notify--test-with-events '(changed deleted) + (file-notify--test-with-events + (cond + ;; cygwin recognizes only `deleted' and `stopped' events. + ((eq system-type 'cygwin) + '(deleted stopped)) + ;; inotify, kqueueg and gfilenotify raise just one + ;; `changed' event, the other backends show us two of + ;; them. + ((or (string-equal "inotify" (file-notify--test-library)) + (string-equal "kqueue" (file-notify--test-library)) + (string-equal "gfilenotify" (file-notify--test-library))) + '(changed deleted stopped)) + (t '(changed changed deleted stopped))) + (read-event nil nil 0.1) (should (file-notify-valid-p file-notify--test-desc)) (write-region "another text" nil file-notify--test-tmpfile nil 'no-message) @@ -583,10 +683,10 @@ Don't wait longer than timeout seconds for the events to be delivered." (file-notify--test-cleanup)) (unwind-protect - ;; The batch-mode operation of w32notify is fragile (there's no - ;; input threads to send the message to). + ;; w32notify does not send a `stopped' event when deleting a + ;; directory. The test does not work, therefore. (unless (string-equal (file-notify--test-library) "w32notify") - (let ((temporary-file-directory + (let ((temporary-file-directory (make-temp-file "file-notify-test-parent" t))) (should (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) @@ -594,20 +694,25 @@ Don't wait longer than timeout seconds for the events to be delivered." (file-notify-add-watch temporary-file-directory '(change) #'file-notify--test-event-handler))) - (file-notify--test-with-events - ;; There are two `deleted' events, for the file and for - ;; the directory. Except for kqueue. - (if (string-equal (file-notify--test-library) "kqueue") - '(created changed deleted stopped) - '(created changed deleted deleted stopped)) - (should (file-notify-valid-p file-notify--test-desc)) - (write-region - "any text" nil file-notify--test-tmpfile nil 'no-message) - (read-event nil nil 0.1) + (file-notify--test-with-events + (cond + ;; cygwin recognizes only `deleted' and `stopped' events. + ((eq system-type 'cygwin) + '(deleted stopped)) + ;; There are two `deleted' events, for the file and for + ;; the directory. Except for kqueue. + ((string-equal (file-notify--test-library) "kqueue") + '(created changed deleted stopped)) + (t '(created changed deleted deleted stopped))) + (should (file-notify-valid-p file-notify--test-desc)) + (read-event nil nil 0.1) + (write-region + "any text" nil file-notify--test-tmpfile nil 'no-message) + (read-event nil nil 0.1) (delete-directory temporary-file-directory t)) - ;; After deleting the parent directory, the descriptor must - ;; not be valid anymore. - (should-not (file-notify-valid-p file-notify--test-desc)))) + ;; After deleting the parent directory, the descriptor must + ;; not be valid anymore. + (should-not (file-notify-valid-p file-notify--test-desc)))) ;; Cleanup. (file-notify--test-cleanup))) @@ -659,7 +764,7 @@ Don't wait longer than timeout seconds for the events to be delivered." ;; valid anymore. (delete-directory file-notify--test-tmpfile t) (file-notify--wait-for-events - (file-notify--test-timeout) + (file-notify--test-timeout) (not (file-notify-valid-p file-notify--test-desc))) (should-not (file-notify-valid-p file-notify--test-desc))) @@ -672,8 +777,9 @@ Don't wait longer than timeout seconds for the events to be delivered." (ert-deftest file-notify-test06-many-events () "Check that events are not dropped." (skip-unless (file-notify--test-local-enabled)) - ;; Under cygwin there are so bad timings that it doesn't make sense to test. + ;; Under cygwin events arrive in random order. Impossible to define a test. (skip-unless (not (eq system-type 'cygwin))) + (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)) (make-directory file-notify--test-tmpfile) (should @@ -699,10 +805,18 @@ Don't wait longer than timeout seconds for the events to be delivered." (let ((source-file-list source-file-list) (target-file-list target-file-list)) (while (and source-file-list target-file-list) + (read-event nil nil 0.1) (write-region "" nil (pop source-file-list) nil 'no-message) (read-event nil nil 0.1) (write-region "" nil (pop target-file-list) nil 'no-message)))) - (file-notify--test-with-events (make-list n 'renamed) + (file-notify--test-with-events + (cond + ;; w32notify fires both `deleted' and `renamed' events. + ((string-equal (file-notify--test-library) "w32notify") + (let (r) + (dotimes (i n r) + (setq r (append '(deleted renamed) r))))) + (t (make-list n 'renamed))) (let ((source-file-list source-file-list) (target-file-list target-file-list)) (while (and source-file-list target-file-list) @@ -725,7 +839,7 @@ Don't wait longer than timeout seconds for the events to be delivered." ;; TODO: ;; * For w32notify, no stopped events arrive when a directory is removed. -;; * Try to handle arriving events under cygwin reliably. +;; * Check, why cygwin recognizes only `deleted' and `stopped' events. (provide 'file-notify-tests) ;;; file-notify-tests.el ends here