diff --git a/helpers.lisp b/helpers.lisp index 8d5c1f90ca93c22d3550311db25524400f13d8bf..36a87d3cb9ebeb7f21333b31d1b62ea59c475813 100644 --- a/helpers.lisp +++ b/helpers.lisp @@ -1,22 +1,54 @@ ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- (in-package :cl-site) -; Makes pathname from prefix + page object + (defun make-path (prefix suffix &optional page) + "Constructs a pathname from `prefix` and `suffix`. + `suffix` can be one of + 1. a context (an alist) with a ':content' element + 2. a pathname + 3. a string identifying a path + + `prefix` can be one of + 1. a pathname + 2. a string identifying a path + " (let ((path (if page (cdr (assoc :content suffix)) suffix))) (if (pathnamep prefix) (merge-pathnames path prefix) (pathname (concatenate 'string prefix path))))) -; Slurps file from a string (defun file-to-string (filepath) + "Reads the file designated by pathname `filepath` into memory, + returning the string with the sequence read from the file" (with-open-file (stream filepath) (let ((data (make-string (file-length stream)))) (read-sequence data stream) data))) +(defun header-lines (lines) + "Returns a list of lines (subset of `lines`) + which form the header of the document `lines` were read from + " + (loop for line in lines + thereis (when (string= line "---") header-lines) + collect line into header-lines)) + +(defun content-lines (lines) + "Returns a list of lines (subset of `lines`) + which remain after the header (if any) has been discarded + " + (loop with found-header-p = nil + for line in lines + when found-header-p + collect line into post-header-lines + when (string= line "---") + do (setf found-header-p t) + collect line into content-lines + finally (return (if found-header-p post-header-lines content-lines)))) + (defun populate-pages () "Each page is an alist containing info to be sent to the template via the context." (mapcar (lambda (p) @@ -31,6 +63,35 @@ (directory (merge-pathnames #P"**/*.lisp" *pages-dir*))))) +(defvar *render-hooks* '() + "A list of hooks wrapping the rendering of the page.") + +(defmacro def-render-hook (name (&rest args) &rest body) + "Registers a hook to wrap the rendering of the page. + + Provides a `call-next-hook` function which dispatches + execution to the next wrapper and ultimately to the + page renderer. + + The wrapper should return the value received from + a `call-next-hook` to its caller as it is the content + of the rendered page. + " + `(progn + (defun ,name (,@args next-hooks) + (flet ((call-next-hook (content context) + (funcall (pop next-hooks) content context next-hooks))) + ,@body)) + (push (function ,name) *render-hooks*))) + +(defun render-page-with-hooks (content context) + (let ((hooks (reverse (cons #'(lambda (p c next-processors) + (process-page p c)) + *render-hooks*)))) + (funcall (pop hooks) content context hooks))) + + + (defun page-content (page) (rest (assoc :content page))) diff --git a/main.lisp b/main.lisp index 5c37a345dddd4785ac31aa7355f6aac31dcef700..568043be114bf4c295994941b0ecaba2404ea27a 100644 --- a/main.lisp +++ b/main.lisp @@ -1,20 +1,6 @@ ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- (in-package :cl-site) -(defun header-lines (lines) - (loop for line in lines - thereis (when (string= line "---") header-lines) - collect line into header-lines)) - -(defun content-lines (lines) - (loop with found-header-p = nil - for line in lines - when found-header-p - collect line into post-header-lines - when (string= line "---") - do (setf found-header-p t) - collect line into content-lines - finally (return (if found-header-p post-header-lines content-lines)))) (defun make-site (&optional output-dir) (let ((*output-dir* (or output-dir *output-dir*)) @@ -52,12 +38,8 @@ and do (format t "Delayed rendering ~a~%" rel-page-path) when satisfies-deps-p do (progn - (format t "Rendering ~A~%" rel-page-path)) - (preprocess-md-page content context - (list #'preprocess-lisp-page - #'generate-news - (lambda (p c next-processors) - (process-page p c)))) + (format t "Rendering ~A~%" rel-page-path) + (render-page-with-hooks content context)) and collect rel-page-path into processed-pages and do (loop for resolved-deps-pages = (loop for delay in delayed-pages @@ -67,11 +49,7 @@ and do (progn (format t "Rendering delayed ~a~%" (fourth delay)) (push (fourth delay) processed-pages) - (preprocess-md-page (second delay) (third delay) - (list #'preprocess-lisp-page - #'generate-news - (lambda (p c next-processors) - (process-page p c)))))) + (render-page-with-hooks (second delay) (third delay)))) while resolved-deps-pages do (setf delayed-pages (set-difference delayed-pages resolved-deps-pages :key #'fourth :test #'string=)))))) diff --git a/process.lisp b/process.lisp index 1a5ea632778d5d2c82bc59e67cb5b6aebad6ab3a..9fd47acae3de1889e8bae2eef451872805e530cf 100644 --- a/process.lisp +++ b/process.lisp @@ -47,21 +47,21 @@ page-context) stream)))))) -(defun preprocess-md-page (content context next-processors) +(def-render-hook preprocess-md-page (content context) (let* ((md-file (enough-namestring (make-path *pages-dir* context t) *pages-dir*))) (unless (string= (pathname-type md-file) "md") - (return-from preprocess-md-page (funcall (pop next-processors) content context next-processors))) + (return-from preprocess-md-page (call-next-hook content context))) (let ((html-file (make-pathname :defaults md-file :type "html"))) (format t "Transforming ~A to ~A~%" md-file html-file) (let ((md-content (with-output-to-string (out) (cl-markdown:markdown content :stream out)))) - (funcall (pop next-processors) md-content context next-processors))))) + (call-next-hook md-content context))))) -(defun preprocess-lisp-page (content context next-processors) +(def-render-hook preprocess-lisp-page (content context) (let* ((lisp-file (make-path *pages-dir* context t))) (unless (string= (pathname-type lisp-file) "lisp") - (return-from preprocess-lisp-page (funcall (pop next-processors) content context next-processors))) + (return-from preprocess-lisp-page (call-next-hook content context))) (let ((html-file (enough-namestring (make-pathname :defaults lisp-file :type "html") *pages-dir*)) *computed-page-content*) (format t "Loading ~a and creating fresh ~a...~%" @@ -69,13 +69,12 @@ ;;;###TODO not happy about loading the lisp file; it defeats the preprocessor/postprocessor purpose (load (merge-pathnames lisp-file *pages-dir*)) (let ((headers (getf *computed-page-content* :headers))) - (funcall (pop next-processors) (getf *computed-page-content* :html-string) - (append (mapcan #'(lambda (key value) - (acons key value nil)) - (plist-keys headers) - (plist-values headers)) - context) - next-processors))))) + (call-next-hook (getf *computed-page-content* :html-string) + (append (mapcan #'(lambda (key value) + (acons key value nil)) + (plist-keys headers) + (plist-values headers)) + context)))))) (defun process-page (content context) (let ((template-path (pathname (merge-pathnames *templates-dir* *DEFAULT-PAGE-TEMPLATE*)))) @@ -92,9 +91,9 @@ ;; newsbox. The news.lisp would have to include the hardcoded HTML ;; which is injected below as well. ;; -(defun generate-news (content context next-processors) +(def-render-hook generate-news (content context) (let ((page-path (cdr (assoc :content context))) - (content (funcall (pop next-processors) content context next-processors))) + (content (call-next-hook content context))) (when (and (string= (pathname-name page-path) "news") (string= (pathname-type page-path) "md")) (let ((newsbox (generate-news-box-content content)))