From 394d3d3bb8a36ee55be17be5cfc6bfb1c39652de Mon Sep 17 00:00:00 2001
From: Brit Butler <redline6561@gmail.com>
Date: Wed, 29 Aug 2012 12:50:26 -0400
Subject: [PATCH] Remove dependency on iolib by homebrewing
 WITH-CURRENT-DIRECTORY. Minor cleanups.

---
 coleslaw.asd      |  2 +-
 src/coleslaw.lisp | 25 ++++++++++++-------------
 src/packages.lisp |  1 -
 src/util.lisp     | 28 ++++++++++++++++++++++++++++
 4 files changed, 41 insertions(+), 15 deletions(-)

diff --git a/coleslaw.asd b/coleslaw.asd
index 1af4d8d..99d3374 100644
--- a/coleslaw.asd
+++ b/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")
diff --git a/src/coleslaw.lisp b/src/coleslaw.lisp
index ae00f72..9fb97a1 100644
--- a/src/coleslaw.lisp
+++ b/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)
-             (merge-pathnames (apply 'format nil path args) (deploy *config*))))
-      (let ((new-build (deploy-path "generated/~a" (get-universal-time)))
-            (prev (deploy-path ".prev"))
-            (curr (deploy-path ".curr")))
+    (with-current-directory coleslaw-conf:*basedir*
+      (let* ((coleslaw-conf:*basedir* (deploy *config*))
+             (new-build (app-path "generated/~a" (get-universal-time)))
+             (prev (app-path ".prev"))
+             (curr (app-path ".curr")))
         (ensure-directories-exist new-build)
-        (with-current-directory coleslaw-conf:*basedir*
-          (run-program "mv ~a ~a" staging new-build)
-          (if (and (probe-file prev) (equal prev (truename prev)))
-              (delete-file prev)
-              (cl-fad:delete-directory-and-files (truename prev)))
-          (when (probe-file curr)
-            (update-symlink prev (truename curr)))
-          (update-symlink curr new-build))))))
+        (run-program "mv ~a ~a" staging new-build)
+        (if (and (probe-file prev) (equal prev (truename prev)))
+            (delete-file prev)
+            (cl-fad:delete-directory-and-files (truename prev)))
+        (when (probe-file curr)
+          (update-symlink prev (truename curr)))
+        (update-symlink curr new-build)))))
 
 (defun main ()
   "Load the user's config, then compile and deploy the blog."
diff --git a/src/packages.lisp b/src/packages.lisp
index f094199..d14c643 100644
--- a/src/packages.lisp
+++ b/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
diff --git a/src/util.lisp b/src/util.lisp
index 7c8bcdc..ea92bbf 100644
--- a/src/util.lisp
+++ b/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)))))