From 3ddd50bf7fcef6b91cb070f5aeed634497c1bff8 Mon Sep 17 00:00:00 2001 From: Brit Butler Date: Wed, 28 Nov 2012 16:10:33 -0500 Subject: [PATCH] WARNING: This commit breaks indices and feeds. Factor write-page from render-page. Reorganization to allow for new content types. --- src/coleslaw.lisp | 45 +++++++++++++++++----------- src/posts.lisp | 76 ++++++++++++++++++++++------------------------- src/util.lisp | 10 +++++-- 3 files changed, 70 insertions(+), 61 deletions(-) diff --git a/src/coleslaw.lisp b/src/coleslaw.lisp index df6abdb..903e325 100644 --- a/src/coleslaw.lisp +++ b/src/coleslaw.lisp @@ -1,26 +1,37 @@ (in-package :coleslaw) -(defgeneric render (content &key &allow-other-keys) - (:documentation "Render the given CONTENT to HTML.")) +(defgeneric render (object &key &allow-other-keys) + (:documentation "Render the given OBJECT to HTML.")) + +(defgeneric render-content (text format) + (:documentation "Compile TEXT from the given FORMAT to HTML for display.") + (:method (text (format (eql :html))) + text) + (:method (test (format (eql :md))) + (let ((3bmd-code-blocks:*code-blocks* t)) + (with-output-to-string (str) + (3bmd:parse-string-and-print-to-stream text str))))) + +(defgeneric page-path (content) + (:documentation "The path to store CONTENT at once rendered.")) (defun render-page (content &optional theme-fn &rest render-args) "Render the given CONTENT to disk using THEME-FN if supplied. Additional args to render CONTENT can be passed via RENDER-ARGS." - (let* ((path (etypecase content - (post (format nil "posts/~a.html" (post-slug content))) - (index (index-path content)))) - (filepath (merge-pathnames path (staging *config*))) - (page (funcall (theme-fn (or theme-fn 'base)) - (list :config *config* - :content content - :raw (apply 'render content render-args) - :pubdate (make-pubdate) - :injections (find-injections content))))) - (ensure-directories-exist filepath) - (with-open-file (out filepath - :direction :output - :if-does-not-exist :create) - (write-line page out)))) + (funcall (theme-fn (or theme-fn 'base)) + (list :config *config* + :content content + :raw (apply 'render content render-args) + :pubdate (make-pubdate) + :injections (find-injections content)))) + +(defun write-page (filepath page) + "Write the given PAGE to FILEPATH." + (ensure-directories-exist filepath) + (with-open-file (out filepath + :direction :output + :if-does-not-exist :create) + (write-line page out))) (defun compile-blog (staging) "Compile the blog to a STAGING directory as specified in .coleslawrc." diff --git a/src/posts.lisp b/src/posts.lisp index 3099090..b98dfa9 100644 --- a/src/posts.lisp +++ b/src/posts.lisp @@ -11,12 +11,41 @@ (format :initform nil :initarg :format :accessor post-format) (content :initform nil :initarg :content :accessor post-content))) -(defmethod render ((content post) &key prev next) +(defmethod render ((object post) &key prev next) (funcall (theme-fn 'post) (list :config *config* - :post content + :post object :prev prev :next next))) +(defmethod page-path ((post post)) + (rel-path (staging *config*) "posts/~a.html" (post-slug post))) + +(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*) @@ -30,45 +59,10 @@ (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)) - while post do (render-page post nil :prev prev :next next))) - -(defgeneric render-content (text format) - (:documentation "Compile TEXT from the given FORMAT to HTML for display.") - (:method (text (format (eql :html))) - text)) - -(defmethod render-content (text (format (eql :md))) - (let ((3bmd-code-blocks:*code-blocks* t)) - (with-output-to-string (str) - (3bmd:parse-string-and-print-to-stream text str)))) - -(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))) - (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 field in '("title" "tags" "date" "format") - for line = (read-line in nil) - appending (list (make-keyword (string-upcase field)) - (aref (parse-field line) 0))))) - (check-header) - (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)))))))) + (loop for (prev post next) on (append '(nil) (sort (hash-table-values *posts*) + #'string< :key #'post-date)) + 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." diff --git a/src/util.lisp b/src/util.lisp index 4052e6e..203c57d 100644 --- a/src/util.lisp +++ b/src/util.lisp @@ -1,9 +1,13 @@ (in-package :coleslaw) -(defun app-path (path &rest args) - "Take a relative PATH and return the corresponding pathname beneath coleslaw. +(defun rel-path (base path &rest args) + "Take a relative PATH and return the corresponding pathname beneath BASE. If ARGS is provided, use (apply 'format nil PATH ARGS) as the value of PATH." - (merge-pathnames (apply 'format nil path args) coleslaw-conf:*basedir*)) + (merge-pathnames (apply 'format nil path args) base)) + +(defun app-path (path &rest args) + "Return a relative path beneath coleslaw." + (apply 'rel-path coleslaw-conf:*basedir* path args)) (defun run-program (program &rest args) "Take a PROGRAM and execute the corresponding shell command. If ARGS is provided,