Remove dependency on iolib by homebrewing WITH-CURRENT-DIRECTORY. Minor cleanups.

coleslaw.asd

@@ -6,7 +6,7 @@
   :author "Brit Butler <redline6561@gmail.com>"
   :pathname "src/"
   :depends-on (:alexandria :closure-template :3bmd :3bmd-ext-code-blocks
-               :local-time :trivial-shell :iolib.os :cl-fad)
+               :local-time :trivial-shell :cl-fad)
   :serial t
   :components ((:file "packages")
                (:file "config")

src/coleslaw.lisp

@@ -39,20 +39,19 @@ If RAW is non-nil, write the content without wrapping it in the base template."
 (defgeneric deploy (staging)
   (:documentation "Deploy the STAGING dir, updating the .prev and .curr symlinks.")
   (:method (staging)
-    (flet ((deploy-path (path &rest args)
+    (with-current-directory coleslaw-conf:*basedir*
-             (merge-pathnames (apply 'format nil path args) (deploy *config*))))
+      (let* ((coleslaw-conf:*basedir* (deploy *config*))
-      (let ((new-build (deploy-path "generated/~a" (get-universal-time)))
+             (new-build (app-path "generated/~a" (get-universal-time)))
-            (prev (deploy-path ".prev"))
+             (prev (app-path ".prev"))
-            (curr (deploy-path ".curr")))
+             (curr (app-path ".curr")))
         (ensure-directories-exist new-build)
-        (with-current-directory coleslaw-conf:*basedir*
+        (run-program "mv ~a ~a" staging new-build)
-          (run-program "mv ~a ~a" staging new-build)
+        (if (and (probe-file prev) (equal prev (truename prev)))
-          (if (and (probe-file prev) (equal prev (truename prev)))
+            (delete-file prev)
-              (delete-file prev)
+            (cl-fad:delete-directory-and-files (truename prev)))
-              (cl-fad:delete-directory-and-files (truename prev)))
+        (when (probe-file curr)
-          (when (probe-file curr)
+          (update-symlink prev (truename curr)))
-            (update-symlink prev (truename curr)))
+        (update-symlink curr new-build)))))
-          (update-symlink curr new-build))))))
 
 (defun main ()
   "Load the user's config, then compile and deploy the blog."

src/packages.lisp

@@ -1,7 +1,6 @@
 (defpackage :coleslaw
   (:documentation "Homepage: <a href=\"http://github.com/redline6561/coleslaw\">Github</a>")
   (:use :cl :closure-template)
-  (:import-from :iolib.os #:with-current-directory)
   (:import-from :alexandria #:hash-table-values
                             #:make-keyword)
   (:export #:main

src/util.lisp

@@ -24,3 +24,31 @@ on files that match the given extension."
                  (when (and ,ext (string= ,ext ,extension))
                    ,@body)))
              `,body))))
+
+(defun current-directory ()
+  "Return the operating system's current directory."
+  #+sbcl (sb-posix:getcwd)
+  #+ccl (current-directory)
+  #+ecl (si:getcwd)
+  #+cmucl (unix:unix-current-directory)
+  #+clisp (ext:cd)
+  #-(or sbcl ccl ecl cmucl clisp) (error "Not implemented yet."))
+
+(defun (setf current-directory) (path)
+  "Change the operating system's current directory to PATH."
+  #+sbcl (sb-posix:chdir pathspec)
+  #+ccl (setf (current-directory) pathspec)
+  #+ecl (si:chdir pathspec)
+  #+cmucl (unix:unix-chdir (namestring pathspec))
+  #+clisp (ext:cd pathspec)
+  #-(or sbcl ccl ecl cmucl clisp) (error "Not implemented yet."))
+
+(defmacro with-current-directory (to-path &body body)
+  "Change the current OS directory to TO-PATH and execute BODY in
+an UNWIND-PROTECT, then change back to the current directory."
+  (alexandria:with-gensyms (old)
+    `(let ((,old (current-directory)))
+       (unwind-protect (progn
+                         (setf (current-directory) ,to-path)
+                         ,@body)
+         (setf (current-directory) ,old)))))