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

WARNING: This commit breaks indices and feeds.

Browse source 
Factor write-page from render-page. Reorganization to allow for new content types.
This commit is contained in:
Brit Butler 2012-11-28 16:10:33 -05:00
parent 2a248f96e9
commit 3ddd50bf7f
3 changed files with 70 additions and 61 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

29
src/coleslaw.lisp
View file

@ -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))
(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)))))
: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))))
(write-line page out)))
(defun compile-blog (staging)
"Compile the blog to a STAGING directory as specified in .coleslawrc."

72
src/posts.lisp
View file

@ -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*)
@ -32,43 +61,8 @@
"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))))))))
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."

10
src/util.lisp
View file

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