2011-04-16 15:45:37 -04:00
|
|
|
(in-package :coleslaw)
|
|
|
|
|
2013-01-22 15:13:26 -05:00
|
|
|
(defparameter *injections* '()
|
2012-09-14 18:37:56 -04:00
|
|
|
"A list that stores pairs of (string . predicate) to inject in the page.")
|
2012-08-20 10:44:46 -04:00
|
|
|
|
2012-09-14 18:37:56 -04:00
|
|
|
(defun add-injection (injection location)
|
2012-09-15 17:08:30 -04:00
|
|
|
"Adds an INJECTION to a given LOCATION for rendering. The INJECTION should be
|
|
|
|
a string which will always be added or a (string . lambda). In the latter case,
|
|
|
|
the lambda takes a single argument, a content object, i.e. a POST or INDEX, and
|
|
|
|
any return value other than nil indicates the injection should be added."
|
|
|
|
(let ((result (etypecase injection
|
|
|
|
(string (list injection #'identity))
|
|
|
|
(list injection))))
|
|
|
|
(push result (getf *injections* location))))
|
2012-09-14 18:37:56 -04:00
|
|
|
|
|
|
|
(defun find-injections (content)
|
2013-02-01 11:25:59 -05:00
|
|
|
"Iterate over *INJECTIONS* collecting any that should be added to CONTENT."
|
2012-09-14 18:37:56 -04:00
|
|
|
(flet ((injections-for (location)
|
2012-09-20 18:38:42 -04:00
|
|
|
(loop for (injection predicate) in (getf *injections* location)
|
2012-09-14 18:37:56 -04:00
|
|
|
when (funcall predicate content)
|
|
|
|
collect injection)))
|
|
|
|
(list :head (injections-for :head)
|
|
|
|
:body (injections-for :body))))
|
2011-04-23 00:13:27 -04:00
|
|
|
|
2013-04-18 14:41:43 -04:00
|
|
|
(define-condition theme-does-not-exist (error)
|
2013-04-12 15:45:53 +02:00
|
|
|
((theme :initarg :theme :reader theme))
|
|
|
|
(:report (lambda (c stream)
|
2013-04-18 14:41:43 -04:00
|
|
|
(format stream "Cannot find the theme: '~A'" (theme c)))))
|
2013-04-12 15:45:53 +02:00
|
|
|
|
2013-04-01 11:23:10 -04:00
|
|
|
(defun theme-package (name)
|
2013-04-18 14:41:43 -04:00
|
|
|
"Find the package matching the theme NAME or signal THEME-DOES-NOT-EXIST."
|
2014-05-06 15:19:43 -04:00
|
|
|
(or (find-package (format nil "~:@(coleslaw.theme.~A~)" name))
|
2013-04-18 14:43:24 -04:00
|
|
|
(error 'theme-does-not-exist :theme name)))
|
2011-04-16 15:45:37 -04:00
|
|
|
|
2013-04-01 11:23:10 -04:00
|
|
|
(defun theme-fn (name &optional (package (theme *config*)))
|
|
|
|
"Find the symbol NAME inside PACKAGE which defaults to the theme package."
|
|
|
|
(find-symbol (princ-to-string name) (theme-package package)))
|
2012-08-20 11:06:35 -04:00
|
|
|
|
2012-09-12 12:52:36 -04:00
|
|
|
(defun compile-theme (theme)
|
|
|
|
"Locate and compile the templates for the given THEME."
|
|
|
|
(do-files (file (app-path "themes/~a/" theme) "tmpl")
|
|
|
|
(compile-template :common-lisp-backend file))
|
|
|
|
(do-files (file (app-path "themes/") "tmpl")
|
2012-08-20 10:44:46 -04:00
|
|
|
(compile-template :common-lisp-backend file)))
|