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

Factor out the FORMAT NIL pattern in SHELL-COMMAND usage.

Browse source
This commit is contained in:
Brit Butler 2012-08-29 11:34:05 -04:00
parent 5e4f21d2ff
commit 1cff1093a9
3 changed files with 11 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
src/coleslaw.lisp
View file

@ -32,15 +32,11 @@ If RAW is non-nil, write the content without wrapping it in the base template."
(static-dir (merge-pathnames "static" (repo *config*)))) (static-dir (merge-pathnames "static" (repo *config*))))
(dolist (dir (list css-dir static-dir)) (dolist (dir (list css-dir static-dir))
(when (probe-file dir) (when (probe-file dir)
(shell-command (format nil "cp -R ~a ." dir))))) (run-program "cp -R ~a ." dir))))
(render-posts) (render-posts)
(render-indices) (render-indices)
(render-feed))) (render-feed)))
(defun update-symlink (path target)
"Update the symlink at PATH to point to TARGET."
(shell-command (format nil "ln -sfn ~a ~a" target path)))
(defgeneric deploy (staging) (defgeneric deploy (staging)
(:documentation "Deploy the STAGING dir, updating the .prev and .curr symlinks.") (:documentation "Deploy the STAGING dir, updating the .prev and .curr symlinks.")
(:method (staging) (:method (staging)
@ -51,7 +47,7 @@ If RAW is non-nil, write the content without wrapping it in the base template."
(curr (deploy-path ".curr"))) (curr (deploy-path ".curr")))
(ensure-directories-exist new-build) (ensure-directories-exist new-build)
(with-current-directory coleslaw-conf:*basedir* (with-current-directory coleslaw-conf:*basedir*
(shell-command (format nil "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)))

1
src/packages.lisp
View file

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

9
src/util.lisp
View file

@ -5,6 +5,15 @@
If ARGS is provided, use (apply 'format nil PATH ARGS) as the value of PATH." If ARGS is provided, use (apply 'format nil PATH ARGS) as the value of PATH."
(merge-pathnames (apply 'format nil path args) coleslaw-conf:*basedir*)) (merge-pathnames (apply 'format nil path args) coleslaw-conf:*basedir*))
(defun run-program (program &rest args)
"Take a PROGRAM and execute the corresponding shell command. If ARGS is provided,
use (apply 'format nil PROGRAM ARGS) as the value of PROGRAM."
(trivial-shell:shell-command (apply 'format nil program args)))
(defun update-symlink (path target)
"Update the symlink at PATH to point to TARGET."
(run-program "ln -sfn ~a ~a" target path))
(defmacro do-files ((var path &optional extension) &body body) (defmacro do-files ((var path &optional extension) &body body)
"For each file on PATH, run BODY. If EXTENSION is provided, only run BODY "For each file on PATH, run BODY. If EXTENSION is provided, only run BODY
on files that match the given extension." on files that match the given extension."