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

This commit is contained in:
Brit Butler 2012-08-29 12:50:26 -04:00
parent fb0fe50cc3
commit 394d3d3bb8
4 changed files with 41 additions and 15 deletions

View file

@ -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")

View file

@ -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")))
(ensure-directories-exist new-build)
(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)
(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))))))
(update-symlink curr new-build)))))
(defun main ()
"Load the user's config, then compile and deploy the blog."

View file

@ -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

View file

@ -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)))))