Add gh-pages plugin. Fixes Issue #28. Thanks mrordinaire!

NEWS.md

@@ -1,6 +1,7 @@
 ## Changes for 0.9.2 (2013-05-xx):
 
-* A new and improved implementation of tags.
+* A plugin for Github Pages support. (thanks @mrordinaire!)
+* A new and improved implementation of tags. (thanks @woudshoo!)
 * A THEME-DOES-NOT-EXIST error is raised when the theme can't be found.
 
 ## Changes for 0.9.1 (2013-04-10):

README.md

@@ -15,11 +15,11 @@ Coleslaw aims to be flexible blog software suitable for replacing a single-user
 * Markdown Support with Code Highlighting provided by [colorize](http://www.cliki.net/colorize).
   * Currently supports: Common Lisp, Emacs Lisp, Scheme, C, C++, Java, Python, Erlang, Haskell, Obj-C, Diff.
 * [Multi-site publishing](http://blub.co.za/posts/Adding-multi-site-support-to-Coleslaw.html) support.
-* Github's pages support
 
-* A [Plugin API](http://github.com/redline6561/coleslaw/blob/master/docs/plugin-api.md) and [plugins](http://github.com/redline6561/coleslaw/blob/master/docs/plugin-use.md) for...
+* A [Plugin API](http://github.com/redline6561/coleslaw/blob/master/docs/plugin-api.md) and [**plugins**](http://github.com/redline6561/coleslaw/blob/master/docs/plugin-use.md) for...
   * Comments via Disqus
   * Analytics via Google
+  * Hosting via Github Pages
   * Deploying to Amazon S3.
   * Using LaTeX (inside pairs of $$) via Mathjax
   * Using ReStructured Text

coleslaw.asd

@@ -13,8 +13,7 @@
                :inferior-shell
                :cl-fad
                :cl-ppcre
-               :closer-mop
-               :puri)
+               :closer-mop)
   :serial t
   :components ((:file "packages")
                (:file "util")

docs/plugin-use.md

@@ -16,6 +16,12 @@
 
 **Example**: ```(disqus :shortname "disqus-provided-unique-id")```
 
+## Hosting via Github Pages
+
+**Description**: Allows hosting with CNAMEs via [github-pages](http://pages.github.com/). Parses the host from the `:domain` section of your config by default. Pass in a string to override.
+
+**Example**: ```(gh-pages :cname t)```
+
 ## LaTeX via Mathjax
 
 **Description**: Provides LaTeX support through [Mathjax](http://www.mathjax.org/) for posts tagged with "math" and indexes containing such posts. Any text enclosed in $$ will be rendered, for example, ```$$ \lambda \scriptstyle{f}. (\lambda x. (\scriptstyle{f} (x x)) \lambda x. (\scriptstyle{f} (x x))) $$```.

examples/single-site.coleslawrc

@@ -1,7 +1,6 @@
 (:author "Brit Butler"
  :deploy "/home/git/blog/"
  :domain "http://blog.redlinernotes.com"
- :github-pages nil
  :feeds ("lisp")
  :plugins ((mathjax)
            (disqus :shortname "my-site-name")

plugins/gh-pages.lisp

@@ -0,0 +1,29 @@
+(eval-when (:compile-toplevel :load-toplevel)
+  (ql:quickload 'puri))
+
+(defpackage :coleslaw-gh-pages
+  (:use :cl)
+  (:import-from :puri #:parse-uri #:uri-host)
+  (:import-from :coleslaw #:*config* #:deploy #:domain #:rel-path)
+  (:export #:enable))
+
+(in-package :coleslaw-gh-pages)
+
+(defvar *cname* nil
+  "The domain CNAME for github to serve pages from.")
+
+(defmethod deploy :after (staging)
+  (let ((base (deploy *config*)))
+    (delete-file (rel-path base "index.html"))
+    (cl-fad:copy-file (rel-path base "1.html") (rel-path base "index.html"))
+    (with-open-file (out (rel-path base "CNAME")
+                     :direction :output
+                     :if-exists :supersede
+                     :if-does-not-exist :create)
+      (format out "~A~%" *cname*))))
+
+(defun enable (&key cname)
+  (typecase cname
+    (string (setf *cname* cname))
+    (t (setf *cname* (uri-host (parse-uri (domain *config*)))))
+    (otherwise (error "Not a valid CNAME: ~A" cname))))

plugins/s3.lisp

@@ -1,4 +1,4 @@
-(eval-when (:compile-toplevel)
+(eval-when (:compile-toplevel :load-toplevel)
   (ql:quickload 'zs3))
 
 (defpackage :coleslaw-s3

src/coleslaw.lisp

@@ -36,7 +36,7 @@ Additional args to render CONTENT can be passed via RENDER-ARGS."
   (ensure-directories-exist filepath)
   (with-open-file (out filepath
                    :direction :output
-                   :if-exists :overwrite
+                   :if-exists :supersede
                    :if-does-not-exist :create)
     (write-line page out)))
 
@@ -51,7 +51,7 @@ Additional args to render CONTENT can be passed via RENDER-ARGS."
       (when (probe-file dir)
         (run-program "cp -R ~a ." dir)))
     (do-ctypes (publish ctype))
-    (render-indices (not (github-pages *config*)))
+    (render-indices)
     (render-feeds (feeds *config*))))
 
 (defgeneric deploy (staging)
@@ -63,14 +63,6 @@ Additional args to render CONTENT can be passed via RENDER-ARGS."
            (curr (rel-path dest ".curr")))
       (ensure-directories-exist new-build)
       (run-program "mv ~a ~a" staging new-build)
-      (when (github-pages *config*)
-        (let ((cname-filename (rel-path "" "~a/CNAME" new-build))
-              (stripped-url (puri:uri-host (puri:parse-uri
-                                            (domain *config*)))))
-          (with-open-file (cname cname-filename
-                                 :direction :output
-                                 :if-exists :supersede)
-                          (format cname "~a~%" stripped-url))))
       (when (probe-file prev)
         (delete-directory-and-files (truename prev) :if-does-not-exist :ignore))
       (when (probe-file curr)

src/config.lisp

@@ -5,7 +5,6 @@
    (deploy :initarg :deploy :initform nil :accessor deploy)
    (domain :initarg :domain :initform "" :accessor domain)
    (feeds :initarg :feeds :initform nil :accessor feeds)
-   (github-pages :initarg :github-pages :initform nil :accessor github-pages)
    (license :initarg :license :initform nil :accessor license)
    (plugins :initarg :plugins :initform nil :accessor plugins)
    (repo :initarg :repo :initform #p"/" :accessor repo)

src/indices.lisp

@@ -67,7 +67,7 @@
                               :posts (subseq content start end)
                               :title "Recent Posts")))
 
-(defun render-indices (make-symlink-p)
+(defun render-indices ()
   "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))
@@ -83,6 +83,4 @@
                                  :prev (and (plusp i) i)
                                  :next (and (< (* (1+ i) 10) (length results))
                                             (+ 2 i)))))))
-  (if make-symlink-p
-    (update-symlink "index.html" "1.html")
-    (run-program "cp 1.html index.html")))
+  (update-symlink "index.html" "1.html"))