Merge pull request #98 from ljanyst/user-themes

Allow for themes defines in the user repo

src/coleslaw.lisp

@@ -26,12 +26,13 @@ in REPO-DIR. Optionally, OLDREV is the revision prior to the last push."
   "Compile the blog to a STAGING directory as specified in .coleslawrc."
   (ensure-directories-exist staging)
   (with-current-directory staging
-    (dolist (dir (list (app-path "themes/~a/css" (theme *config*))
-                       (app-path "themes/~a/img" (theme *config*))
-                       (app-path "themes/~a/js" (theme *config*))
-                       (merge-pathnames "static" (repo-dir *config*))))
+    (let ((theme-dir (find-theme (theme *config*))))
+      (dolist (dir (list (merge-pathnames "css" theme-dir)
+                         (merge-pathnames "img" theme-dir)
+                         (merge-pathnames "js" theme-dir)
+                         (repo-path "static")))
         (when (probe-file dir)
-        (run-program "rsync --delete -raz ~a ." dir)))
+          (run-program "rsync --delete -raz ~a ." dir))))
     (do-subclasses (ctype content)
       (publish ctype))
     (do-subclasses (itype index)

src/themes.lisp

@@ -30,9 +30,16 @@ function that takes a DOCUMENT and returns NIL or a STRING for template insertio
   "Find the symbol NAME inside PACKAGE which defaults to the theme package."
   (find-symbol (princ-to-string name) (theme-package package)))
 
+(defun find-theme (theme)
+  "Find the theme prefering themes in the local repo."
+  (let ((local-theme (repo-path "themes/~a/" theme)))
+    (if (probe-file local-theme)
+        local-theme
+        (app-path "themes/~a/" theme))))
+
 (defun compile-theme (theme)
   "Locate and compile the templates for the given THEME."
-  (do-files (file (app-path "themes/~a/" theme) "tmpl")
+  (do-files (file (find-theme theme) "tmpl")
     (compile-template :common-lisp-backend file))
   (do-files (file (app-path "themes/") "tmpl")
     (compile-template :common-lisp-backend file)))

src/util.lisp

@@ -71,6 +71,10 @@ If ARGS is provided, use (fmt path args) as the value of PATH."
   "Return a relative path beneath coleslaw."
   (apply 'rel-path coleslaw-conf:*basedir* path args))
 
+(defun repo-path (path &rest args)
+  "Return a relative path beneath the repo being processed."
+  (apply 'rel-path (repo-dir *config*) path args))
+
 (defun run-program (program &rest args)
   "Take a PROGRAM and execute the corresponding shell command. If ARGS is provided,
 use (fmt program args) as the value of PROGRAM."