Merge pull request #8 from redline6561/content-types

Extensible Content types.

NEWS.md

@@ -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.

TODO

@@ -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

coleslaw.asd

@@ -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")

docs/coleslaw.html

@@ -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>
+<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">config-key</span>
+<span class="symboltype">function</span></div>
+<div class="documentation">
+<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="(setf deploy)_func" href="#(setf deploy)_func">(setf deploy)</a>
-<span class="lambdalist">new-value object</span>
+<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>:undocumented</pre></div></div>
+<pre>The path to store OBJECT at once rendered.</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="symboltype">function</span></div>
+<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>Load the user's config, then compile and deploy the blog.</pre></div></div>
+<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>

plugins/mathjax.lisp

@@ -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)))

src/coleslaw.lisp

@@ -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*)))

src/content.lisp

@@ -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)))

src/feeds.lisp

@@ -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)))

src/indices.lisp

@@ -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)
-                                                              (+ index step))))
+                                     (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"))

src/packages.lisp

@@ -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))

src/posts.lisp

@@ -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)))
-
-(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))))))))
-
-(defun load-posts ()
-  "Read the stored .post files from the repo."
-  (clrhash *posts*)
+  (rel-path (staging *config*) "posts/~a" (content-slug object)))
+
+(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))))
+
+(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*)
-            (error "There is already an existing post with the slug ~a."
-                   (post-slug post))
-            (setf (gethash (post-slug post) *posts*) 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))
+    (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."
+                 (content-slug post))
+          (setf (gethash (content-slug post) *content*) post)))))
+
+(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)))

themes/atom.tmpl

@@ -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}
 

themes/hyde/index.tmpl

@@ -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">

themes/hyde/post.tmpl

@@ -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}

themes/rss.tmpl

@@ -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}