Flexible Lisp Blogware. Fork for personal use. Mirrored from https://github.com/kingcons/coleslaw originally.

themes.lisp 1.9KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445
  1. (in-package :coleslaw)
  2. (defparameter *injections* '()
  3. "A list that stores pairs of (string . predicate) to inject in the page.")
  4. (defun add-injection (injection location)
  5. "Adds an INJECTION to a given LOCATION for rendering. The INJECTION should be
  6. a string which will always be added or a (string . lambda). In the latter case,
  7. the lambda takes a single argument, a content object, i.e. a POST or INDEX, and
  8. any return value other than nil indicates the injection should be added."
  9. (let ((result (etypecase injection
  10. (string (list injection #'identity))
  11. (list injection))))
  12. (push result (getf *injections* location))))
  13. (defun find-injections (content)
  14. "Iterate over *INJECTIONS* collecting any that should be added to CONTENT."
  15. (flet ((injections-for (location)
  16. (loop for (injection predicate) in (getf *injections* location)
  17. when (funcall predicate content)
  18. collect injection)))
  19. (list :head (injections-for :head)
  20. :body (injections-for :body))))
  21. (define-condition theme-does-not-exist (error)
  22. ((theme :initarg :theme :reader theme))
  23. (:report (lambda (c stream)
  24. (format stream "Cannot find the theme: '~A'" (theme c)))))
  25. (defun theme-package (name)
  26. "Find the package matching the theme NAME or signal THEME-DOES-NOT-EXIST."
  27. (or (find-package (format nil "~:@(coleslaw.theme.~A~)" name))
  28. (error 'theme-does-not-exist :theme name)))
  29. (defun theme-fn (name &optional (package (theme *config*)))
  30. "Find the symbol NAME inside PACKAGE which defaults to the theme package."
  31. (find-symbol (princ-to-string name) (theme-package package)))
  32. (defun compile-theme (theme)
  33. "Locate and compile the templates for the given THEME."
  34. (do-files (file (app-path "themes/~a/" theme) "tmpl")
  35. (compile-template :common-lisp-backend file))
  36. (do-files (file (app-path "themes/") "tmpl")
  37. (compile-template :common-lisp-backend file)))