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

coleslaw.lisp 2.8KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172
  1. (in-package :coleslaw)
  2. (defvar *last-revision* nil
  3. "The git revision prior to the last push. For use with GET-UPDATED-FILES.")
  4. (defun main (repo-dir &optional oldrev)
  5. "Load the user's config file, then compile and deploy the blog stored
  6. in REPO-DIR. Optionally, OLDREV is the revision prior to the last push."
  7. (load-config repo-dir)
  8. (setf (repo *config*) repo-dir
  9. *last-revision* oldrev)
  10. (load-content)
  11. (compile-theme (theme *config*))
  12. (let ((dir (staging-dir *config*)))
  13. (compile-blog dir)
  14. (deploy dir)))
  15. (defun load-content ()
  16. "Load all content stored in the blog's repo."
  17. (do-subclasses (ctype content)
  18. (discover ctype))
  19. (update-content-metadata)
  20. (do-subclasses (itype index)
  21. (discover itype)))
  22. (defun compile-blog (staging)
  23. "Compile the blog to a STAGING directory as specified in .coleslawrc."
  24. (ensure-directories-exist staging)
  25. (with-current-directory staging
  26. (dolist (dir (list (app-path "themes/~a/css" (theme *config*))
  27. (app-path "themes/~a/img" (theme *config*))
  28. (app-path "themes/~a/js" (theme *config*))
  29. (merge-pathnames "static" (repo *config*))))
  30. (when (probe-file dir)
  31. (run-program "rsync --delete -raz ~a ." dir)))
  32. (do-subclasses (ctype content)
  33. (publish ctype))
  34. (do-subclasses (itype index)
  35. (publish itype))
  36. (update-symlink "index.html" "1.html")))
  37. (defgeneric deploy (staging)
  38. (:documentation "Deploy the STAGING build to the directory specified in the config.")
  39. (:method (staging)
  40. (let ((destination (deploy-dir *config*)))
  41. (run-program "rsync --delete -avz ~a ~a" staging destination))))
  42. (defun update-symlink (path target)
  43. "Update the symlink at PATH to point to TARGET."
  44. (run-program "ln -sfn ~a ~a" target path))
  45. (defun preview (path &optional (content-type 'post))
  46. "Render the content at PATH under user's configured repo and save it to
  47. ~/tmp.html. Load the user's config and theme if necessary."
  48. (let ((current-working-directory (cl-fad:pathname-directory-pathname path)))
  49. (unless *config*
  50. (load-config (namestring current-working-directory))
  51. (compile-theme (theme *config*)))
  52. (let* ((file (rel-path (repo *config*) path))
  53. (content (construct content-type (read-content file))))
  54. (write-file "tmp.html" (render-page content)))))
  55. (defun render-page (content &optional theme-fn &rest render-args)
  56. "Render the given CONTENT to HTML using THEME-FN if supplied.
  57. Additional args to render CONTENT can be passed via RENDER-ARGS."
  58. (funcall (or theme-fn (theme-fn 'base))
  59. (list :config *config*
  60. :content content
  61. :raw (apply 'render content render-args)
  62. :pubdate (format-rfc1123-timestring nil (local-time:now))
  63. :injections (find-injections content))))