coleslaw/src/coleslaw.lisp - Recently Written

src/coleslaw.lisp (3310 bytes)
1 (in-package :coleslaw)
2 
3 (defvar *last-revision* nil
4   "The git revision prior to the last push. For use with GET-UPDATED-FILES.")
5 
6 (defun main (repo-dir &key oldrev (deploy t))
7   "Load the user's config file, compile the blog in REPO-DIR into STAGING-DIR,
8  and optionally deploy the blog to DEPLOY-DIR.
9   OLDREV -- the git revision prior to the last push.
10   DEPLOY -- when non-nil, perform the deploy. (default: t)"
11   (load-config repo-dir)
12   (setf *last-revision* oldrev)
13   (load-content)
14   (compile-theme (theme *config*))
15   (let ((dir (staging-dir *config*)))
16     (compile-blog dir)
17     (when deploy
18       (deploy dir))))
19 
20 (defun load-content ()
21   "Load all content stored in the blog's repo."
22   (do-subclasses (ctype content)
23     (discover ctype))
24   (update-content-metadata)
25   (do-subclasses (itype index)
26     (discover itype)))
27 
28 (defun compile-blog (staging)
29   "Compile the blog to a STAGING directory as specified in .coleslawrc."
30   (ensure-directories-exist staging)
31   (with-current-directory staging
32     (let ((theme-dir (find-theme (theme *config*))))
33       (dolist (dir (list (merge-pathnames "css" theme-dir)
34                          (merge-pathnames "img" theme-dir)
35                          (merge-pathnames "js" theme-dir)
36                          (repo-path "static")))
37         (when (probe-file dir)
38           (if (uiop:os-windows-p)
39               (run-program "(robocopy ~a ~a /MIR /IS) ^& IF %ERRORLEVEL% LEQ 1 exit 0" dir (path:basename dir))
40               (run-program "rsync --delete -raz ~a ." dir)))))
41     (do-subclasses (ctype content)
42       (publish ctype))
43     (do-subclasses (itype index)
44       (publish itype))
45     (let ((recent-posts (reduce #'(lambda (a b)
46                                     (if (< (index-name a) (index-name b))
47                                         a b))
48                                 (find-all 'numeric-index))))
49       (update-symlink "index.html" (page-url recent-posts)))))
50 
51 (defgeneric deploy (staging)
52   (:documentation "Deploy the STAGING build to the directory specified in the config.")
53   (:method (staging)
54     "By default, do nothing"
55     (declare)))
56 
57 (defun update-symlink (path target)
58   "Update the symlink at PATH to point to TARGET."
59   (run-program "ln -sfn ~a ~a" target path))
60 
61 (defun preview (path &optional (content-type 'post))
62   "Render the content at PATH under user's configured repo and save it to
63 ~/tmp.html. Load the user's config and theme if necessary."
64   (let ((current-working-directory (cl-fad:pathname-directory-pathname path)))
65     (unless *config*
66       (load-config (namestring current-working-directory))
67       (compile-theme (theme *config*)))
68     (let* ((file (rel-path (repo-dir *config*) path))
69            (content (construct content-type (read-content file))))
70       (write-file "tmp.html" (render-page content)))))
71 
72 (defun render-page (content &optional theme-fn &rest render-args)
73   "Render the given CONTENT to HTML using THEME-FN if supplied.
74 Additional args to render CONTENT can be passed via RENDER-ARGS."
75   (funcall (or theme-fn (theme-fn 'base))
76            (list :config *config*
77                  :content content
78                  :raw (apply 'render content render-args)
79                  :pubdate (format-rfc1123-timestring nil (local-time:now))
80                  :injections (find-injections content))))