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"
-  :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")
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
-    :access :attrib 
+    :access :attrib
     :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
-            (: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
@@ -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)."
-    (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*
-         (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)
@@ -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))
-        (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
-       (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)
@@ -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
-                   (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))
@@ -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
-          ;; 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))
@@ -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
-                (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))
@@ -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
-            (: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)
@@ -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)
-              (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))
-        (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
-         (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
@@ -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))
-        (handle (watch-raw inotify pathname flags)))
+         (handle (watch-raw inotify pathname flags)))
     (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))))
-       (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)
@@ -367,10 +368,10 @@ terminates if no events are available."
    `(loop
       with ,var and ,inotify-sym = ,inotify
       ,.(unless blocking-p
-         `(while (event-available-p ,inotify-sym)))
+          `(while (event-available-p ,inotify-sym)))
       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."
@@ -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
-         (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)
@@ -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
-         (progn
-           ,.(mapcar (lambda (specifier)
-                       `(watch ,inotify ,.specifier))
-                     rest)
-           ,.body)
+          (progn
+            ,.(mapcar (lambda (specifier)
+                        `(watch ,inotify ,@specifier))
+                      rest)
+            ,@body)
        (close-inotify ,inotify))))