marcuskammer/coleslaw
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge pull request #46 from redline6561/better-indexes

Browse source 
Release: 0.9.3!
This commit is contained in:
Brit Butler 2014-04-15 22:11:02 -04:00
commit 5705e3a7dc
25 changed files with 497 additions and 343 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
NEWS.md
View file

@ -1,3 +1,13 @@
## Changes for 0.9.3 (2013-04-16):
* **INCOMPATIBLE CHANGE**: `page-path` and the `blog` config class are no longer exported.
* New Docs: [A Hacker's Guide to Coleslaw](hacking_guide) and [Themes](theming_guide)!
* A new theme *readable* based on bootswatch readable, courtesy of @rmoritz!
* Posts may have an author to support multi-user blogs courtesy of @tychoish.
* Fixes to the ReStructuredText plugin courtesy of @tychoish.
* UTF-8 fixes for config files and site content courtesy of @cl-ment.
* Fix timestamps in the sitemap plugin courtesy of @woudshoo.
## Changes for 0.9.2 (2013-05-11):
* **INCOMPATIBLE CHANGE**: Renamed staging, deploy config options staging-dir, deploy-dir.
@ -52,3 +62,6 @@
## Changes for 0.5 (2012-08-22):
* Initial release.
[hacking_guide]: https://github.com/redline6561/coleslaw/blob/master/docs/hacking.md
[theming_guide]: https://github.com/redline6561/coleslaw/blob/master/docs/themes.md

2
README.md
View file

@ -56,4 +56,4 @@ your post
```
## Theming
A default theme, hyde, is provided. Themes are made using Google's closure-template and the source for [hyde](https://github.com/redline6561/coleslaw/tree/master/themes/hyde) should be simple and instructive until I can provide better docs.
Two themes are provided: hyde and readable (based on [bootswatch readable](http://bootswatch.com/readable/)). Hyde is the default. A guide to creating themes for coleslaw lives [here](https://github.com/redline6561/coleslaw/blob/master/docs/themes.md).

2
TODO
View file

@ -1,7 +1,5 @@
TODO:
Coleslaw.next
; See if there are any good ideas we can steal from [Frog](https://github.com/greghendershott/frog)
; Add HACKING.md docs, i.e. formalize workflow+releases. No more landing broken stuff on master!
;; needs: shout template/render function. Twitter\Disqus integration with shouts?
;; Rename index.posts to something else?
; Incremental compilation: only "touched" posts+tags+months and by-n. -> 1.0

6
coleslaw.asd
View file

@ -1,7 +1,7 @@
(defsystem #:coleslaw
:name "coleslaw"
:description "Flexible Lisp Blogware"
:version "0.9.2"
:version "0.9.3"
:license "BSD"
:author "Brit Butler <redline6561@gmail.com>"
:pathname "src/"
@ -19,10 +19,10 @@
(:file "util")
(:file "config")
(:file "themes")
(:file "documents")
(:file "content")
(:file "posts")
(:file "indices")
(:file "feeds")
(:file "indexes")
(:file "coleslaw"))
:in-order-to ((test-op (load-op coleslaw-tests)))
:perform (test-op :after (op c)

169
docs/hacking.md
View file

@ -20,36 +20,84 @@ will checkout the repo to a **$TMPDIR** and call `(coleslaw:main $TMPDIR)`.
It is then coleslaw's job to load all of your content, your config and
templates, and render the content to disk. Deployment is done by
updating a symlink and the default install assumes your webserver will
be configured to serve from that symlink. However, there are plugins
for deploying to Heroku, S3, and Github Pages.
moving the files to a location specified in the config and updating a
symlink. It is assumed a web server is set up to serve from that
symlink. However, there are plugins for deploying to Heroku, S3, and
Github Pages.
### Blogs vs Sites
**Coleslaw** is blogware. When I designed it, I only cared that it
could replace my server's wordpress install. As a result, the code is
still structured in terms of POSTs and INDEXes. Roughly speaking, a
POST is a blog entry and an INDEX is a collection of POSTs or other
content. An INDEX really only serves to group a set of content objects
on a page, it isn't content itself.
could replace my server's wordpress install. As a result, the code
until very recently was structured in terms of POSTs and
INDEXes. Roughly speaking, a POST is a blog entry and an INDEX is a
collection of POSTs or other content. An INDEX really only serves to
group a set of content objects on a page, it isn't content itself.
This isn't ideal if you're looking for a full-on static site
generator. Content Types were added in 0.8 as a step towards making
*coleslaw* suitable for more use cases but still have some
limitations. Chiefly, the association between Content Types, their
template, and their inclusion in an INDEX is presently ad-hoc.
limitations. Any subclass of CONTENT that implements the *document
protocol* counts as a content type. However, only POSTs are currently
included on INDEXes since their isn't yet a formal relationship to
determine what content types should be included on which indexes.
### Current Content Types & Indices
### The Document Protocol
There are 3 INDEX subclasses at present: TAG-INDEX, DATE-INDEX, and
NUMERIC-INDEX, for grouping content by tags, publishing date, and
reverse chronological order, respectively. Currently, there is only 1
content type: POST, for blog entries.
The *document protocol* was born during a giant refactoring in 0.9.3.
Any object that will be rendered to HTML should adhere to the protocol.
Subclasses of CONTENT (content types) that implement the protocol will
be seamlessly picked up by *coleslaw* and included on the rendered site.
All current Content Types and Indexes implement the protocol faithfully.
It consists of 2 "class" methods, 2 instance methods, and an invariant.
* Class Methods:
Since Common Lisp doesn't have explicit support for class methods, we
implement them by eql-specializing on the class, e.g.
```lisp
(defmethod foo ((doc-type (eql (find-class 'bar))))
... )
```
- `discover`: Create instances for documents of the class and put them in
in-memory database with `add-document`. If your class is a subclass of
CONTENT, there is a default method for this.
- `publish`: Iterate over all objects of the class
* Instance Methods:
- `page-url`: Generate a unique, relative path for the object on the site
sans file extension. An :around method adds that later. The `slug` slot
on the object is generally used to hold a portion of the unique
identifier. i.e. `(format nil "posts/~a" (content-slug object))`.
- `render`: A method that calls the appropriate template with `theme-fn`,
passing it any needed arguments and returning rendered HTML.
* Invariants:
- Any Content Types (subclasses of CONTENT) are expected to be stored in
the site's git repo with the lowercased class-name as a file extension,
i.e. (".post" for POST files).
### Current Content Types & Indexes
There are 5 INDEX subclasses at present: TAG-INDEX, MONTH-INDEX,
NUMERIC-INDEX, FEED, and TAG-FEED. Respectively, they support
grouping content by tags, publishing date, and reverse chronological
order. Feeds exist to special case RSS and ATOM generation.
Currently, there is only 1 content type: POST, for blog entries.
I'm planning to add a content type PAGE, for static pages. It should
be a pretty straightforward subclass of CONTENT with the necessary
methods: `render`, `page-url` and `publish`, but will require a small
tweak to prevent showing up in any INDEX.
methods: `render`, `page-url` and `publish`. It could have a `url`
slot with `page-url` as a reader to allow arbitrary layout on the site.
The big question is how to handle templating and how indexes or other
content should link to it.
### Templates and Theming
@ -57,41 +105,42 @@ User configs are allowed to specify a theme, otherwise the default is
used. A theme consists of a directory under "themes/" containing css,
images, and at least 3 templates: Base, Index, and Post.
**Coleslaw** exclusively uses
**Coleslaw** uses
[cl-closure-template](https://github.com/archimag/cl-closure-template)
for templating which is a well documented CL implementation of
Google's Closure Templates. Each template file should be in a
namespace like `coleslaw.theme.theme-name`.
exclusively for templating. **cl-closure-template** is a well
documented CL implementation of Google's Closure Templates. Each
template file should contain a namespace like
`coleslaw.theme.theme-name`.
Each template creates a lisp function in the theme's package when
loaded. These functions take a property list (or plist) as an argument
and return rendered HTML. **Coleslaw** defines a helper called
`theme-fn` for easy access to the template functions.
`theme-fn` for easy access to the template functions. Additionally,
there are RSS, ATOM, and sitemap templates *coleslaw* uses automatically.
No need for individual themes to reimplement a standard, after all!
// TODO: Update for changes to compile-blog, indexes refactor, etc.
### The Lifecycle of a Page
- `(load-content)`
A page starts, obviously, with a file. When
*coleslaw* loads your content, it iterates over a list of content
types (i.e. subclasses of CONTENT). For each content type, it
iterates over all files in the repo with a matching extension,
e.g. ".post" for POSTs. Objects of the appropriate class are created
from each matching file and inserted into the `*content*` hash-table.
A page starts, obviously, with a file. When *coleslaw* loads your
content, it iterates over a list of content types (i.e. subclasses of
CONTENT). For each content type, it iterates over all files in the
repo with a matching extension, e.g. ".post" for POSTs. Objects of the
appropriate class are created from each matching file and inserted
into the an in-memory data store. Then the INDEXes are created by
iterating over the POSTs and inserted into the data store.
- `(compile-blog dir)`
Compilation starts by ensuring the staging directory (`/tmp/coleslaw/`
by default) exists, cd'ing there, and copying over any necessary theme
assets. Then *coleslaw* iterates over the content types, calling the
`publish` method on each one. Publish creates any non-INDEX pages for
the objects of that content type by iterating over the objects in an
appropriate fashion, rendering them, and passing the result to
`write-page` (which should probably just be renamed to `write-file`).
After this, `render-indices` and `render-feeds` are called, and an
'index.html' symlink is created to point to the first reverse
chronological index.
assets. Then *coleslaw* iterates over the content types and index classes,
calling the `publish` method on each one. Publish iterates over the
class instances, rendering each one and writing the result out to disk
with `write-page` (which should probably just be renamed to `write-file`).
After this, an 'index.html' symlink is created to point to the first index.
- `(deploy dir)`
@ -102,10 +151,29 @@ freshly built site.
## Areas for Improvement
### Render Function Cleanup
There are currently 3 render-foo* functions and 3 implementations of the
render method. Only the render-foo* functions call `write-page` so there
should be some room for cleanup here. The render method implementations
are probably necessary unless we want to start storing their arguments
on the models. There may be a different way to abstract the data flow.
### User-Defined Routing
There is no reason *coleslaw* should be in charge of the site layout or
should care. If all objects only used the *slug* slot in their `page-url`
methods, there could be a :routing argument in the config containing
a plist of `(:class "~{format string~}")` pairs. A default method could
check the :class key under `(routing *config*)` if no specialized
`page-url` was defined. This would have the additional benefit of
localizing all the site routing in one place. New Content Types would
probably `pushnew` a plist onto the config key in their `enable` function.
### Better Content Types
Creating a new content type should be both straightforward and doable
as a plugin. All that is really required is a subclass of CONTENT with
Creating a new content type is both straightforward and doable as a
plugin. All that is really required is a subclass of CONTENT with
any needed slots, a template, a `render` method to call the template
with any needed options, a `page-url` method for layout, and a
`publish` method.
@ -115,10 +183,12 @@ Unfortunately, this does not solve:
1. The issue of compiling the template at load-time and making sure it
was installed in the theme package. The plugin would need to do
this itself or the template would need to be included in 'core'.
Thankfully, this should be easy with *cl-closure-template*.
2. More seriously, there is no formal relationship between content
types and indices. Indices include *ALL* objects in the `*content*`
hash table. This may be undesirable and doesn't permit indices
dedicated to particular content types.
types and indexes. Consequentially, INDEXes include only POST
objects at the moment. Whether the INDEX should specify what
Content Types it includes or the CONTENT which indexes it appears
on is not yet clear.
### New Content Type: Shouts!
@ -130,19 +200,10 @@ tabs or stored on twitter's servers. It would be cool to see SHOUTs as
a plugin, probably with a dedicated SHOUT-INDEX, and some sort of
oEmbed/embed.ly/noembed support.
### Layouts and Paths
Defining a page-url for every content-object and index seems a bit
silly. It also spreads information about the site layout throughout
the codebase, it might be better to have a slot in the config that
defines this information with a key to go with each format string.
Adding a new content-type as a plugin could then provide a default
by banging on the config or specify the path in its `enable` options.
### Incremental Compilation
Incremental compilation is doable, even straightforward if you ignore
indices. It is also preferable to building the site in parallel as
indexes. It is also preferable to building the site in parallel as
avoiding work is better than using more workers. Moreover, being
able to determine (and expose) what files just changed enables new
functionality such as plugins that cross-post to tumblr.
@ -158,6 +219,6 @@ things the existing deployment model would not work as it involves
rebuilding the entire site. In all likelihood we would want to update
the site 'in-place'. Atomicity of filesystem operations would be a
reasonable concern. Also, every numbered INDEX would have to be
regenerated along with any tag or month indices matching the
regenerated along with any tag or month indexes matching the
modified files. If incremental compilation is a goal, simply
disabling the indices may be appropriate for certain users.
disabling the indexes may be appropriate for certain users.

10
docs/themes.md
View file

@ -4,9 +4,10 @@ The theming support in coleslaw is very flexible and relatively easy
to use. However it does require some knowledge of HTML, CSS, and how
coleslaw processes content.
To understand how coleslaw processes a blog, a look at the [overview][ovr]
documentation may prove useful. This document will focus mainly on the
template engine and how you can influence the resulting HTML.
To understand how coleslaw processes a blog, a look at the
[overview][ovr] and [hacking][hck] documentation may prove
useful. This document will focus mainly on the template engine and how
you can influence the resulting HTML.
**NOTE**: Themes are not able to change the generated file names or the
generated file structure on disk. They can change the resulting HTML, nothing more.
@ -219,7 +220,8 @@ Good luck!
As mentioned earlier, most files have a file name which is a slug of
some sort. So if you want to create a link to a tag file you should
do something like this: `<a href="${config.domain}/tags/{$tag.slug}">{$tag.name}</a>`.
do something like this: `<a href="${config.domain}/tags/{$tag.slug}.{$config.pageExt}">{$tag.name}</a>`.
[clt]: https://developers.google.com/closure/templates/
[ovr]: https://github.com/redline6561/coleslaw/blob/master/docs/overview.md
[hck]: https://github.com/redline6561/coleslaw/blob/master/docs/hacking.md

11
plugins/mathjax.lisp
View file

@ -4,10 +4,8 @@
(:import-from :coleslaw #:add-injection
#:content
#:index
#:content-tags
#:index-posts
#:make-tag
#:tag-slug=))
#:tag-p
#:index-content))
(in-package :coleslaw-mathjax)
@ -19,11 +17,12 @@
(defun enable (&key force config (preset "TeX-AMS-MML_HTMLorMML")
(location "http://cdn.mathjax.org/mathjax/latest/MathJax.js"))
(labels ((math-post-p (obj)
(member (make-tag "math") (content-tags obj) :test #'tag-slug=))
;; Would it be better to test against latex than math, here?
(tag-p "math" obj))
(mathjax-p (obj)
(or force
(etypecase obj
(content (math-post-p obj))
(index (some #'math-post-p (index-posts obj)))))))
(index (some #'math-post-p (index-content obj)))))))
(let ((mathjax-header (format nil *mathjax-header* config location preset)))
(add-injection (list mathjax-header #'mathjax-p) :head))))

6
plugins/sitemap.lisp
View file

@ -18,12 +18,12 @@
(in-package :coleslaw-sitemap)
(defmethod deploy :before (staging)
"Render sitemap.xml under document root"
"Render sitemap.xml under document root."
(declare (ignore staging))
(let ((urls (append '("" "sitemap.xml") ; empty string is for root url
(mapcar #'page-url (find-all 'coleslaw:post)))))
(mapcar #'page-url (hash-table-values coleslaw::*site*)))))
(write-page (rel-path (staging-dir *config*) "sitemap.xml")
(funcall (theme-fn 'sitemap "feeds")
(funcall (theme-fn 'sitemap "sitemap")
(list :config *config*
:urls urls
:pubdate (format-timestring nil (now)))))))

121
src/coleslaw.lisp
View file

@ -1,7 +1,62 @@
(in-package :coleslaw)
(defgeneric render (object &key &allow-other-keys)
(:documentation "Render the given OBJECT to HTML."))
(defun main (&optional config-key)
"Load the user's config file, then compile and deploy the site."
(load-config config-key)
(load-content)
(compile-theme (theme *config*))
(let ((dir (staging-dir *config*)))
(compile-blog dir)
(deploy dir)))
(defun load-content ()
"Load all content stored in the blog's repo."
(do-subclasses (ctype content)
(discover ctype))
(do-subclasses (itype index)
(discover itype)))
(defun compile-blog (staging)
"Compile the blog to a STAGING directory as specified in .coleslawrc."
(ensure-directories-exist staging)
(with-current-directory staging
(dolist (dir (list (app-path "themes/~a/css" (theme *config*))
(app-path "themes/~a/img" (theme *config*))
(app-path "themes/~a/js" (theme *config*))
(merge-pathnames "static" (repo *config*))))
(when (probe-file dir)
(run-program "rsync --delete -raz ~a ." dir)))
(do-subclasses (ctype content)
(publish ctype))
(do-subclasses (itype index)
(publish itype))
(update-symlink "index.html" "1.html")))
(defgeneric deploy (staging)
(:documentation "Deploy the STAGING dir, updating the .prev and .curr symlinks.")
(:method (staging)
(let* ((dest (deploy-dir *config*))
(new-build (rel-path dest "generated/~a" (get-universal-time)))
(prev (rel-path dest ".prev"))
(curr (rel-path dest ".curr")))
(ensure-directories-exist new-build)
(run-program "mv ~a ~a" staging new-build)
(when (and (probe-file prev) (truename prev))
(run-program "rm -r ~a" (truename prev)))
(when (probe-file curr)
(update-symlink prev (truename curr)))
(update-symlink curr new-build))))
(defun preview (path &optional (content-type 'post))
"Render the content at PATH under user's configured repo and save it to
~/tmp.html. Load the user's config and theme if necessary."
(let ((current-working-directory (cl-fad:pathname-directory-pathname path)))
(unless *config*
(load-config (namestring current-working-directory))
(compile-theme (theme *config*)))
(let* ((file (rel-path (repo *config*) path))
(content (construct content-type (read-content file))))
(write-page "tmp.html" (render-page content)))))
(defgeneric render-content (text format)
(:documentation "Compile TEXT from the given FORMAT to HTML for display.")
@ -12,18 +67,6 @@
(with-output-to-string (str)
(3bmd:parse-string-and-print-to-stream text str)))))
(defgeneric page-url (object)
(:documentation "The url to the object, without the domain."))
(defmethod page-url :around ((object t))
(let ((result (call-next-method))
(extension (if (string= (page-ext *config*) "/")
"html"
(page-ext *config*))))
(if (pathname-type result)
result
(make-pathname :type extension :defaults result))))
(defun page-path (object)
"The path to store OBJECT at once rendered."
(rel-path (staging-dir *config*) (namestring (page-url object))))
@ -47,53 +90,3 @@ Additional args to render CONTENT can be passed via RENDER-ARGS."
:if-does-not-exist :create
:external-format '(:utf-8))
(write-line page out)))
(defun compile-blog (staging)
"Compile the blog to a STAGING directory as specified in .coleslawrc."
(ensure-directories-exist staging)
(with-current-directory staging
(dolist (dir (list (app-path "themes/~a/css" (theme *config*))
(app-path "themes/~a/img" (theme *config*))
(app-path "themes/~a/js" (theme *config*))
(merge-pathnames "static" (repo *config*))))
(when (probe-file dir)
(run-program "rsync --delete -raz ~a ." dir)))
(do-ctypes (publish (make-keyword ctype)))
(render-indices)
(update-symlink "index.html" "1.html")
(render-feeds (feeds *config*))))
(defgeneric deploy (staging)
(:documentation "Deploy the STAGING dir, updating the .prev and .curr symlinks.")
(:method (staging)
(let* ((dest (deploy-dir *config*))
(new-build (rel-path dest "generated/~a" (get-universal-time)))
(prev (rel-path dest ".prev"))
(curr (rel-path dest ".curr")))
(ensure-directories-exist new-build)
(run-program "mv ~a ~a" staging new-build)
(when (and (probe-file prev) (truename prev))
(run-program "rm -r ~a" (truename prev)))
(when (probe-file curr)
(update-symlink prev (truename curr)))
(update-symlink curr new-build))))
(defun main (&optional config-key)
"Load the user's config file, then compile and deploy the site."
(load-config config-key)
(load-content)
(compile-theme (theme *config*))
(let ((dir (staging-dir *config*)))
(compile-blog dir)
(deploy dir)))
(defun preview (path &optional (content-type 'post))
"Render the content at PATH under user's configured repo and save it to
~/tmp.html. Load the user's config and theme if necessary."
(let ((current-working-directory (cl-fad:pathname-directory-pathname path)))
(unless *config*
(load-config (namestring current-working-directory))
(compile-theme (theme *config*)))
(let* ((file (rel-path (repo *config*) path))
(content (construct content-type (read-content file))))
(write-page "tmp.html" (render-page content)))))

14
src/config.lisp
View file

@ -6,15 +6,15 @@
(domain :initarg :domain :accessor domain)
(feeds :initarg :feeds :accessor feeds)
(license :initarg :license :accessor license)
(page-ext :initarg :page-ext :accessor page-ext :initform "html")
(plugins :initarg :plugins :accessor plugins)
(repo :initarg :repo :accessor repo)
(routing :initarg :routing :accessor routing)
(separator :initarg :separator :accessor separator :initform ";;;;;")
(sitenav :initarg :sitenav :accessor sitenav)
(staging-dir :initarg :staging-dir :accessor staging-dir :initform "/tmp/coleslaw/")
(posts-dir :initarg :posts-dir :accessor posts-dir :initform "posts")
(separator :initarg :separator :accessor separator :initform ";;;;;")
(page-ext :initarg :page-ext :accessor page-ext :initform "html")
(title :initarg :title :accessor title)
(theme :initarg :theme :accessor theme)))
(theme :initarg :theme :accessor theme)
(title :initarg :title :accessor title)))
(define-condition unknown-config-section-error (error)
((text :initarg :text :reader text)))
@ -55,14 +55,14 @@ if necessary. DIR is ~ by default."
(let ((config-form (read in)))
(if (symbolp (car config-form))
;; Single site config: ignore CONFIG-KEY.
(setf *config* (apply #'make-instance 'blog config-form))
(setf *config* (construct 'blog config-form))
;; Multi-site config: load config section for CONFIG-KEY.
(let* ((config-key-pathname (cl-fad:pathname-as-directory config-key))
(section (assoc config-key-pathname config-form
:key #'cl-fad:pathname-as-directory
:test #'equal)))
(if section
(setf *config* (apply #'make-instance 'blog (cdr section))
(setf *config* (construct 'blog (cdr section))
(repo *config*) config-key)
(error 'unknown-config-section-error
:text (format nil "In ~A: No such key: '~A'." in config-key)))))

81
src/content.lisp
View file

@ -1,7 +1,6 @@
(in-package :coleslaw)
(defparameter *content* (make-hash-table :test #'equal)
"A hash table to store all the site content and metadata.")
;; Tagging
(defclass tag ()
((name :initform nil :initarg :name :accessor tag-name)
@ -16,27 +15,27 @@
"Test if the slugs for tag A and B are equal."
(string= (tag-slug a) (tag-slug b)))
;; Slugs
(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)))
;; Content Types
(defclass content ()
((tags :initform nil :initarg :tags :accessor content-tags)
(slug :initform nil :initarg :slug :accessor content-slug)
(date :initform nil :initarg :date :accessor content-date)
(text :initform nil :initarg :text :accessor content-text)))
(defun construct (content-type args)
"Create an instance of CONTENT-TYPE with the given ARGS."
(apply 'make-instance content-type args))
(defun tag-p (tag obj)
"Test if OBJ is tagged with TAG."
(member tag (content-tags obj) :test #'tag-slug=))
(defun month-p (month obj)
"Test if OBJ was written in MONTH."
(search month (content-date obj)))
(defgeneric publish (content-type)
(:documentation "Write pages to disk for all content of the given CONTENT-TYPE."))
(defun read-content (file)
"Returns a plist of metadata from FILE with :text holding the content as a string."
(flet ((slurp-remainder (stream)
@ -61,49 +60,15 @@
(setf (getf meta :tags) (read-tags (getf meta :tags)))
(append meta (list :text content))))))
(defun find-all (content-type)
"Return a list of all instances of a given CONTENT-TYPE."
(loop for val being the hash-values in *content*
when (typep val content-type) collect val))
(defun tag-p (tag obj)
"Test if OBJ is tagged with TAG."
(let ((tag (if (typep tag 'tag) tag (make-tag tag))))
(member tag (content-tags obj) :test #'tag-slug=)))
(defun purge-all (content-type)
"Remove all instances of CONTENT-TYPE from *content*."
(dolist (obj (find-all content-type))
(remhash (content-slug obj) *content*)))
(defun discover (content-type)
"Load all content of the given CONTENT-TYPE from disk."
(purge-all content-type)
(let ((file-type (string-downcase (princ-to-string content-type))))
(do-files (file (repo *config*) file-type)
(let ((obj (construct content-type (read-content file))))
(if (gethash (content-slug obj) *content*)
(error "There is already existing content with the slug ~a."
(content-slug obj))
(setf (gethash (content-slug obj) *content*) obj))))))
(defmacro do-ctypes (&body body)
"Iterate over the subclasses of CONTENT performing BODY with ctype lexically
bound to the current subclass."
(alexandria:with-gensyms (ctypes)
`(let ((,ctypes (closer-mop:class-direct-subclasses (find-class 'content))))
(loop for ctype in (mapcar #'class-name ,ctypes) do ,@body))))
(defun load-content ()
"Load all content stored in the blog's repo."
(do-ctypes (discover ctype)))
(defun month-p (month obj)
"Test if OBJ was written in MONTH."
(search month (content-date obj)))
(defun by-date (content)
"Sort CONTENT in reverse chronological order."
(sort content #'string> :key #'content-date))
(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)))

56
src/documents.lisp Normal file
View file

@ -0,0 +1,56 @@
(in-package :coleslaw)
;;;; The Document Protocol
;; Data Storage
(defvar *site* (make-hash-table :test #'equal)
"An in-memory database to hold all site documents, keyed on page-url.")
(defun add-document (doc)
"Add DOC to the in-memory database. Error if a matching entry is present."
(let ((url (page-url doc)))
(if (gethash url *site*)
(error "There is already an existing document with the url ~a" url)
(setf (gethash url *site*) doc))))
;; Class Methods
(defun find-all (doc-type)
"Return a list of all instances of a given DOC-TYPE."
(loop for val being the hash-values in *site*
when (typep val doc-type) collect val))
(defun purge-all (doc-type)
"Remove all instances of DOC-TYPE from memory."
(dolist (obj (find-all doc-type))
(remhash (page-url obj) *site*)))
(defgeneric publish (doc-type)
(:documentation "Write pages to disk for all documents of the given DOC-TYPE."))
(defgeneric discover (doc-type)
(:documentation "Load all documents of the given DOC-TYPE into memory.")
(:method (doc-type)
(let* ((class-name (class-name doc-type))
(file-type (string-downcase (symbol-name class-name))))
(do-files (file (repo *config*) file-type)
(let ((obj (construct class-name (read-content file))))
(add-document obj))))))
(defmethod discover :before (doc-type)
(purge-all (class-name doc-type)))
;; Instance Methods
(defgeneric page-url (document)
(:documentation "The url to the document, without the domain."))
(defmethod page-url :around ((document t))
(let ((result (call-next-method)))
(if (pathname-type result)
result
(make-pathname :type "html" :defaults result))))
(defgeneric render (document &key &allow-other-keys)
(:documentation "Render the given DOCUMENT to HTML."))

27
src/feeds.lisp
View file

@ -1,27 +0,0 @@
(in-package :coleslaw)
(defun make-pubdate ()
"Make a RFC1123 pubdate representing the current time."
(local-time:format-rfc1123-timestring nil (local-time:now)))
(defun render-feed (posts &key path template tag)
(flet ((first-10 (list) (subseq list 0 (min (length list) 10)))
(tag-posts (list) (remove-if-not (lambda (x) (tag-p tag x)) list)))
(let ((template (theme-fn template "feeds"))
(index (if tag
(make-instance 'tag-index :id path
:posts (first-10 (tag-posts posts)))
(make-instance 'index :id path
:posts (first-10 posts)))))
(write-page (page-path index) (render-page index template)))))
(defun render-feeds (tag-feeds)
"Render the default RSS and ATOM feeds along with any TAG-FEEDS."
(let ((posts (by-date (find-all 'post))))
(dolist (feed '((:path "rss.xml" :template :rss-feed)
(:path "atom.xml" :template :atom-feed)))
(apply #'render-feed posts feed))
(dolist (feed tag-feeds)
(apply #'render-feed posts (list :path (format nil "~A-rss.xml" feed)
:tag (make-tag feed)
:template :rss-feed)))))

145
src/indexes.lisp Normal file
View file

@ -0,0 +1,145 @@
(in-package :coleslaw)
(defclass index ()
((slug :initform nil :initarg :slug :accessor index-slug)
(title :initform nil :initarg :title :accessor index-title)
(content :initform nil :initarg :content :accessor index-content)))
(defmethod render ((object index) &key prev next)
(funcall (theme-fn 'index) (list :tags (all-tags)
:months (all-months)
:config *config*
:index object
:prev prev
:next next)))
;;; Index by Tag
(defclass tag-index (index) ())
(defmethod page-url ((object tag-index))
(format nil "tag/~a" (index-slug object)))
(defmethod discover ((doc-type (eql (find-class 'tag-index))))
(let ((content (by-date (find-all 'post))))
(dolist (tag (all-tags))
(add-document (index-by-tag tag content)))))
(defun index-by-tag (tag content)
"Return an index of all CONTENT matching the given TAG."
(make-instance 'tag-index :slug (tag-slug tag)
:content (remove-if-not (lambda (x) (tag-p tag x)) content)
:title (format nil "Content tagged ~a" (tag-name tag))))
(defmethod publish ((doc-type (eql (find-class 'tag-index))))
(dolist (index (find-all 'tag-index))
(render-index index)))
;;; Index by Month
(defclass month-index (index) ())
(defmethod page-url ((object month-index))
(format nil "date/~a" (index-slug object)))
(defmethod discover ((doc-type (eql (find-class 'month-index))))
(let ((content (by-date (find-all 'post))))
(dolist (month (all-months))
(add-document (index-by-month month content)))))
(defun index-by-month (month content)
"Return an index of all CONTENT matching the given MONTH."
(make-instance 'month-index :slug month
:content (remove-if-not (lambda (x) (month-p month x)) content)
:title (format nil "Content from ~a" month)))
(defmethod publish ((doc-type (eql (find-class 'month-index))))
(dolist (index (find-all 'month-index))
(render-index index)))
;;; Reverse Chronological Index
(defclass numeric-index (index) ())
(defmethod page-url ((object numeric-index))
(format nil "~d" (index-slug object)))
(defmethod discover ((doc-type (eql (find-class 'numeric-index))))
(let ((content (by-date (find-all 'post))))
(dotimes (i (ceiling (length content) 10))
(add-document (index-by-n i content)))))
(defun index-by-n (i content)
"Return the index for the Ith page of CONTENT in reverse chronological order."
(let ((content (subseq content (* 10 i))))
(make-instance 'numeric-index :slug (1+ i)
:content (take-up-to 10 content)
:title "Recent Content")))
(defmethod publish ((doc-type (eql (find-class 'numeric-index))))
(let ((indexes (sort (find-all 'numeric-index) #'< :key #'index-slug)))
(dolist (index indexes)
(let ((prev (1- (index-slug index)))
(next (1+ (index-slug index))))
(render-index index :prev (when (plusp prev) prev)
:next (when (<= next (length indexes)) next))))))
;;; Atom and RSS Feeds
(defclass feed (index)
((format :initform nil :initarg :format :accessor feed-format)))
(defmethod page-url ((object feed))
(format nil "~(~a~).xml" (feed-format object)))
(defmethod discover ((doc-type (eql (find-class 'feed))))
(let ((content (take-up-to 10 (by-date (find-all 'post)))))
(dolist (format '(rss atom))
(let ((feed (make-instance 'feed :content content :format format)))
(add-document feed)))))
(defmethod publish ((doc-type (eql (find-class 'feed))))
(dolist (feed (find-all 'feed))
(render-feed feed)))
(defclass tag-feed (feed) ())
(defmethod page-url ((object tag-feed))
(format nil "tag/~a~(~a~).xml" (index-slug object) (feed-format object)))
(defmethod discover ((doc-type (eql (find-class 'tag-feed))))
(let ((content (by-date (find-all 'post))))
(dolist (tag (feeds *config*))
(let ((tagged (remove-if-not (lambda (x) (tag-p tag x)) content)))
(dolist (format '(rss atom))
(let ((feed (make-instance 'tag-feed :content (take-up-to 10 tagged)
:format format
:slug tag)))
(add-document feed)))))))
(defmethod publish ((doc-type (eql (find-class 'tag-feed))))
(dolist (feed (find-all 'tag-feed))
(render-feed feed)))
;;; Helper Functions
(defun all-months ()
"Retrieve a list of all months with published content."
(let ((months (mapcar (lambda (x) (subseq (content-date x) 0 7))
(find-all 'post))))
(sort (remove-duplicates months :test #'string=) #'string>)))
(defun all-tags ()
"Retrieve a list of all tags used in content."
(let* ((dupes (mappend #'content-tags (find-all 'post)))
(tags (remove-duplicates dupes :test #'string= :key #'tag-slug)))
(sort tags #'string< :key #'tag-name)))
(defun render-feed (feed)
"Render the given FEED to both RSS and ATOM."
(let ((theme-fn (theme-fn (feed-format feed) "feeds")))
(write-page (page-path feed) (render-page feed theme-fn))))
(defun render-index (index &rest render-args)
"Render the given INDEX using RENDER-ARGS if provided."
(write-page (page-path index) (apply #'render-page index nil render-args)))

76
src/indices.lisp
View file

@ -1,76 +0,0 @@
(in-package :coleslaw)
(defclass index ()
((id :initform nil :initarg :id :accessor index-id)
(posts :initform nil :initarg :posts :accessor index-posts)
(title :initform nil :initarg :title :accessor index-title)))
(defclass tag-index (index) ())
(defclass date-index (index) ())
(defclass numeric-index (index) ())
(defmethod page-url ((object index))
(index-id object))
(defmethod page-url ((object tag-index))
(format nil "tag/~a" (index-id object)))
(defmethod page-url ((object date-index))
(format nil "date/~a" (index-id object)))
(defmethod page-url ((object numeric-index))
(format nil "~d" (index-id object)))
(defmethod render ((object index) &key prev next)
(funcall (theme-fn 'index) (list :tags (all-tags)
:months (all-months)
:config *config*
:index object
:prev prev
:next next)))
(defun all-months ()
"Retrieve a list of all months with published content."
(let ((months (mapcar (lambda (x) (subseq (content-date x) 0 7))
(hash-table-values *content*))))
(sort (remove-duplicates months :test #'string=) #'string>)))
(defun all-tags ()
"Retrieve a list of all tags used in content."
(let* ((dupes (mappend #'content-tags (hash-table-values *content*)))
(tags (remove-duplicates dupes :test #'string= :key #'tag-slug)))
(sort tags #'string< :key #'tag-name)))
(defun index-by-tag (tag content)
"Return an index of all CONTENT matching the given TAG."
(make-instance 'tag-index :id (tag-slug tag)
:posts (remove-if-not (lambda (x) (tag-p tag x)) content)
:title (format nil "Posts tagged ~a" (tag-name tag))))
(defun index-by-month (month content)
"Return an index of all CONTENT matching the given MONTH."
(make-instance 'date-index :id month
:posts (remove-if-not (lambda (x) (month-p month x)) content)
:title (format nil "Posts from ~a" month)))
(defun index-by-n (i content &optional (step 10))
"Return the index for the Ith page of CONTENT in reverse chronological order."
(let* ((start (* step i))
(end (min (length content) (+ start step))))
(make-instance 'numeric-index :id (1+ i)
:posts (subseq content start end)
:title "Recent Posts")))
(defun render-index (index &rest render-args)
"Render the given INDEX using RENDER-ARGS if provided."
(write-page (page-path index) (apply #'render-page index nil render-args)))
(defun render-indices ()
"Render the indices to view content in groups of size N, by month, and by tag."
(let ((results (by-date (find-all 'post))))
(dolist (tag (all-tags))
(render-index (index-by-tag tag results)))
(dolist (month (all-months))
(render-index (index-by-month month results)))
(dotimes (i (ceiling (length results) 10))
(render-index (index-by-n i results)
:prev (and (plusp i) i)
:next (and (< (* (1+ i) 10) (length results))
(+ 2 i))))))

14
src/packages.lisp
View file

@ -10,14 +10,16 @@
(:export #:main
#:preview
#:*config*
#:blog
#:content
#:post
#:index
#:page-path
#:render-content
#:add-injection
;; The Document Protocol
#:add-document
#:find-all
#:purge-all
#:discover
#:publish
#:render
#:render-content
#:read-content
#:add-injection))
#:page-url
#:render))

4
src/posts.lisp
View file

@ -22,9 +22,9 @@
:next next)))
(defmethod page-url ((object post))
(format nil "~a/~a" (posts-dir *config*) (content-slug object)))
(format nil "posts/~a" (content-slug object)))
(defmethod publish ((content-type (eql :post)))
(defmethod publish ((doc-type (eql (find-class 'post))))
(loop for (next post prev) on (append '(nil) (by-date (find-all 'post)))
while post do (write-page (page-path post)
(render-page post nil :prev prev :next next))))

23
src/util.lisp
View file

@ -1,5 +1,20 @@
(in-package :coleslaw)
(defun construct (class-name args)
"Create an instance of CLASS-NAME with the given ARGS."
(apply 'make-instance class-name args))
(defmacro do-subclasses ((var class) &body body)
"Iterate over the subclasses of CLASS performing BODY with VAR
lexically bound to the current subclass' class-name."
(alexandria:with-gensyms (klasses all-subclasses)
`(labels ((,all-subclasses (class)
(let ((subclasses (closer-mop:class-direct-subclasses class)))
(append subclasses (loop for subclass in subclasses
nconc (,all-subclasses subclass))))))
(let ((,klasses (,all-subclasses (find-class ',class))))
(loop for ,var in ,klasses do ,@body)))))
(defun fmt (fmt-str args)
"A convenient FORMAT interface for string building."
(apply 'format nil fmt-str args))
@ -69,3 +84,11 @@ an UNWIND-PROTECT, then change back to the current directory."
(setf (current-directory) ,path)
,@body)
(setf (current-directory) ,old)))))
(defun take-up-to (n seq)
"Take elements from SEQ until all elements or N have been taken."
(subseq seq 0 (min (length seq) n)))
(defun make-pubdate ()
"Make a RFC1123 pubdate representing the current time."
(local-time:format-rfc1123-timestring nil (local-time:now)))

6
themes/atom.tmpl
View file

@ -1,6 +1,6 @@
{namespace coleslaw.theme.feeds}
{template atom-feed}
{template atom}
<?xml version="1.0"?>{\n}
<feed xmlns="http://www.w3.org/2005/Atom">
@ -12,9 +12,9 @@
<name>{$config.author}</name>
</author>
{foreach $post in $content.posts}
{foreach $post in $content.content}
<entry>
<link type="text/html" rel="alternate" href="{$config.domain}/posts/{$post.slug}.html"/>
<link type="text/html" rel="alternate" href="{$config.domain}/posts/{$post.slug}.{$config.pageExt}"/>
<title>{$post.title}</title>
<published>{$post.date}</published>
<updated>{$post.date}</updated>

18
themes/hyde/index.tmpl
View file

@ -2,31 +2,31 @@
{template index}
<h1 class="title">{$index.title}</h1>
{foreach $post in $index.posts}
{foreach $obj in $index.content}
<div class="article-meta">
<a class="article-title" href="{$config.domain}/posts/{$post.slug}.html">{$post.title}</a>
<div class="date"> posted on {$post.date}</div>
<div class="article">{$post.text |noAutoescape}</div>
<a class="article-title" href="{$config.domain}/posts/{$obj.slug}.{$config.pageExt}">{$obj.title}</a>
<div class="date"> posted on {$obj.date}</div>
<div class="article">{$obj.text |noAutoescape}</div>
</div>
{/foreach}
<div id="relative-nav">
{if $prev} <a href="{$prev}.html">Previous</a> {/if}
{if $next} <a href="{$next}.html">Next</a> {/if}
{if $prev} <a href="{$prev}.{$config.pageExt}">Previous</a> {/if}
{if $next} <a href="{$next}.{$config.pageExt}">Next</a> {/if}
</div>
{if $tags}
<div id="tagsoup">
<p>This blog covers
{foreach $tag in $tags}
<a href="{$config.domain}/tag/{$tag.slug}.html">{$tag.name}</a>{nil}
<a href="{$config.domain}/tag/{$tag.slug}.{$config.pageExt}">{$tag.name}</a>{nil}
{if not isLast($tag)},{sp}{/if}
{/foreach}
</div>
{/if}
{if $months}
<div id="monthsoup">
<p>View posts from
<p>View content from
{foreach $month in $months}
<a href="{$config.domain}/date/{$month}.html">{$month}</a>{nil}
<a href="{$config.domain}/date/{$month}.{$config.pageExt}">{$month}</a>{nil}
{if not isLast($month)},{sp}{/if}
{/foreach}
</div>

6
themes/hyde/post.tmpl
View file

@ -5,7 +5,7 @@
<h1 class="title">{$post.title}</h1>{\n}
<div class="tags">{\n}
Tagged as {foreach $tag in $post.tags}
<a href="../tag/{$tag.slug}.html">{$tag.name}</a>{nil}
<a href="../tag/{$tag.slug}.{$config.pageExt}">{$tag.name}</a>{nil}
{if not isLast($tag)},{sp}{/if}
{/foreach}
</div>{\n}
@ -17,7 +17,7 @@
{$post.text |noAutoescape}
</div>{\n}
<div class="relative-nav">{\n}
{if $prev} <a href="{$config.domain}/posts/{$prev.slug}.html">Previous</a><br> {/if}{\n}
{if $next} <a href="{$config.domain}/posts/{$next.slug}.html">Next</a><br> {/if}{\n}
{if $prev} <a href="{$config.domain}/posts/{$prev.slug}.{$config.pageExt}">Previous</a><br> {/if}{\n}
{if $next} <a href="{$config.domain}/posts/{$next.slug}.{$config.pageExt}">Next</a><br> {/if}{\n}
</div>{\n}
{/template}

14
themes/readable/index.tmpl
View file

@ -2,18 +2,18 @@
{template index}
<h1 class="page-header">{$index.title}</h1>
{foreach $post in $index.posts}
{foreach $obj in $index.content}
<div class="row-fluid">
<h1><a href="{$config.domain}/posts/{$post.slug}.html">{$post.title}</a></h1>
<p class="date-posted">posted on {$post.date}</p>
{$post.text |noAutoescape}
<h1><a href="{$config.domain}/posts/{$obj.slug}.{$config.pageExt}">{$obj.title}</a></h1>
<p class="date-posted">posted on {$obj.date}</p>
{$obj.text |noAutoescape}
</div>
{/foreach}
{if $tags}
<div class="row-fluid">
<p>This blog covers
{foreach $tag in $tags}
<a href="{$config.domain}/tag/{$tag.slug}.html">{$tag.name}</a>{nil}
<a href="{$config.domain}/tag/{$tag.slug}.{$config.pageExt}">{$tag.name}</a>{nil}
{if not isLast($tag)},{sp}{/if}
{/foreach}
</p>
@ -21,9 +21,9 @@
{/if}
{if $months}
<div class="row-fluid">
<p>View posts from
<p>View content from
{foreach $month in $months}
<a href="{$config.domain}/date/{$month}.html">{$month}</a>{nil}
<a href="{$config.domain}/date/{$month}.{$config.pageExt}">{$month}</a>{nil}
{if not isLast($month)},{sp}{/if}
{/foreach}
</p>

6
themes/readable/post.tmpl
View file

@ -5,7 +5,7 @@
<h1 class="page-header">{$post.title}</h1>{\n}
<p>Tagged as
{foreach $tag in $post.tags}
<a href="../tag/{$tag.slug}.html">{$tag.name}</a>{nil}
<a href="../tag/{$tag.slug}{$config.pageExt}">{$tag.name}</a>{nil}
{if not isLast($tag)},{sp}{/if}
{/foreach}
</p>
@ -14,8 +14,8 @@
{$post.text |noAutoescape}
<ul class="pager">
{if $prev}<li class="previous"><a href="{$config.domain}/posts/{$prev.slug}.html">&larr; Previous</a></li>{/if}{\n}
{if $next}<li class="next"><a href="{$config.domain}/posts/{$next.slug}.html">Next &rarr;</a></li>{/if}{\n}
{if $prev}<li class="previous"><a href="{$config.domain}/posts/{$prev.slug}.{$config.pageExt}">&larr; Previous</a></li>{/if}{\n}
{if $next}<li class="next"><a href="{$config.domain}/posts/{$next.slug}.{$config.pageExt}">Next &rarr;</a></li>{/if}{\n}
</ul>
</div>{\n}
{/template}

8
themes/rss.tmpl
View file

@ -1,6 +1,6 @@
{namespace coleslaw.theme.feeds}
{template rss-feed}
{template rss}
<?xml version="1.0"?>{\n}
<rss version="2.0" xmlns:atom="http://www.w3.org/2005/Atom">
<channel>
@ -10,13 +10,13 @@
<language>en-us</language>
<pubDate>{$pubdate}</pubDate>
{foreach $post in $content.posts}
{foreach $post in $content.content}
<item>
<title>{$post.title}</title>
<link>{$config.domain}/posts/{$post.slug}.html</link>
<link>{$config.domain}/posts/{$post.slug}.{$config.pageExt}</link>
<pubDate>{$post.date}</pubDate>
<author>{$config.author}</author>
<guid isPermaLink="true">{$config.domain}/posts/{$post.slug}.html</guid>
<guid isPermaLink="true">{$config.domain}/posts/{$post.slug}.{$config.pageExt}</guid>
{foreach $tag in $post.tags}
<category><![CDATA[ {$tag} ]]></category>
{/foreach}

2
themes/sitemap.tmpl
View file

@ -1,4 +1,4 @@
{namespace coleslaw.theme.feeds}
{namespace coleslaw.theme.sitemap}
{template sitemap}
<?xml version="1.0"?>{\n}