commit 82a8ad204909ee49cf6a8f2885590f0939d61e8d (HEAD, refs/remotes/origin/master) Author: Stefan Monnier Date: Wed Nov 25 17:03:27 2015 -0500 * lisp/emacs-lisp/eieio.el: Add some default implementations (standard-class): Mark it obsolete. (slot-missing): Give it a default implementation. (destructor): Simplify and mark it obsolete. (object-print): Give it a default implementation. (eieio-change-class): Rename from change-class. (change-class): Redefine as obsolete alias. diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index dcaaab6..c54cd22 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -756,9 +756,7 @@ Argument FN is the function calling this verifier." ;; The slot-missing method is a cool way of allowing an object author ;; to intercept missing slot definitions. Since it is also the LAST ;; thing called in this fn, its return value would be retrieved. - (slot-missing obj slot 'oref) - ;;(signal 'invalid-slot-name (list (eieio-object-name obj) slot)) - ) + (slot-missing obj slot 'oref)) (cl-check-type obj eieio-object) (eieio-barf-if-slot-unbound (aref obj c) obj slot 'oref)))) @@ -780,9 +778,7 @@ Fills in OBJ's SLOT with its default value." ;; Oref that slot. (aref (eieio--class-class-allocation-values cl) c) - (slot-missing obj slot 'oref-default) - ;;(signal 'invalid-slot-name (list (class-name cl) slot)) - ) + (slot-missing obj slot 'oref-default)) (eieio-barf-if-slot-unbound (let ((val (cl--slot-descriptor-initform (aref (eieio--class-slots cl) @@ -822,9 +818,7 @@ Fills in OBJ's SLOT with VALUE." (aset (eieio--class-class-allocation-values class) c value)) ;; See oref for comment on `slot-missing' - (slot-missing obj slot 'oset value) - ;;(signal 'invalid-slot-name (list (eieio-object-name obj) slot)) - ) + (slot-missing obj slot 'oset value)) (eieio--validate-slot-value class c value slot) (aset obj c value)))) diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 790e8bc..0ec07fe 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -678,7 +678,8 @@ This class is not stored in the `parent' slot of a class vector." (setq eieio-default-superclass (cl--find-class 'eieio-default-superclass)) -(defalias 'standard-class 'eieio-default-superclass) +(define-obsolete-function-alias 'standard-class + 'eieio-default-superclass "25.2") (cl-defgeneric make-instance (class &rest initargs) "Make a new instance of CLASS based on INITARGS. @@ -765,11 +766,7 @@ dynamically set from SLOTS." ;; Shared initialize will parse our slots for us. (shared-initialize this slots)) -(cl-defgeneric slot-missing (object slot-name operation &optional new-value) - "Method invoked when an attempt to access a slot in OBJECT fails.") - -(cl-defmethod slot-missing ((object eieio-default-superclass) slot-name - _operation &optional _new-value) +(cl-defgeneric slot-missing (object slot-name _operation &optional _new-value) "Method invoked when an attempt to access a slot in OBJECT fails. SLOT-NAME is the name of the failed slot, OPERATION is the type of access that was requested, and optional NEW-VALUE is the value that was desired @@ -777,8 +774,9 @@ to be set. This method is called from `oref', `oset', and other functions which directly reference slots in EIEIO objects." - (signal 'invalid-slot-name (list (eieio-object-name object) - slot-name))) + (signal 'invalid-slot-name + (list (if (eieio-object-p object) (eieio-object-name object) object) + slot-name))) (cl-defgeneric slot-unbound (object class slot-name fn) "Slot unbound is invoked during an attempt to reference an unbound slot.") @@ -815,22 +813,19 @@ first and modify the returned object.") (if params (shared-initialize nobj params)) nobj)) -(cl-defgeneric destructor (this &rest params) - "Destructor for cleaning up any dynamic links to our object.") - -(cl-defmethod destructor ((_this eieio-default-superclass) &rest _params) - "Destructor for cleaning up any dynamic links to our object. -Argument THIS is the object being destroyed. PARAMS are additional -ignored parameters." +(cl-defgeneric destructor (_this &rest _params) + "Destructor for cleaning up any dynamic links to our object." + (declare (obsolete nil "25.2")) ;; No cleanup... yet. - ) + nil) -(cl-defgeneric object-print (this &rest strings) - "Pretty printer for object THIS. Call function `object-name' with STRINGS. +(cl-defgeneric object-print (this &rest _strings) + "Pretty printer for object THIS. It is sometimes useful to put a summary of the object into the default # string when using EIEIO browsing tools. -Implement this method to customize the summary.") +Implement this method to customize the summary." + (format "%S" this)) (cl-defmethod object-print ((this eieio-default-superclass) &rest strings) "Pretty printer for object THIS. Call function `object-name' with STRINGS. @@ -938,11 +933,12 @@ this object." ;;; Unimplemented functions from CLOS ;; -(defun change-class (_obj _class) +(defun eieio-change-class (_obj _class) "Change the class of OBJ to type CLASS. This may create or delete slots, but does not affect the return value of `eq'." (error "EIEIO: `change-class' is unimplemented")) +(define-obsolete-function-alias 'change-class 'eieio-change-class "25.2") ;; Hook ourselves into help system for describing classes and methods. ;; FIXME: This is not actually needed any more since we can click on the commit c334674695ab6c2691e29ae0d6a2993eae1414a3 Author: Michael Albinus Date: Wed Nov 25 15:44:20 2015 +0100 Mention kqueue in NEWS diff --git a/etc/NEWS b/etc/NEWS index 46910b0..1ef496c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -23,6 +23,19 @@ When you add a new item, use the appropriate mark if you are sure it applies, otherwise leave it unmarked. +* Installation Changes in Emacs 25.2 + +** 'configure' detects the kqueue file notification library on *BSD +and Mac OS X machines. + + +* Changes in Specialized Modes and Packages in Emacs 25.2 + +** File Notifications + +*** The kqueue library is integrated for *BSD and Mac OS X machines. + + * Installation Changes in Emacs 25.1 +++ commit 4401e5e0d79ea7d219cf56f115f52cda433a8403 Merge: 91cad2b e604e6a Author: Michael Albinus Date: Wed Nov 25 15:24:27 2015 +0100 ; Merge from scratch/kqueue The following commit was skipped: e604e6a Merge branch 'scratch/kqueue' of git.sv.gnu.org:/srv/git/emacs into scratch/kqueue commit 91cad2b327f19094764ca1dc2c432368742f1d2f Merge: c378d6c bec57a4 Author: Michael Albinus Date: Wed Nov 25 15:24:27 2015 +0100 Merge from scratch/kqueue bec57a4 Some final fixes in file notification before merging with master 0247489 Rework file notifications, kqueue has problems with directory monitors 5154781 Continie with pending events 6b490c0 Improve loops in file-notify-test06-many-events c8e266f Handle more complex rename operation in kqueue 5044bdf New test with a larger number of events. 65ba5a9 Further fixes for kqueue. 13f3508 Code cleanup of kqueue.c 99aa855 Doc changes for kqueue 8deebe1 Finish implementation in kqueue.c 90d6c69 * lisp/filenotify.el (file-notify-add-watch): Fix thinko. e95b309 More work on kqueue 41d9bd0 Implement directory events c571fc1 Build fixes for kqueue support. e0a68f2 Continue kqueue implementation 7543d1c Work on kqueue e3354e2 Add kqueue support c6457ce Minor fix to comment indentation and typo in last commit b92307f linum-mode plays more nicely with other margin-setting extensions 58e6235 * lisp/image-mode.el: Support encrypted file 9375652 * lisp/progmodes/verilog-mode.el (verilog-save-buffer-state): Add backquote 47f83b6 ; ChangeLog.2 fixes 7cc233e * lisp/emacs-lisp/package.el: Fix a decoding issue 5f9153f * lisp/emacs-lisp/package.el: Refactor -with-work-buffer-async 353f5e7 * lisp/progmodes/verilog-mode.el: Use with-silent-modifications 70f1fda ; Auto-commit of ChangeLog files. ae0653b * CONTRIBUTE: Remove information about feature freeze. 9459456 Merge branch 'release-process-lowercase' 9a4aa0f Document the release process f8cc14b * admin/release-process: Rename from admin/FOR-RELEASE. dcd5877 gitmerge: Fix git log command 2ac79ae gitmerge: Try to detect cherry-picks 5f7a2a9 Increment Emacs version on master branch ed2e7e2 Mention CONTRIBUTE in README 9e00a02 Update verilog-mode.el to 2015-11-09-b121d60-vpo. 138ad3d ; Fix warnings 7126e9a ; Update xref-etags-mode for the latest change 246d660 Use generic dispatch for xref backends 31f6e93 Support rectangular regions for more commands f103a27 Handle multiple matches on the same line; add highlighting fe973fc Replace xref-match-bounds with xref-match-length 92a5010 Merge from gnulib 04ac097 Spruce up ftfont.c memory allocation 4c4b520 Port recent XCB changes to 64-bit ‘long int’ 4f0ce9c * src/undo.c (run_undoable_change): Now static. 695a6f9 Remove support for ':timeout' from w32 tray notifications a731c2f * test/automated/simple-test.el: Add test for bug#20698 (bug#21885) 2b4c0c0 * lisp/progmodes/elisp-mode.el: Declare function `project-roots' 66b9f7b * src/undo.c: Small fixes for previous change 2fac30e Add a few more variables to redisplay--variables 04f69f1 * lisp/loadup.el: Enlarge the size of the hash table to 80000. e221d32 Fix point positioning after transposing with negative arg 35f5afb Fix last change in shr.el 508e77b Fix last change d60ed3f Another fix for MinGW64 and Cygwin builds due to notifications 805a39b Remove intern calls and XXX comments from Fx_export_frames 9463abf shr: don't invoke unbound function (Bug#21895) 6e5186e * test/automated/keymaps-test.el: Fix test to make it repeatable 0c92826 * test/automated/cl-lib-tests.el (cl-lib-struct-constructors): Small fix 39dbd1c : Tests for undo-auto functionality. 20aa42e ; Merge branch 'fix/no-undo-boundary-on-secondary-buffer-change' 44dfa86 The heuristic that Emacs uses to add an `undo-boundary' has been reworked, as it interacts poorly with functions on `post-command-hook' or `after-change-functions'. d2f73db Bind [?\S-\ ] to previous line command in Dired-like modes. c1bc6e5 Fix the MinGW64 and Cygwin-w32 builds 1e363a8 Enable sorting of JSON object keys when encoding 9dd7da9 * test/automated/keymap-tests.el: New test file aa17de9 Speed up x_real_pos_and_offsets using XCB a838c83 Enable use of XCB for checking window manager state c7f2b6a Detect XCB and save a connection handle e1c27db Reduce some data dependencies between X calls 25e32bd Use color cache for creating bitmap 851be0f Add "^" to the interactive specs of `dired-next/previous-line' 055ca3a Sync with soap-client repository, version 3.0.2 e0f64e7 CC Mode: Respect users' settings of open-paren-in-column-0-is-defun-start. 952395d * lisp/obarray.el: Fix shadowed variables 436d330 Avoid error in submitting a form with EWW e887f6e ; * doc/lispref/os.texi: Fix indentation of sample code. 51d840a Rename seq-p and map-p to seqp and mapp 23036ba Rename obarray-p to obarrayp 20aea42 Rename obarray-foreach to obarray-map a3b2101 New file with obarray functions. 9d43941 Implement tray notifications for MS-Windows commit e604e6a66e52377151ec7865530f31b1493bc1ef (refs/remotes/origin/scratch/kqueue) Merge: bec57a4 15e7544 Author: Michael Albinus Date: Wed Nov 25 15:08:05 2015 +0100 Merge branch 'scratch/kqueue' of git.sv.gnu.org:/srv/git/emacs into scratch/kqueue commit bec57a486a2a40d7c770dab72a34cf6a4d17a5d0 Author: Michael Albinus Date: Wed Nov 25 15:00:06 2015 +0100 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. diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 0d7a2b9..b6c1f68 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 d1a80bb..6577ee2 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 7bacddd..b665ddd 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 commit 0247489fed0f70b2abf960de48bc4432381a581b Author: Michael Albinus Date: Fri Nov 20 18:06:42 2015 +0000 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. diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 5072bf4..0d7a2b9 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 ca0e3e7..1830040 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 2745f10..6f18697 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 81fb42e..7bacddd 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) + (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 file-notify--test-tmpfile 'recursive)) + (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))) commit 5154781141c2305c24103beb358453d30a838921 Author: Michael Albinus Date: Thu Nov 19 18:49:33 2015 +0000 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. diff --git a/src/kqueue.c b/src/kqueue.c index fa54176..ca0e3e7 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 commit 6b490c070931899a779c3717a2f19625d9e16b19 Author: Michael Albinus Date: Thu Nov 19 16:56:28 2015 +0100 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. diff --git a/test/automated/file-notify-tests.el b/test/automated/file-notify-tests.el index b9cd192..81fb42e 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]." commit c8e266ff5f1862567a9f4b77b2d90b8586b12539 Author: Michael Albinus Date: Thu Nov 19 09:58:08 2015 +0000 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. diff --git a/src/kqueue.c b/src/kqueue.c index e2c9dab..fa54176 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 f0068c5..b9cd192 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") commit 5044bdfed7a0bcf091583816ab8a95621138e7fe Author: Wolfgang Jenkner Date: Wed Nov 18 19:24:27 2015 +0100 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. diff --git a/test/automated/file-notify-tests.el b/test/automated/file-notify-tests.el index 6946541..f0068c5 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") commit 65ba5a98d47f4305f95f960efdf424684754a11d Author: Michael Albinus Date: Wed Nov 18 13:47:25 2015 +0000 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. diff --git a/lisp/filenotify.el b/lisp/filenotify.el index eb869cf..5072bf4 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 5caef67..e2c9dab 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 67e929a..6946541 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) commit 13f3508443e4f5c48d40e4dbb11eaf875a5b2042 Author: Michael Albinus Date: Tue Nov 17 15:46:29 2015 +0000 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. diff --git a/src/kqueue.c b/src/kqueue.c index dfd9139..5caef67 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); } commit 99aa85535aebd96eff294250caef9ab2de2334b7 Author: Michael Albinus Date: Mon Nov 16 14:43:14 2015 +0100 Doc changes for kqueue * doc/lispref/os.texi (File Notifications): Add kqueue as backend. Fix some glitches in the example. diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index f3c4e29..17a0b47 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -2640,9 +2640,9 @@ This function removes the tray notification given by its unique 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} @@ -2713,7 +2713,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 @@ -2752,7 +2753,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 @@ -2798,14 +2799,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 @@ -2815,32 +2816,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 commit 8deebe1ab8d79c3a3fbc3043f99af76802f60bd6 Author: Michael Albinus Date: Mon Nov 16 09:47:26 2015 +0000 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. diff --git a/src/kqueue.c b/src/kqueue.c index 2097b7e..dfd9139 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; commit 90d6c698da735cf3e54d69816995f70e53060bac Author: Michael Albinus Date: Mon Nov 16 08:20:22 2015 +0100 * lisp/filenotify.el (file-notify-add-watch): Fix thinko. diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 2302942..eb869cf 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. commit e95b309ae4f5fbdebdb7067daca9d091925047cf Author: Michael Albinus Date: Sun Nov 15 17:45:32 2015 +0000 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. diff --git a/lisp/filenotify.el b/lisp/filenotify.el index f7c9756..2302942 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 0425a14..2097b7e 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); - - for (dl = old_dl; ! NILP (dl); dl = XCDR (dl)) { + 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); + + /* 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); - - 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)))))))))) + /* 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; + } + + 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 (Qwrite, Qnil), - XCAR (old_entry), callback); + (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; + } - /* 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))))))))))) + /* 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 (Qattrib, Qnil), - XCAR (old_entry), callback); + (XCAR (watch_object), Fcons (Qwrite, Qnil), + 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. */ commit 41d9bd0c3b19d839b72fdd20e613cb6ab3b1b1f4 Author: Michael Albinus Date: Sat Nov 14 11:51:28 2015 +0000 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. diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 029fcf8..f7c9756 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 d2f3d37..0425a14 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 commit c571fc149a786a5bef7f2b283b912999d76dd313 Author: Wolfgang Jenkner Date: Wed Nov 11 16:07:50 2015 +0100 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. diff --git a/configure.ac b/configure.ac index dcd45ea..bae4fec 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 c2e859f..d2f3d37 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); commit e0a68f25877c9b2497d7c4ad0aa1b69e34a3b11f Author: Michael Albinus Date: Wed Nov 11 09:22:06 2015 +0100 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. diff --git a/lisp/filenotify.el b/lisp/filenotify.el index f7c9756..029fcf8 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 a4c3892..c2e859f 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. */ commit 7543d1cf46e475bd14a147ef676abe3935a8f96e Author: Michael Albinus Date: Mon Nov 9 20:26:10 2015 +0100 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. diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 4c5d43f..f7c9756 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 2449abb..ab7cb34 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -5945,12 +5945,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 69bf5f6..a4c3892 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; - - /* 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; + for (;;) { + struct kevent kev; + struct input_event event; + Lisp_Object monitor_object, watch_object, name, callback, actions; + + 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; - - /* 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); + if (CONSP (watch_object)) { + name = XCAR (XCDR (watch_object)); + callback = XCAR (XCDR (XCDR (XCDR (watch_object)))); + } + else + continue; + + /* 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); + + 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); + + /* 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); - 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); + /* Start monitoring for possible I/O. */ + add_read_fd (kqueuefd, kqueue_callback, NULL); //data); - /* 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)); + watch_list = Qnil; } - if (! monitor) - xsignal2 (Qfile_notify_error, build_string ("Cannot watch file"), file); - Lisp_Object watch_descriptor = make_pointer_integer (monitor); + /* 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); - /* 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); - } + /* 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; - /* The default rate limit is 800 msec. We adapt this. */ - g_file_monitor_set_rate_limit (monitor, 100); + /* Register event. */ + EV_SET (&ev, fd, EVFILT_VNODE, EV_ADD | EV_ENABLE | EV_CLEAR, + fflags, 0, NULL); - /* 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 */ commit e3354e2265bc442e4c7b84b806be482db88581a2 Author: Michael Albinus Date: Mon Nov 9 10:00:56 2015 +0100 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. diff --git a/configure.ac b/configure.ac index 0348c06..dcd45ea 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. @@ -4066,8 +4079,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 d667c55..d7ad395 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -160,12 +160,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@ @@ -355,7 +356,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) @@ -468,7 +469,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 b4052b8..2e9f950 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 0000000..69bf5f6 --- /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 3efa492..426b6c9 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4257,17 +4257,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); commit 15e7544bc4a5b38d7e2c28043b3b70eaef1ea5f5 Author: Michael Albinus Date: Wed Nov 25 15:00:06 2015 +0100 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. diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 0d7a2b9..b6c1f68 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 d1a80bb..6577ee2 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 7bacddd..b665ddd 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 commit 8eca1d457083c8b1f46f8addbc695a6119ffb9ad Author: Michael Albinus Date: Fri Nov 20 18:06:42 2015 +0000 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. diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 5072bf4..0d7a2b9 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 ca0e3e7..1830040 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 2745f10..6f18697 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 81fb42e..7bacddd 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) + (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 file-notify--test-tmpfile 'recursive)) + (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))) commit 83d429b0ad0d73df68b79dd94d7c95256e01fdc0 Author: Michael Albinus Date: Thu Nov 19 18:49:33 2015 +0000 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. diff --git a/src/kqueue.c b/src/kqueue.c index fa54176..ca0e3e7 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 commit 4e4180a478aba1f3b66adaab8c0284d215ad6e03 Author: Michael Albinus Date: Thu Nov 19 16:56:28 2015 +0100 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. diff --git a/test/automated/file-notify-tests.el b/test/automated/file-notify-tests.el index b9cd192..81fb42e 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]." commit a81fe30a764c117e87e9da13f19b46d0ba6d35a8 Author: Michael Albinus Date: Thu Nov 19 09:58:08 2015 +0000 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. diff --git a/src/kqueue.c b/src/kqueue.c index e2c9dab..fa54176 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 f0068c5..b9cd192 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") commit 0d45fc135cb2ac17aa776cc5bd5b339bf20514ae Author: Wolfgang Jenkner Date: Wed Nov 18 19:24:27 2015 +0100 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. diff --git a/test/automated/file-notify-tests.el b/test/automated/file-notify-tests.el index 6946541..f0068c5 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") commit 5f08a72c8bf88d4f6f564c5890ec937f59605463 Author: Michael Albinus Date: Wed Nov 18 13:47:25 2015 +0000 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. diff --git a/lisp/filenotify.el b/lisp/filenotify.el index eb869cf..5072bf4 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 5caef67..e2c9dab 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 67e929a..6946541 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) commit bad2b4dbc6dee26bde4b2da73cf9c295f0a31f97 Author: Michael Albinus Date: Tue Nov 17 15:46:29 2015 +0000 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. diff --git a/src/kqueue.c b/src/kqueue.c index dfd9139..5caef67 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); } commit b5804c3a08cca4082bb2bcff1ab70c94ba0c7b96 Author: Michael Albinus Date: Mon Nov 16 14:43:14 2015 +0100 Doc changes for kqueue * doc/lispref/os.texi (File Notifications): Add kqueue as backend. Fix some glitches in the example. diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 7050df8..666a05d 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 commit 30bd630da3ffe0e7a46566fed3ddf4e61abcb737 Author: Michael Albinus Date: Mon Nov 16 09:47:26 2015 +0000 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. diff --git a/src/kqueue.c b/src/kqueue.c index 2097b7e..dfd9139 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; commit 71d88ecab786e8df1490c1dbb8cba3479c29ca12 Author: Michael Albinus Date: Mon Nov 16 08:20:22 2015 +0100 * lisp/filenotify.el (file-notify-add-watch): Fix thinko. diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 2302942..eb869cf 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. commit 54e22f958b2e277830a01a5a1b0fe51ce1b6f405 Author: Michael Albinus Date: Sun Nov 15 17:45:32 2015 +0000 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. diff --git a/lisp/filenotify.el b/lisp/filenotify.el index f7c9756..2302942 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 0425a14..2097b7e 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); - - for (dl = old_dl; ! NILP (dl); dl = XCDR (dl)) { + 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); + + /* 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); - - 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)))))))))) + /* 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; + } + + 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 (Qwrite, Qnil), - XCAR (old_entry), callback); + (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; + } - /* 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))))))))))) + /* 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 (Qattrib, Qnil), - XCAR (old_entry), callback); + (XCAR (watch_object), Fcons (Qwrite, Qnil), + 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. */ commit 978f5b0a705c459fc708b7adacdac2b00c759422 Author: Michael Albinus Date: Sat Nov 14 11:51:28 2015 +0000 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. diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 029fcf8..f7c9756 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 d2f3d37..0425a14 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 commit 84cadc60a7cd4695b9d9e086fd8d68803388dea8 Author: Wolfgang Jenkner Date: Wed Nov 11 16:07:50 2015 +0100 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. diff --git a/configure.ac b/configure.ac index 9c6db56..f9274d7 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 c2e859f..d2f3d37 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); commit bd377a57b1e6fbd46cb63a0999c89e1242463b96 Author: Michael Albinus Date: Wed Nov 11 09:22:06 2015 +0100 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. diff --git a/lisp/filenotify.el b/lisp/filenotify.el index f7c9756..029fcf8 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 a4c3892..c2e859f 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. */ commit 0198c3066e8866d464690a9a7924d42e9c2663bf Author: Michael Albinus Date: Mon Nov 9 20:26:10 2015 +0100 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. diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 4c5d43f..f7c9756 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 8512078..a6ada21 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 69bf5f6..a4c3892 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; - - /* 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; + for (;;) { + struct kevent kev; + struct input_event event; + Lisp_Object monitor_object, watch_object, name, callback, actions; + + 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; - - /* 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); + if (CONSP (watch_object)) { + name = XCAR (XCDR (watch_object)); + callback = XCAR (XCDR (XCDR (XCDR (watch_object)))); + } + else + continue; + + /* 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); + + 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); + + /* 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); - 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); + /* Start monitoring for possible I/O. */ + add_read_fd (kqueuefd, kqueue_callback, NULL); //data); - /* 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)); + watch_list = Qnil; } - if (! monitor) - xsignal2 (Qfile_notify_error, build_string ("Cannot watch file"), file); - Lisp_Object watch_descriptor = make_pointer_integer (monitor); + /* 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); - /* 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); - } + /* 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; - /* The default rate limit is 800 msec. We adapt this. */ - g_file_monitor_set_rate_limit (monitor, 100); + /* Register event. */ + EV_SET (&ev, fd, EVFILT_VNODE, EV_ADD | EV_ENABLE | EV_CLEAR, + fflags, 0, NULL); - /* 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 */ commit 662ee733257d573deaadd2e217894b70265fb5fe Author: Michael Albinus Date: Mon Nov 9 10:00:56 2015 +0100 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. diff --git a/configure.ac b/configure.ac index 5b2d9c7..9c6db56 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 f735759..6a85718 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 b4052b8..2e9f950 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 0000000..69bf5f6 --- /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 c782f0d..b34a852 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);