+(defun pathname-handle/flags (inotify pathname)
+ "Returns a CONS cell with the values HANDLE and FLAGS if PATHNAME is
+being watched by INOTIFY, else NIL. The match is exact."
+ (gethash pathname (inotify-watched inotify)))
+
+(defun event-pathname/flags (inotify event &optional (handle (slot-value event 'wd)))
+ "Returns two values PATHNAME and FLAGS for an EVENT which were used during
+registration. If HANDLE is specified EVENT is ignored."
+ (block NIL
+ (maphash (lambda (pathname entry)
+ (when (eql (car entry) handle)
+ (return (values pathname (cdr entry)))))
+ (inotify-watched inotify))))
+
+(defun sane-user-flags (inotify pathname flags &key (replace-p T))
+ (check-type flags watch-flag-list)
+ ;; now, :mask-add can't be member of flags
+ ;; merge the flags
+ (let* ((flags (ensure-list flags))
+ (rep-flags (if replace-p
+ (cons :mask-add flags)
+ flags)))
+ (let ((it (gethash pathname (slot-value inotify 'watched))))
+ (if it
+ (union (cdr it) rep-flags :test #'eq)
+ rep-flags))))
+
+(defun watch (inotify pathname flags &key (replace-p T))
+ "Adds PATHNAME (either pathname or string) to be watched and records the
+watched paths. FLAGS (a list of keywords) determines how exactly (see
+inotify(7) for detailed information). Returns a handle which can be used
+with UNWATCH and EVENT-PATHNAME/FLAGS. If REPLACE-P is set to T (default),
+the flags mask is replaced rather than OR-ed to the current mask (if it
+exists). The :MASK-ADD flag is therefore removed from the FLAGS argument."
+ (let* ((flags (sane-user-flags inotify pathname flags :replace-p replace-p))
+ (handle (watch-raw inotify pathname flags)))
+ (with-slots (watched) inotify
+ (setf (gethash pathname watched) (cons handle flags)))
+ handle))
+
+(defun unwatch (inotify &key pathname event handle)
+ "Disables watching the path associated with the supplied HANDLE (which
+may be one from a given EVENT) or PATHNAME."
+ (unless (or pathname event handle)
+ (error "either PATHNAME, EVENT or HANDLE have to be specified"))
+ (when event
+ (setf handle (slot-value event 'wd)))
+ (if handle
+ (unwatch-raw inotify handle)
+ (let ((handle (car (pathname-handle/flags inotify pathname))))
+ (unless handle
+ (error "PATHNAME ~S isn't being watched" pathname))
+ ;; remove even if unwatch-raw throws an error (which can happen if :oneshot is specified)
+ (remhash pathname (inotify-watched inotify))
+ (unwatch-raw inotify handle)))
+ (values))
+
+(defun list-watched (inotify)
+ "Returns a LIST of all watched pathnames in no particular order."
+ (loop
+ for pathname being each hash-key in (inotify-watched inotify)
+ collect pathname))
+
+(defun unix-eagain-p (fd)
+ "Returns T on a file descriptor if trying to read raised an EAGAIN
+error."
+ (handler-case (prog1 NIL (osicat-posix:read fd (null-pointer) 0))
+ ;; we have to check for both to be portable, says read(2)
+ (osicat-posix:eagain () T)
+ (osicat-posix:ewouldblock () T)
+ ;; this is set if the kernel is newer than 2.6.21 if the buffer is
+ ;; too small to get the next event (which it certainly is)
+ (osicat-posix:einval () NIL)))
+
+(defun event-available-p (inotify)
+ "Returns T if an event is available on the queue."
+ (if (inotify-nonblocking inotify)
+ (not (unix-eagain-p (inotify-fd inotify)))
+ (listen (inotify-stream inotify))))
+
+(defun read-event (inotify)
+ "Reads an event from the queue. Blocks if no event is available."
+ (read-event-from-stream (inotify-stream inotify)))
+
+(defun next-event (inotify)
+ "Reads an event from the queue. Returns NIL if none is available."
+ (when (event-available-p inotify)
+ (read-event inotify)))
+
+(defmacro do-events ((var inotify &key blocking-p) &body body)
+ "Loops BODY with VAR bound to the next events retrieved from INOTIFY.
+The macro uses NEXT-EVENT, so reading an event won't block and the loop
+terminates if no events are available. If BLOCKING-P is set, the loop
+blocks if no events are available, otherwise it exits as soon as no
+events were encountered."
+ (check-type var symbol)
+ (let ((inotify-sym (gensym)))
+ `(loop
+ with ,var and ,inotify-sym = ,inotify
+ ,.(unless blocking-p
+ `(while (event-available-p ,inotify-sym)))
+ do (progn
+ (setf ,var (read-event ,inotify-sym))
+ ,@body))))
+
+(defun next-events (inotify)
+ "Reads all available events from the queue. Returns a LIST of events."
+ (loop
+ while (event-available-p inotify)
+ collect (read-event inotify)))
+
+;;; this has the longer name, because this way you actually have to read
+;;; about the differences, at least i hope so
+(defmacro with-unregistered-inotify ((inotify &optional (nonblocking T) &rest rest) &body body)
+ "Like WITH-INOTIFY, but uses MAKE-UNREGISTERED-INOTIFY and WATCH-RAW
+instead. Useful if you need to monitor just a fixed set of paths."
+ `(let ((,inotify (make-unregistered-inotify ,nonblocking)))
+ (unwind-protect
+ (progn
+ ,.(mapcar (lambda (specifier)
+ `(watch-raw ,inotify ,@specifier))
+ rest)
+ ,@body)
+ (close-inotify ,inotify))))
+
+(defmacro with-inotify ((inotify &optional (nonblocking T) &rest rest) &body body)
+ "Executes BODY with a newly created queue bound to INOTIFY if true.
+See MAKE-INOTIFY for more information about possible arguments.
+
+The REST is a list of argument forms for the WATCH function, i.e. one or
+more forms (PATHNAME FLAGS &KEY (REPLACE-P T)).
+
+Since the QUEUE is closed on unwinding, this macro doesn't bother with
+UNWATCH calls on all WATCHed paths."
+ `(let ((,inotify (make-inotify ,nonblocking)))
+ (unwind-protect
+ (progn
+ ,.(mapcar (lambda (specifier)
+ `(watch ,inotify ,@specifier))
+ rest)
+ ,@body)
+ (close-inotify ,inotify))))
+
+;; TODO: what about other implementations?
+#+sbcl
+(defmacro with-inotify-event-handler ((inotify
+ &optional (nonblocking T) (registered T)
+ &rest rest)
+ event-handler
+ &body body)
+ "Registers an INOTIFY queue and runs EVENT-HANDLER with it as only
+parameter whenever input happens while the BODY is executed.
+
+Other parameters are passed to WITH-(UNREGISTERED)-INOTIFY depending on the
+value of REGISTERED (default T)."
+ (let ((handle (gensym "HANDLE")))
+ `(,(if registered 'with-inotify 'with-unregistered-inotify)
+ (,inotify ,nonblocking ,@rest)
+ (sb-sys:with-fd-handler
+ ((inotify-fd ,inotify)
+ :input
+ (lambda (,handle)
+ (declare (ignore ,handle))
+ (funcall ,event-handler ,inotify)))
+ ,@body))))
+
+#+sbcl
+(defun run-inotify-program (program args rest directories flags
+ &key function (wait T) event-handler (registered T))
+ "Runs a program and records all matched events in all DIRECTORIES using
+FLAGS. If EVENT-HANDLER is set, it is instead called with every available
+event.
+
+PROGRAM, ARGS and REST are the arguments to SB-EXT:RUN-PROGRAM. REST is
+passed on verbatim except for the WAIT parameter, which is set to false.
+
+PROGRAM may also be a FUNCTION, in which case it is called with
+\(ARGS . REST) as arguments and has to return a process object like from
+SB-EXT:RUN-PROGRAM. The process also shouldn't be spawned with WAIT set.
+
+DIRECTORIES is a list of directory arguments for WATCH/-RAW.
+
+WAIT is only valid if FUNCTION is set. If it is true, after FUNCTION has
+returned, we wait until the process has quit.
+
+On supported implementations (SBCL) the FUNCTION parameter may be used to
+do some work while the program is running and watched by the inotify queue.
+It is called with the process object and the inotify queue as arguments."
+ (let (events)
+ (labels ((run ()
+ (typecase program
+ (function (apply program args rest))
+ (T
+ (apply #'sb-ext:run-program program args :wait NIL rest))))
+ (events (inotify)
+ (do-events (event inotify)
+ (if event-handler
+ (funcall event-handler event)
+ (push event events))))
+ (body (inotify)
+ (unwind-protect
+ (progn
+ (let ((register (if registered #'watch #'watch-raw)))
+ (mapcar (lambda (directory)
+ (funcall register inotify directory flags))
+ directories))
+ (let ((process (run)))
+ (if function
+ (unwind-protect
+ (funcall function process inotify)
+ ;; wait in any case so catching the files will work
+ (when wait
+ (sb-ext:process-wait process)))
+ (loop
+ while (sb-ext:process-alive-p process)
+ do (events inotify)
+ finally (return (if event-handler
+ process
+ (values (nreverse events) process)))))))
+ (close-inotify inotify))))
+ (let ((inotify (if registered (make-inotify) (make-unregistered-inotify))))
+ (if function
+ #-sbcl
+ (error "the FUNCTION parameter is only supported on SBCL for now")
+ #+sbcl
+ (sb-sys:with-fd-handler
+ ((inotify-fd inotify)
+ :input
+ (lambda (handle)
+ (declare (ignore handle))
+ (events inotify)))
+ (body inotify))
+ (body inotify))))))