Refactors to indices, pervasive docstrings.

This commit is contained in:
Brit Butler 2012-08-20 17:26:12 -04:00
parent a2c6be20bf
commit ef38d2874f
5 changed files with 55 additions and 33 deletions

2
TODO
View file

@ -13,7 +13,7 @@ Plugins? Injection support for HEAD and BODY. What about predicate-based injecti
How is it served? Hunchentoot, Lighttpd, S3, whomever!
TODO:
; implement read-post, render-by-month
; implement read-post
; fix plugins: s3, wordpress
; doc themes and plugins
; implement plugins: atom, markdown, pygment/highlighting

View file

@ -21,22 +21,8 @@ on files that match the given extension."
,@body))
`,body))) ,path)))
(defun compile-blog ()
(let ((staging #p"/tmp/coleslaw/"))
; TODO: More incremental compilation? Don't regen whole blog unnecessarily.
(if (probe-file staging)
(delete-files staging :recursive t)
(ensure-directories-exist staging))
(with-current-directory staging
(let ((css-dir (app-path "themes/~a/css/" (theme *config*)))
(static-dir (merge-pathnames "static/" (repo *config*))))
(dolist (dir (list css-dir static-dir))
(run-program "cp" `("-R" ,dir "."))))
(render-posts)
(render-indices))
(deploy staging)))
(defun render-page (path html)
"Populate the base template with the provided HTML and write it out to PATH."
(ensure-directories-exist path)
(with-open-file (out path
:direction :output
@ -54,6 +40,22 @@ on files that match the given extension."
:credits (author *config*)))))
(write content out))))
(defun compile-blog ()
"Compile the blog to a staging directory in /tmp."
(let ((staging #p"/tmp/coleslaw/"))
; TODO: More incremental compilation? Don't regen whole blog unnecessarily.
(if (probe-file staging)
(delete-files staging :recursive t)
(ensure-directories-exist staging))
(with-current-directory staging
(let ((css-dir (app-path "themes/~a/css/" (theme *config*)))
(static-dir (merge-pathnames "static/" (repo *config*))))
(dolist (dir (list css-dir static-dir))
(run-program "cp" `("-R" ,dir "."))))
(render-posts)
(render-indices))
(deploy staging)))
(defun update-symlink (name target)
"Update the symlink NAME to point to TARGET."
(run-program "ln" (list "-sfn" (namestring target) name)))

View file

@ -1,18 +1,27 @@
(in-package :coleslaw)
(defun all-months ()
"Retrieve a list of all months with published posts."
(remove-duplicates (mapcar (lambda (x) (subseq (post-date x) 0 7)) *posts*)))
(defun all-tags ()
"Retrieve a list of all tags used in posts."
(remove-duplicates (mapcan #'post-tags *posts*) :test #'string=))
(defun taglinks ()
(let ((tags (remove-duplicates (mapcar #'post-tags *posts*))))
(loop for tag in tags
collect (list :url (format nil "~a/tag/~a.html" (domain *config*) tag)
:name tag))))
"Generate links to all the tag indices."
(loop for tag in (all-tags)
collect (list :url (format nil "~a/tag/~a.html" (domain *config*) tag)
:name tag)))
(defun monthlinks ()
(let ((months (mapcar (lambda (x) (get-month (post-date x))) *posts*)))
(loop for month in months
collect (list :url (format nil "~a/month/~a.html" (domain *config*) month)
:name month))))
"Generate links to all the month indices."
(loop for month in (all-months)
collect (list :url (format nil "~a/date/~a.html" (domain *config*) month)
:name month)))
(defun write-index (posts filename title)
"Write out the HTML for POSTS to FILENAME.html."
(let ((content (loop for post in posts
collect (list :url (format nil "~a/posts/~a.html"
(domain *config*) (post-slug post))
@ -30,6 +39,7 @@
:next nil)))))
(defun render-by-20 ()
"Render the indices to view posts in reverse chronological order by 20."
(flet ((by-20 (posts start)
(let ((index (* 20 (1- start))))
(subseq posts index (min (length posts) (+ index 19))))))
@ -39,15 +49,16 @@
do (write-index (by-20 posts i) (format nil "~d.html" i) "Recent Posts")))))
(defun render-by-tag ()
(let ((tags (remove-duplicates (mapcan #'post-tags *posts*) :test #'string=)))
(loop for tag in tags
do (flet ((match-tag (post)
(member tag post :test #'string= :key #'post-tags)))
(let ((posts (remove-if-not #'match-tag posts)))
(write-index posts (format nil "tag/~a.html" tag)
(format nil "Posts tagged ~a" tag)))))))
"Render the indices to view posts by tag."
(loop for tag in (all-tags)
do (flet ((match-tag (post)
(member tag post :test #'string= :key #'post-tags)))
(let ((posts (remove-if-not #'match-tag posts)))
(write-index posts (format nil "tag/~a.html" tag)
(format nil "Posts tagged ~a" tag))))))
(defun render-by-month ()
"Render the indices to view posts by month."
(let ((months (remove-duplicates (mapcar (lambda (x) (subseq (post-date x) 0 7))
*posts*) :test #'string=)))
(loop for month in months
@ -57,6 +68,7 @@
(format nil "Posts from ~a" (subseq month 0 7)))))))
(defun render-indices ()
"Render the indices to view posts in groups of 20, by month, and by tag."
(render-by-20)
(render-by-tag)
(render-by-month))

View file

@ -1,6 +1,7 @@
(in-package :coleslaw)
(defparameter *posts* (make-hash-table :test #'equal))
(defparameter *posts* (make-hash-table :test #'equal)
"A hash table to store all the posts and their metadata.")
(defclass post ()
((slug :initform nil :initarg :slug :accessor post-slug)
@ -12,6 +13,7 @@
(aliases :initform nil :initarg :aliases :accessor post-aliases)))
(defun render-posts ()
"Iterate through the files in the repo to render+write the posts out to disk."
(do-files (file (repo *config*) "post")
(with-open-file (in file)
(let ((post (read-post in)))
@ -35,10 +37,12 @@
:next nil))))
(defun slug-char-p (char)
"Determine if CHAR is a valid slug (i.e. URL) character."
(or (char<= #\0 char #\9)
(char<= #\a char #\z)
(char<= #\A char #\Z)
(member char '(#\_ #\-))))
(defun slugify (string)
"Return a version of STRING suitable for use as a URL."
(remove-if-not #'slug-char-p (substitute #\- #\Space string)))

View file

@ -1,6 +1,7 @@
(in-package :coleslaw)
(defparameter *injections* (make-hash-table :test #'equal))
(defparameter *injections* (make-hash-table :test #'equal)
"A hash table for storing JS to inject in the theme templates.")
(defgeneric add-injection (str location)
(:documentation "Add STR to the list of elements injected in LOCATION.")
@ -14,12 +15,15 @@
(remove str (gethash location *injections*) :test #'string=))))
(defun theme-package (&key (name (theme *config*)))
"Find the package matching the theme NAME."
(find-package (string-upcase (concatenate 'string "coleslaw.theme." name))))
(defun theme-fn (name)
"Find the symbol NAME inside the current theme's package."
(find-symbol name (theme-package)))
(defun compile-theme (&key (theme-dir (app-path "themes/~a/" (theme *config*))))
"Iterate over the files in THEME-DIR, compiling them when they are templates."
(do-files (file theme-dir "tmpl")
(compile-template :common-lisp-backend file)))