marcuskammer/coleslaw
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add cl-fad for do-files and directory deletion.

Browse source
This commit is contained in:
Brit Butler 2012-08-21 15:57:01 -04:00
parent ef315397a4
commit 34c05403e9
3 changed files with 13 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
coleslaw.asd
View file

@ -1,11 +1,11 @@
(defsystem #:coleslaw (defsystem #:coleslaw
:name "coleslaw-core" :name "coleslaw-core"
:description "Flexible Lisp Blogware" :description "Flexible Lisp Blogware"
:version "0.0.3" :version "0.4"
:license "BSD" :license "BSD"
:author "Brit Butler <redline6561@gmail.com>" :author "Brit Butler <redline6561@gmail.com>"
:pathname "src/" :pathname "src/"
:depends-on (:closure-template :iolib.os :alexandria) :depends-on (:closure-template :iolib.os :alexandria :cl-fad)
:serial t :serial t
:components ((:file "packages") :components ((:file "packages")
(:file "config") (:file "config")

18
src/coleslaw.lisp
View file

@ -17,13 +17,13 @@ If ARGS is provided, use (apply 'format nil PATH ARGS) as the value of PATH."
"For each file under PATH, run BODY. If EXTENSION is provided, only run BODY "For each file under PATH, run BODY. If EXTENSION is provided, only run BODY
on files that match the given extension." on files that match the given extension."
(alexandria:with-gensyms (ext) (alexandria:with-gensyms (ext)
`(iolib.os:mapdir (lambda (x) `(mapcar (lambda (,var)
(let* ((,var (to-pathname x ,path)) ,@(if extension
,@(when extension `((,ext (pathname-type ,var))))) `((let ((,ext (pathname-type ,var)))
,@(if extension (when (and ,ext (string= ,ext ,extension))
`((when (and ,ext (string= ,ext ,extension)) ,@body)))
,@body)) `,body))
`,body))) ,path))) (list-directory ,path))))
(defun render-page (path html) (defun render-page (path html)
"Populate the base template with the provided HTML and write it out to PATH." "Populate the base template with the provided HTML and write it out to PATH."
@ -49,7 +49,7 @@ on files that match the given extension."
(let ((staging #p"/tmp/coleslaw/")) (let ((staging #p"/tmp/coleslaw/"))
; TODO: More incremental compilation? Don't regen whole blog unnecessarily. ; TODO: More incremental compilation? Don't regen whole blog unnecessarily.
(when (probe-file staging) (when (probe-file staging)
(delete-files staging :recursive t)) (delete-directory-and-files staging))
(ensure-directories-exist staging) (ensure-directories-exist staging)
(with-current-directory staging (with-current-directory staging
(let ((css-dir (app-path "themes/~a/css/" (theme *config*))) (let ((css-dir (app-path "themes/~a/css/" (theme *config*)))
@ -72,7 +72,7 @@ on files that match the given extension."
(let ((new-build (app-path "generated/~a" (get-universal-time)))) (let ((new-build (app-path "generated/~a" (get-universal-time))))
(run-program "mv" (list dir (namestring new-build))) (run-program "mv" (list dir (namestring new-build)))
(when (probe-file (app-path ".prev")) (when (probe-file (app-path ".prev"))
(delete-files (read-symlink (app-path ".prev")) :recursive t)) (delete-directory-and-files (read-symlink (app-path ".prev"))))
(when (probe-file (app-path ".curr")) (when (probe-file (app-path ".curr"))
(update-symlink ".prev" (read-symlink (app-path ".curr")))) (update-symlink ".prev" (read-symlink (app-path ".curr"))))
(update-symlink ".curr" new-build)))) (update-symlink ".curr" new-build))))

3
src/packages.lisp
View file

@ -1,7 +1,8 @@
(defpackage :coleslaw (defpackage :coleslaw
(:use :cl :closure-template) (:use :cl :closure-template)
(:import-from :cl-fad #:delete-directory-and-files
#:list-directory)
(:import-from :iolib.os #:with-current-directory (:import-from :iolib.os #:with-current-directory
#:delete-files
#:read-symlink #:read-symlink
#:run-program) #:run-program)
(:import-from :iolib.pathnames #:file-path-namestring) (:import-from :iolib.pathnames #:file-path-namestring)