mop: Implement a class which automatically defines a predicate.

[lisp] / safely.lisp

diff --git a/safely.lisp b/safely.lisp
index 6153060..60dd683 100644 (file)
--- a/safely.lisp
+++ b/safely.lisp
@@ -23,33 +23,37 @@
 ;;; along with this program; if not, write to the Free Software Foundation,
 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
-(defpackage #:mdw.safely
+(defpackage #:safely
   (:use #:common-lisp #:mdw.base #:mdw.unix)
   (:export #:safely #:safely-close #:safely-delete-file
           #:safely-open-output-stream #:safely-bail #:safely-commit
           #:safely-writing))
-(in-package #:mdw.safely)
+(in-package #:safely)
 
 (defstruct (safely (:predicate safelyp))
   "Stores information about how to commit or undo safe writes."
   (streams nil)
   (trail nil))
+
 (defun safely-close (safe stream)
   "Make sure that STREAM is closed when SAFE is finished."
   (push stream (safely-streams safe)))
+
 (defun safely-delete-file (safe file)
   "Delete FILE when SAFE is committed."
   (push `(:delete ,file ,(fresh-file-name file "del")) (safely-trail safe)))
+
 (defun fresh-file-name (base tag)
   "Return a fresh file name constructed from BASE and TAG in the current
-directory.  Do not assume that this filename will be good by the time you try
-to create the file."
+   directory.  Do not assume that this filename will be good by the time you
+   try to create the file."
   (let ((name (format nil "~A.~A-~X"
                      base tag (random most-positive-fixnum))))
     (if (probe-file name) (fresh-file-name base tag) name)))
+
 (defun safely-open-output-stream (safe file &rest open-args)
   "Create an output stream which will be named FILE when SAFE is committed.
-Other OPEN-ARGS are passed to open."
+   Other OPEN-ARGS are passed to open."
   (let* ((new (fresh-file-name file "new"))
         (stream (apply #'open
                        new
@@ -60,15 +64,20 @@ Other OPEN-ARGS are passed to open."
     (push `(:shunt ,new ,file ,(fresh-file-name file "old"))
          (safely-trail safe))
     stream))
+
 (defun delete-file-without-moaning (file)
   "Delete the FILE, ignoring errors."
-  (when (probe-file file)
-    (unix-try unlink file)))
+  (with-errno-handlers ()
+      (sys-unlink file)
+    (ENOENT nil)))
+
 (defun rename-file-without-moaning (old new)
   "Rename OLD to NEW, ignoring errors, and without doing any stupid name
-mangling."
-  (when (probe-file old)
-    (unix-try rename old new)))
+   mangling."
+  (with-errno-handlers ()
+      (sys-rename old new)
+    (ENOENT nil)))
+
 (defun safely-unwind (trail)
   "Roll back the TRAIL of operations."
   (dolist (job trail)
@@ -84,22 +93,25 @@ mangling."
       (:revert (destructuring-bind (tag old new) job
                 (declare (ignore tag))
                 (rename-file-without-moaning old new))))))
+
 (defun safely-reset (safe)
   "Reset SAFE to its initial state."
   (setf (safely-streams safe) nil)
   (setf (safely-trail safe) nil))
+
 (defun safely-bail (safe)
   "Abort the operations in SAFE, unwinding all the things that have been
-done.  Streams are closed, new files are removed."
+   done.  Streams are closed, new files are removed."
   (dolist (stream (safely-streams safe))
     (close stream :abort t))
   (safely-unwind (safely-trail safe))
   (safely-reset safe))
+
 (defun safely-commit (safe)
   "Commit SAFE.  The files deleted by safely-delete-file are deleted; the
-files created by safely-open-output-stream are renamed over the old versions,
-if any.  If a problem occurs during this stage, everything is rewound and no
-changes are made."
+   files created by safely-open-output-stream are renamed over the old
+   versions, if any.  If a problem occurs during this stage, everything is
+   rewound and no changes are made."
   (let ((trail (safely-trail safe))
        (revert nil)
        (cleanup nil))
@@ -121,20 +133,21 @@ changes are made."
                                  (copy-file file old)
                                  (push `(:revert ,old ,file) revert))
                                (push `(:rmtmp ,file) revert))
-                           (unix-try rename new file)))
+                           (sys-rename new file)))
                  (:delete (destructuring-bind (tag file old) job
                             (declare (ignore tag))
                             (push `(:revert ,old ,file) revert)
-                            (unix-try rename file old)
+                            (sys-rename file old)
                             (push `(:rmtmp old) cleanup))))))
          (setf revert nil))
       (safely-unwind trail)
       (safely-unwind revert)
       (safely-unwind cleanup)
       (safely-reset safe))))
+
 (defmacro safely ((safe &key) &body body)
   "Do stuff within the BODY safely.  If BODY completes without errors, the
-SAFE is committed; otherwise it's bailed."
+   SAFE is committed; otherwise it's bailed."
   `(let ((,safe (make-safely)))
      (unwind-protect
         (progn
@@ -143,9 +156,10 @@ SAFE is committed; otherwise it's bailed."
           (setf ,safe nil))
        (when ,safe
         (safely-bail ,safe)))))
+
 (defmacro safely-writing ((stream file &rest open-args) &body body)
   "Simple macro for writing a single file safely.  STREAM is opened onto a
-temporary file, and if BODY completes, it is renamed to FILE."
+   temporary file, and if BODY completes, it is renamed to FILE."
   (with-gensyms safe
     `(safely (,safe)
        (let ((,stream (apply #'safely-open-output-stream