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

Merge pull request #8 from redline6561/content-types

Browse source 
Extensible Content types.
This commit is contained in:
Brit Butler 2013-01-06 12:37:27 -08:00
commit ba4e4d9496
15 changed files with 255 additions and 129 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
NEWS.md Normal file
View file

@ -0,0 +1,30 @@
## Changes for 0.8 (2013-01-06):
* Add support for new [content types](http://blog.redlinernotes.com/posts/Lessons-from-Coleslaw.html).
* Support for [Multi-site Publishing](http://blub.co.za/posts/Adding-multi-site-support-to-Coleslaw.html).
* CCL and Atom feed bugfixes.
* Major code refactor and docs update.
## Changes for 0.7 (2012-09-20):
* Add commenting support via Disqus plugin.
* Add formal plugin API with per-page predicate support. (aka "injections")
* Note jsmpereira's [coleslaw heroku package](https://github.com/jsmpereira/coleslaw-heroku) in README.
* Support for RSS feeds of arbitrary tags, e.g. "lisp" posts.
## Changes for 0.6.5 (2012-09-12):
* Add support for ATOM feeds.
* Add support for a sitenav in coleslawrc configs.
* Template and rendering cleanup.
* Miscellaneous deployment improvements.
## Changes for 0.6 (2012-08-29):
* Support Markdown in core rather than as a plugin.
* Improve documentation + README.
* Copious bugfixes and code cleanups.
## Changes for 0.5 (2012-08-22):
* Initial release.

10
TODO
View file

@ -4,8 +4,14 @@ BUGS:
; Slugs aren't unicode safe. See [reddit discussion](http://www.reddit.com/r/lisp/comments/yvh6g/coleslaw_jekylllike_static_blogware_in_500_lines/) and [mozilla code](https://github.com/mozilla/unicode-slugify/blob/master/slugify/__init__.py).
TODO:
; remove need for ordering in header. improve date check/error reporting. -> 0.8
; doc themes and plugins, s3+hunchentoot. -> 0.8
0.9
; Add SHOUT content type.
;; needs: shout template/render function. Twitter\Disqus integration with shouts?
;; Indices fundamentally don't know about content-types. Is that a problem?
;; Rename index.posts to something else?
Coleslaw.next
; improve date check/error reporting. -> 0.9
; doc themes and plugins, s3+hunchentoot. -> 0.9
; unit tests -> 0.9
; Incremental compilation: only "touched" posts+tags+months and by-n. -> 1.0
;; possible plugins: analytics, logging/monitoring, crossposting

6
coleslaw.asd
View file

@ -1,7 +1,7 @@
(defsystem #:coleslaw
:name "coleslaw-core"
:description "Flexible Lisp Blogware"
:version "0.7"
:version "0.8"
:license "BSD"
:author "Brit Butler <redline6561@gmail.com>"
:pathname "src/"
@ -12,12 +12,14 @@
:local-time
:inferior-shell
:cl-fad
:cl-ppcre)
:cl-ppcre
:closer-mop)
:serial t
:components ((:file "packages")
(:file "util")
(:file "config")
(:file "themes")
(:file "content")
(:file "posts")
(:file "indices")
(:file "feeds")

77
docs/coleslaw.html
View file

@ -58,43 +58,86 @@ else
<pre>Homepage: <a href="http://github.com/redline6561/coleslaw">Github</a></pre></div>
<div class="frame">
<div class="labeltitle">
<span class="expander" onclick="expand(this, 'classes');">-</span>Classes</div>
<div id="classes">
<div class="symboldecl">
<div class="definition">
<a class="symbolname" name="blog_class" href="#blog_class">blog</a>
<span class="lambdalist">(standard-object)</span>
<span class="symboltype">class</span></div>
<div class="documentation">
<pre></pre></div></div>
<div class="symboldecl">
<div class="definition">
<a class="symbolname" name="content_class" href="#content_class">content</a>
<span class="lambdalist">(standard-object)</span>
<span class="symboltype">class</span></div>
<div class="documentation">
<pre></pre></div></div>
<div class="symboldecl">
<div class="definition">
<a class="symbolname" name="index_class" href="#index_class">index</a>
<span class="lambdalist">(standard-object)</span>
<span class="symboltype">class</span></div>
<div class="documentation">
<pre></pre></div></div>
<div class="symboldecl">
<div class="definition">
<a class="symbolname" name="post_class" href="#post_class">post</a>
<span class="lambdalist">(content)</span>
<span class="symboltype">class</span></div>
<div class="documentation">
<pre></pre></div></div></div></div>
<div class="frame">
<div class="labeltitle">
<span class="expander" onclick="expand(this, 'functions');">-</span>Functions</div>
<div id="functions">
<div class="symboldecl">
<div class="definition">
<a class="symbolname" name="add-injection_func" href="#add-injection_func">add-injection</a>
<span class="lambdalist">str location</span>
<span class="symboltype">standard-generic-function</span></div>
<span class="lambdalist">injection location</span>
<span class="symboltype">function</span></div>
<div class="documentation">
<pre>Add STR to the list of elements injected in LOCATION.</pre></div></div>
<pre>Adds an INJECTION to a given LOCATION for rendering. The INJECTION should be
a string which will always be added or a (string . lambda). In the latter case,
the lambda takes a single argument, a content object, i.e. a POST or INDEX, and
any return value other than nil indicates the injection should be added.</pre></div></div>
<div class="symboldecl">
<div class="definition">
<a class="symbolname" name="deploy_func" href="#deploy_func">deploy</a>
<span class="lambdalist">staging</span>
<a class="symbolname" name="discover_func" href="#discover_func">discover</a>
<span class="lambdalist">content-type</span>
<span class="symboltype">standard-generic-function</span></div>
<div class="documentation">
<pre>Deploy the STAGING dir, updating the .prev and .curr symlinks.</pre></div></div>
<div class="symboldecl">
<div class="definition">
<a class="symbolname" name="(setf deploy)_func" href="#(setf deploy)_func">(setf deploy)</a>
<span class="lambdalist">new-value object</span>
<span class="symboltype">standard-generic-function</span></div>
<div class="documentation">
<pre>:undocumented</pre></div></div>
<pre>Load all content of the given CONTENT-TYPE from disk.</pre></div></div>
<div class="symboldecl">
<div class="definition">
<a class="symbolname" name="main_func" href="#main_func">main</a>
<span class="lambdalist"></span>
<span class="lambdalist">config-key</span>
<span class="symboltype">function</span></div>
<div class="documentation">
<pre>Load the user's config, then compile and deploy the blog.</pre></div></div>
<pre>Load the user's config section corresponding to CONFIG-KEY, then
compile and deploy the blog.</pre></div></div>
<div class="symboldecl">
<div class="definition">
<a class="symbolname" name="page-path_func" href="#page-path_func">page-path</a>
<span class="lambdalist">object</span>
<span class="symboltype">standard-generic-function</span></div>
<div class="documentation">
<pre>The path to store OBJECT at once rendered.</pre></div></div>
<div class="symboldecl">
<div class="definition">
<a class="symbolname" name="publish_func" href="#publish_func">publish</a>
<span class="lambdalist">content-type</span>
<span class="symboltype">standard-generic-function</span></div>
<div class="documentation">
<pre>Write pages to disk for all content of the given CONTENT-TYPE.</pre></div></div>
<div class="symboldecl">
<div class="definition">
<a class="symbolname" name="render_func" href="#render_func">render</a>
<span class="lambdalist">content &key next prev &allow-other-keys</span>
<span class="lambdalist">object &key next prev &allow-other-keys</span>
<span class="symboltype">standard-generic-function</span></div>
<div class="documentation">
<pre>Render the given CONTENT to HTML.</pre></div></div>
<pre>Render the given OBJECT to HTML.</pre></div></div>
<div class="symboldecl">
<div class="definition">
<a class="symbolname" name="render-content_func" href="#render-content_func">render-content</a>

16
plugins/mathjax.lisp
View file

@ -2,9 +2,9 @@
(:use :cl)
(:export #:enable)
(:import-from :coleslaw #:add-injection
#:post
#:content
#:index
#:post-tags
#:content-tags
#:index-posts))
(in-package :coleslaw-mathjax)
@ -21,10 +21,10 @@ src=\"http://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLor
</script>")
(defun enable ()
(labels ((math-post-p (post)
(member "math" (post-tags post) :test #'string=))
(mathjax-p (content)
(etypecase content
(post (math-post-p content))
(index (some #'math-post-p (index-posts content))))))
(labels ((math-post-p (obj)
(member "math" (content-tags obj) :test #'string=))
(mathjax-p (obj)
(etypecase obj
(content (math-post-p obj))
(index (some #'math-post-p (index-posts obj))))))
(add-injection (list *mathjax-header* #'mathjax-p) :head)))

4
src/coleslaw.lisp
View file

@ -49,7 +49,7 @@ Additional args to render CONTENT can be passed via RENDER-ARGS."
(merge-pathnames "static" (repo *config*))))
(when (probe-file dir)
(run-program "cp -R ~a ." dir)))
(render-posts)
(do-ctypes (publish ctype))
(render-indices)
(render-feeds (feeds *config*))))
@ -76,7 +76,7 @@ Additional args to render CONTENT can be passed via RENDER-ARGS."
"Load the user's config section corresponding to CONFIG-KEY, then
compile and deploy the blog."
(load-config config-key)
(load-posts)
(load-content)
(compile-theme (theme *config*))
(compile-blog (staging *config*))
(deploy (staging *config*)))

84
src/content.lisp Normal file
View file

@ -0,0 +1,84 @@
(in-package :coleslaw)
(defparameter *content* (make-hash-table :test #'equal)
"A hash table to store all the site content and metadata.")
(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))
(defgeneric discover (content-type)
(:documentation "Load all content of the given CONTENT-TYPE from disk."))
(defgeneric publish (content-type)
(:documentation "Write pages to disk for all content of the given CONTENT-TYPE."))
(defun read-content (file &optional plist-p)
"Returns two values, a list of metadata from FILE, and the content as a string.
If PLIST-P is non-nil, a single plist is returned with :content holding the text."
(flet ((slurp-remainder (stream)
(let ((seq (make-string (- (file-length stream)
(file-position stream)))))
(read-sequence seq stream)
(remove #\Nul seq)))
(parse-field (str)
(nth-value 1 (cl-ppcre:scan-to-strings "[a-zA-Z]+: (.*)" str)))
(field-name (line)
(make-keyword (string-upcase (subseq line 0 (position #\: line)))))
(read-delimited (str &optional (delimiter ", "))
(mapcar #'string-downcase (cl-ppcre:split delimiter str))))
(with-open-file (in file)
(unless (string= (read-line in) ";;;;;")
(error "The provided file lacks the expected header."))
(let ((meta (loop for line = (read-line in nil)
until (string= line ";;;;;")
appending (list (field-name line)
(aref (parse-field line) 0))))
(content (slurp-remainder in)))
(setf (getf meta :tags) (read-delimited (getf meta :tags)))
(if plist-p
(append meta (list :text content))
(values meta 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 (eql content-type (type-of val)) collect val))
(defun purge-all (content-type)
"Remove all instances of CONTENT-TYPE from *content*."
(dolist (obj (find-all content-type))
(remhash (content-slug obj) *content*)))
(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 (compose 'make-keyword 'class-name) ,ctypes)
do ,@body))))
(defun load-content ()
"Load all content stored in the blog's repo."
(do-ctypes (discover ctype)))
(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)))

2
src/feeds.lisp
View file

@ -11,7 +11,7 @@
"Render and write the given FEEDS for the site."
(flet ((first-10 (list)
(subseq list 0 (min (length list) 10))))
(let* ((by-date (by-date (hash-table-values *posts*)))
(let* ((by-date (by-date (find-all 'post)))
(posts (first-10 by-date))
(rss (make-instance 'index :id "rss.xml" :posts posts))
(atom (make-instance 'index :id "feed.atom" :posts posts)))

54
src/indices.lisp
View file

@ -27,62 +27,58 @@
(rel-path (staging *config*) "~d" (index-id object)))
(defun all-months ()
"Retrieve a list of all months with published posts."
(sort (remove-duplicates (mapcar (lambda (x) (get-month (post-date x)))
(hash-table-values *posts*)) :test #'string=)
"Retrieve a list of all months with published content."
(sort (remove-duplicates (mapcar (lambda (x) (get-month (content-date x)))
(hash-table-values *content*)) :test #'string=)
#'string>))
(defun all-tags ()
"Retrieve a list of all tags used in posts."
(sort (remove-duplicates (mappend 'post-tags (hash-table-values *posts*))
"Retrieve a list of all tags used in content."
(sort (remove-duplicates (mappend 'content-tags (hash-table-values *content*))
:test #'string=) #'string<))
(defun get-month (timestamp)
"Extract the YYYY-MM portion of TIMESTAMP."
(subseq timestamp 0 7))
(defun by-date (posts)
"Sort POSTS in reverse chronological order."
(sort posts #'string> :key #'post-date))
(defun index-by-tag (tag posts)
"Return an index of all POSTS matching the given TAG."
(let ((content (remove-if-not (lambda (post) (member tag (post-tags post)
:test #'string=)) posts)))
(defun index-by-tag (tag content)
"Return an index of all CONTENT matching the given TAG."
(let ((results (remove-if-not (lambda (obj) (member tag (content-tags obj)
:test #'string=)) content)))
(make-instance 'tag-index :id tag
:posts content
:posts results
:title (format nil "Posts tagged ~a" tag))))
(defun index-by-month (month posts)
"Return an index of all POSTS matching the given MONTH."
(let ((content (remove-if-not (lambda (post) (search month (post-date post)))
posts)))
(defun index-by-month (month content)
"Return an index of all CONTENT matching the given MONTH."
(let ((results (remove-if-not (lambda (obj) (search month (content-date obj)))
content)))
(make-instance 'date-index :id month
:posts content
:posts results
:title (format nil "Posts from ~a" month))))
(defun index-by-n (i posts &optional (step 10))
"Return the index for the Ith page of POSTS in reverse chronological order."
(defun index-by-n (i content &optional (step 10))
"Return the index for the Ith page of CONTENT in reverse chronological order."
(make-instance 'int-index :id (1+ i)
:posts (let ((index (* step i)))
(subseq posts index (min (length posts)
(subseq content index (min (length content)
(+ index step))))
:title "Recent Posts"))
(defun render-indices ()
"Render the indices to view posts in groups of size N, by month, and by tag."
(let ((posts (by-date (hash-table-values *posts*))))
"Render the indices to view content in groups of size N, by month, and by tag."
(let ((results (by-date (hash-table-values *content*))))
(dolist (tag (all-tags))
(let ((index (index-by-tag tag posts)))
(let ((index (index-by-tag tag results)))
(write-page (page-path index) (render-page index))))
(dolist (month (all-months))
(let ((index (index-by-month month posts)))
(let ((index (index-by-month month results)))
(write-page (page-path index) (render-page index))))
(dotimes (i (ceiling (length posts) 10))
(let ((index (index-by-n i posts)))
(dotimes (i (ceiling (length results) 10))
(let ((index (index-by-n i results)))
(write-page (page-path index)
(render-page index nil
:prev (and (plusp i) i)
:next (and (< (* (1+ i) 10) (length posts))
:next (and (< (* (1+ i) 10) (length results))
(+ 2 i)))))))
(update-symlink "index.html" "1.html"))

11
src/packages.lisp
View file

@ -3,12 +3,17 @@
(:use :cl)
(:import-from :alexandria #:hash-table-values
#:make-keyword
#:mappend)
#:mappend
#:compose)
(:import-from :closure-template #:compile-template)
(:export #:main
#:blog
#:content
#:post
#:index
#:add-injection
#:page-path
#:discover
#:publish
#:render
#:render-content
#:deploy))
#:add-injection))

78
src/posts.lisp
View file

@ -1,15 +1,8 @@
(in-package :coleslaw)
(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)
(title :initform nil :initarg :title :accessor post-title)
(tags :initform nil :initarg :tags :accessor post-tags)
(date :initform nil :initarg :date :accessor post-date)
(format :initform nil :initarg :format :accessor post-format)
(content :initform nil :initarg :content :accessor post-content)))
(defclass post (content)
((title :initform nil :initarg :title :accessor post-title)
(format :initform nil :initarg :format :accessor post-format)))
(defmethod render ((object post) &key prev next)
(funcall (theme-fn 'post) (list :config *config*
@ -18,59 +11,26 @@
:next next)))
(defmethod page-path ((object post))
(rel-path (staging *config*) "posts/~a" (post-slug object)))
(rel-path (staging *config*) "posts/~a" (content-slug object)))
(defun read-post (in)
"Make a POST instance based on the data from the stream IN."
(flet ((check-header ()
(unless (string= (read-line in) ";;;;;")
(error "The provided file lacks the expected header.")))
(parse-field (str)
(nth-value 1 (cl-ppcre:scan-to-strings "[a-zA-Z]+: (.*)" str)))
(field-name (line)
(subseq line 0 (position #\: line)))
(read-tags (str)
(mapcar #'string-downcase (cl-ppcre:split ", " str)))
(slurp-remainder ()
(let ((seq (make-string (- (file-length in) (file-position in)))))
(read-sequence seq in)
(remove #\Nul seq))))
(check-header)
(let ((args (loop for line = (read-line in nil) until (string= line ";;;;;")
appending (list (make-keyword (string-upcase (field-name line)))
(aref (parse-field line) 0)))))
(setf (getf args :tags) (read-tags (getf args :tags))
(getf args :format) (make-keyword (string-upcase (getf args :format))))
(apply 'make-instance 'post
(append args (list :content (render-content (slurp-remainder)
(getf args :format))
:slug (slugify (getf args :title))))))))
(defmethod initialize-instance :after ((object post) &key)
(with-accessors ((title post-title)
(format post-format)
(text content-text)) object
(setf (content-slug object) (slugify title)
format (make-keyword (string-upcase format))
text (render-content text format))))
(defun load-posts ()
"Read the stored .post files from the repo."
(clrhash *posts*)
(defmethod discover ((content-type (eql :post)))
(purge-all 'post)
(do-files (file (repo *config*) "post")
(with-open-file (in file)
(let ((post (read-post in)))
(if (gethash (post-slug post) *posts*)
(let ((post (construct 'post (read-content file t))))
(if (gethash (content-slug post) *content*)
(error "There is already an existing post with the slug ~a."
(post-slug post))
(setf (gethash (post-slug post) *posts*) post))))))
(content-slug post))
(setf (gethash (content-slug post) *content*) post)))))
(defun render-posts ()
"Iterate through the files in the repo to render+write the posts out to disk."
(loop for (prev post next) on (append '(nil) (sort (hash-table-values *posts*)
#'string< :key #'post-date))
(defmethod publish ((content-type (eql :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))))
(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)))

2
themes/atom.tmpl
View file

@ -22,7 +22,7 @@
<name>{$config.author}</name>
<uri>{$config.domain}</uri>
</author>
<content type="html">{$post.content |noAutoescape}</content>
<content type="html">{$post.text |noAutoescape}</content>
</entry>
{/foreach}

2
themes/hyde/index.tmpl
View file

@ -6,7 +6,7 @@
<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.content |noAutoescape}</div>
<div class="article">{$post.text |noAutoescape}</div>
</div>
{/foreach}
<div id="relative-nav">

2
themes/hyde/post.tmpl
View file

@ -14,7 +14,7 @@
</div>{\n}
</div>{\n}
<div class="article-content">{\n}
{$post.content |noAutoescape}
{$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}

2
themes/rss.tmpl
View file

@ -20,7 +20,7 @@
{foreach $tag in $post.tags}
<category><![CDATA[ {$tag} ]]></category>
{/foreach}
<description><![CDATA[ {$post.content |noAutoescape} ]]></description>
<description><![CDATA[ {$post.text |noAutoescape} ]]></description>
</item>
{/foreach}