Untabify and replace some splices to conform.
authorOlof-Joachim Frahm <olof@macrolet.net>
Wed, 19 Dec 2012 22:58:39 +0000 (23:58 +0100)
committerOlof-Joachim Frahm <olof@macrolet.net>
Wed, 19 Dec 2012 22:58:39 +0000 (23:58 +0100)
cl-inotify.asd
inotify.lisp

index f35ddbf..80aaad5 100644 (file)
@@ -36,7 +36,7 @@
   :long-description "Binding to the Linux inotify(7) API."
   :author "Olof-Joachim Frahm <olof@macrolet.net>"
   :license "Simplified BSD License"
   :long-description "Binding to the Linux inotify(7) API."
   :author "Olof-Joachim Frahm <olof@macrolet.net>"
   :license "Simplified BSD License"
-  :depends-on (#:cffi #:binary-types #:trivial-utf-8)
+  :depends-on (#:cffi #:binary-types #:trivial-utf-8 #:sb-posix)
   :serial T
   :components ((:file "package")
               (cffi-grovel:grovel-file "grovel")
   :serial T
   :components ((:file "package")
               (cffi-grovel:grovel-file "grovel")
index e43e7db..555ca85 100644 (file)
@@ -56,7 +56,7 @@
 (deftype inotify-add/read-flag ()
   "Shared valid flags for the WATCH-RAW and READ-EVENT functions."
   '(member
 (deftype inotify-add/read-flag ()
   "Shared valid flags for the WATCH-RAW and READ-EVENT functions."
   '(member
-    :access :attrib 
+    :access :attrib
     :close-write :close-nowrite :close
     :create :delete :delete-self
     :modify
     :close-write :close-nowrite :close
     :create :delete :delete-self
     :modify
@@ -118,8 +118,8 @@ NAME optionally identifies a file relative to a watched directory."
   (name NIL))
 
 (defstruct (inotify-instance
   (name NIL))
 
 (defstruct (inotify-instance
-            (:constructor make-inotify-instance ())
-            (:conc-name inotify-))
+             (:constructor make-inotify-instance ())
+             (:conc-name inotify-))
   "Contains the stream and file descriptor for a inotify instance."
   fd
   stream
   "Contains the stream and file descriptor for a inotify instance."
   fd
   stream
@@ -130,24 +130,25 @@ NAME optionally identifies a file relative to a watched directory."
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun read-new-value (&optional (stream *query-io*))
     "READs a value from the STREAM and returns it (wrapped in a list)."
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun read-new-value (&optional (stream *query-io*))
     "READs a value from the STREAM and returns it (wrapped in a list)."
-    (format stream "Enter a new value: ~%")
-    (list (read *query-io*))))
+    (format stream "~&Enter a new value (unevaluated): ")
+    (force-output stream)
+    (list (read stream))))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun init-endian ()
     "Initialises the endianess for the BINARY-TYPES library.  Is automatically
 called when the library is loaded."
     (setf binary-types:*endian*
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun init-endian ()
     "Initialises the endianess for the BINARY-TYPES library.  Is automatically
 called when the library is loaded."
     (setf binary-types:*endian*
-         (restart-case #+little-endian :little-endian
-                       #+big-endian :big-endian
-                       #-(or little-endian big-endian) (error "unknown endianess")
-                       (use-value (value)
-                         :report "Enter a correct value (either :LITTLE-ENDIAN or :BIG-ENDIAN)."
-                         :interactive read-new-value
-                         ;; TODO: better way to test for correct value/retry values?
-                         (case value
-                           ((:little-endian :big-endian) value)
-                           (T (error "wrong value supplied (not :LITTLE-ENDIAN or :BIG-ENDIAN)"))))))))
+          (restart-case #+little-endian :little-endian
+                        #+big-endian :big-endian
+                        #-(or little-endian big-endian) (error "unknown endianess")
+                        (use-value (value)
+                          :report "Enter a correct value (either :LITTLE-ENDIAN or :BIG-ENDIAN)."
+                          :interactive read-new-value
+                          ;; TODO: better way to test for correct value/retry values?
+                          (case value
+                            ((:little-endian :big-endian) value)
+                            (T (error "wrong value supplied (not :LITTLE-ENDIAN or :BIG-ENDIAN)"))))))))
 
 ;; initialise the endianess
 (eval-when (:compile-toplevel :load-toplevel :execute)
 
 ;; initialise the endianess
 (eval-when (:compile-toplevel :load-toplevel :execute)
@@ -158,12 +159,12 @@ called when the library is loaded."
 (defun read-raw-event-from-stream (stream)
   "Reads a raw event from the inotify stream."
   (let* ((event (binary-types:read-binary 'inotify-event stream))
 (defun read-raw-event-from-stream (stream)
   "Reads a raw event from the inotify stream."
   (let* ((event (binary-types:read-binary 'inotify-event stream))
-        (len (binary-types:read-binary 'binary-types:u32 stream)))
+         (len (binary-types:read-binary 'binary-types:u32 stream)))
     (when (plusp len)
       (with-slots (name) event
     (when (plusp len)
       (with-slots (name) event
-       (let ((buffer (make-array len :element-type '(unsigned-byte 8))))
-         (read-sequence buffer stream :end len)
-         (setf name (trivial-utf-8:utf-8-bytes-to-string buffer :end (position 0 buffer))))))
+        (let ((buffer (make-array len :element-type '(unsigned-byte 8))))
+          (read-sequence buffer stream :end len)
+          (setf name (trivial-utf-8:utf-8-bytes-to-string buffer :end (position 0 buffer))))))
     event))
 
 (defun read-event-from-stream (stream)
     event))
 
 (defun read-event-from-stream (stream)
@@ -178,8 +179,8 @@ called when the library is loaded."
   (let ((flags (sb-posix:fcntl fd sb-posix:f-getfl)))
     ;; an error is raised if this fails, so we don't have to do it ourselves
     (sb-posix:fcntl fd sb-posix:f-setfl
   (let ((flags (sb-posix:fcntl fd sb-posix:f-getfl)))
     ;; an error is raised if this fails, so we don't have to do it ourselves
     (sb-posix:fcntl fd sb-posix:f-setfl
-                   (funcall (if nonblocking #'logior #'logxor)
-                            flags sb-posix:o-nonblock)))
+                    (funcall (if nonblocking #'logior #'logxor)
+                             flags sb-posix:o-nonblock)))
   (values))
 
 (defun init-unregistered-inotify (inotify &optional (nonblocking T))
   (values))
 
 (defun init-unregistered-inotify (inotify &optional (nonblocking T))
@@ -190,23 +191,23 @@ the file descriptor is set to non-blocking I/O."
       (perror "inotify_init failed"))
     (with-slots (fd stream (non-block nonblocking)) inotify
       (unwind-protect
       (perror "inotify_init failed"))
     (with-slots (fd stream (non-block nonblocking)) inotify
       (unwind-protect
-          ;; file descriptor is collected with auto-close
-          (progn
-            (setf fd result)
-            (when nonblocking
-              (set-nonblocking fd T)
-              (setf non-block nonblocking))
-            (setf stream
-                  (sb-sys:make-fd-stream
-                   fd
-                   :input T
-                   :element-type '(unsigned-byte 8)
-                   :name (format NIL "inotify event queue ~A" fd)
-                   :auto-close T
-                   :buffering (if nonblocking :none :full))))
-       ;; if stream is constructed, gc'ing it will cleanup the file descriptor
-       (unless stream
-         (sb-posix:close fd)))))
+           ;; file descriptor is collected with auto-close
+           (progn
+             (setf fd result)
+             (when nonblocking
+               (set-nonblocking fd T)
+               (setf non-block nonblocking))
+             (setf stream
+                   (sb-sys:make-fd-stream
+                    fd
+                    :input T
+                    :element-type '(unsigned-byte 8)
+                    :name (format NIL "inotify event queue ~A" fd)
+                    :auto-close T
+                    :buffering (if nonblocking :none :full))))
+        ;; if stream is constructed, gc'ing it will cleanup the file descriptor
+        (unless stream
+          (sb-posix:close fd)))))
   inotify)
 
 (defun make-unregistered-inotify (&optional (nonblocking T))
   inotify)
 
 (defun make-unregistered-inotify (&optional (nonblocking T))
@@ -237,10 +238,10 @@ determines how exactly (see inotify(7) for detailed information) and can
 be of type LIST, KEYWORD or a raw numerical value (which isn't checked
 for validity though).  Returns a handle which can be used with UNWATCH-RAW."
   (let* ((path (etypecase pathname
 be of type LIST, KEYWORD or a raw numerical value (which isn't checked
 for validity though).  Returns a handle which can be used with UNWATCH-RAW."
   (let* ((path (etypecase pathname
-                (string pathname)
-                (pathname (namestring pathname))))
-        (result (c-inotify-add-watch (inotify-fd inotify)
-                                     path (translate-keyword-flags flags))))
+                 (string pathname)
+                 (pathname (namestring pathname))))
+         (result (c-inotify-add-watch (inotify-fd inotify)
+                                      path (translate-keyword-flags flags))))
     (when (minusp result)
       (perror "inotify_add_watch failed"))
     result))
     (when (minusp result)
       (perror "inotify_add_watch failed"))
     result))
@@ -255,9 +256,9 @@ for validity though).  Returns a handle which can be used with UNWATCH-RAW."
 ;;;; support functions, making life easier
 
 (defstruct (registered-inotify-instance
 ;;;; support functions, making life easier
 
 (defstruct (registered-inotify-instance
-            (:include inotify-instance)
-            (:constructor make-registered-inotify-instance ())
-            (:conc-name inotify-))
+             (:include inotify-instance)
+             (:constructor make-registered-inotify-instance ())
+             (:conc-name inotify-))
   "Additionally to the information in INOTIFY-INSTANCE, records watched
 paths in a dictionary."
   watched)
   "Additionally to the information in INOTIFY-INSTANCE, records watched
 paths in a dictionary."
   watched)
@@ -282,22 +283,22 @@ being watched by INOTIFY, else NIL.  The match is exact."
 registration.  If HANDLE is specified EVENT is ignored."
   (block NIL
     (maphash (lambda (pathname entry)
 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))))
+               (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))
 
 (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)))
+         (rep-flags (if replace-p
+                        (cons :mask-add flags)
+                        flags)))
     (let ((it (gethash pathname (slot-value inotify 'watched))))
       (if it
     (let ((it (gethash pathname (slot-value inotify 'watched))))
       (if it
-         (union (cdr it) rep-flags :test #'eq)
-         rep-flags))))
+          (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
 
 (defun watch (inotify pathname flags &key (replace-p T))
   "Adds PATHNAME (either pathname or string) to be watched and records the
@@ -307,7 +308,7 @@ 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))
 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)))
+         (handle (watch-raw inotify pathname flags)))
     (with-slots (watched) inotify
       (setf (gethash pathname watched) (cons handle flags)))
     handle))
     (with-slots (watched) inotify
       (setf (gethash pathname watched) (cons handle flags)))
     handle))
@@ -322,11 +323,11 @@ may be one from a given EVENT) or PATHNAME."
   (if handle
       (unwatch-raw inotify handle)
       (let ((handle (car (pathname-handle/flags inotify pathname))))
   (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)))
+        (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)
   (values))
 
 (defun list-watched (inotify)
@@ -367,10 +368,10 @@ terminates if no events are available."
    `(loop
       with ,var and ,inotify-sym = ,inotify
       ,.(unless blocking-p
    `(loop
       with ,var and ,inotify-sym = ,inotify
       ,.(unless blocking-p
-         `(while (event-available-p ,inotify-sym)))
+          `(while (event-available-p ,inotify-sym)))
       do (progn
       do (progn
-          (setf ,var (read-event ,inotify-sym))
-          ,.body))))
+           (setf ,var (read-event ,inotify-sym))
+           ,@body))))
 
 (defun next-events (inotify)
   "Reads all available events from the queue.  Returns a LIST of events."
 
 (defun next-events (inotify)
   "Reads all available events from the queue.  Returns a LIST of events."
@@ -385,11 +386,11 @@ terminates if no events are available."
 instead.  Useful if you need to monitor just a fixed set of paths."
   `(let* ((,inotify (make-unregistered-inotify ,nonblocking)))
      (unwind-protect
 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)
+          (progn
+            ,.(mapcar (lambda (specifier)
+                        `(watch-raw ,inotify ,@specifier))
+                      rest)
+            ,@body)
        (close-inotify ,inotify))))
 
 (defmacro with-inotify ((inotify &optional (nonblocking T) &rest rest) &body body)
        (close-inotify ,inotify))))
 
 (defmacro with-inotify ((inotify &optional (nonblocking T) &rest rest) &body body)
@@ -403,9 +404,9 @@ 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
 UNWATCH calls on all WATCHed paths."
   `(let* ((,inotify (make-inotify ,nonblocking)))
      (unwind-protect
-         (progn
-           ,.(mapcar (lambda (specifier)
-                       `(watch ,inotify ,.specifier))
-                     rest)
-           ,.body)
+          (progn
+            ,.(mapcar (lambda (specifier)
+                        `(watch ,inotify ,@specifier))
+                      rest)
+            ,@body)
        (close-inotify ,inotify))))
        (close-inotify ,inotify))))