Commit 7bf046e0 authored by Dave Cooper's avatar Dave Cooper

Address discussion points from @ehuelsmann for !48.

parent e21dcf77
...@@ -26,7 +26,7 @@ Load with this command: ...@@ -26,7 +26,7 @@ Load with this command:
To clean any old output/ directory: To clean any old output/ directory:
(cl-site:make-clean) (cl-site:make-clean)
To generate the site: To generate the site:
......
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
(add-content (add-content
:title "Common-Lisp.net | About" :headers-plist (list :|title| "Common-Lisp.net | About")
:html-string :html-string
(with-cl-who-string (:indent t) (with-cl-who-string (:indent t)
(:h1 ((:i :class "far fa-question-circle")) " About Common-Lisp.net") (:h1 ((:i :class "far fa-question-circle")) " About Common-Lisp.net")
......
This diff is collapsed.
...@@ -24,21 +24,6 @@ ...@@ -24,21 +24,6 @@
(defparameter *PRIVATE-KEYS* '(:slug :content)) (defparameter *PRIVATE-KEYS* '(:slug :content))
(defun populate-pages ()
(mapcar (lambda (p)
(list (cons :content (file-namestring p))
(cons :title (file-namestring p))))
;;
;; At this point there could be duplicate, i.e. a .html and a .lisp file.
;;
(append
(directory (make-pathname :defaults *PAGES-DIR* :name :wild :type "html"))
(directory (make-pathname :defaults *PAGES-DIR* :name :wild :type "lisp")))))
(defparameter *PAGES* (populate-pages)
"Each page is an alist containing info to be sent to the template via the context.")
;; Initialize global context (will be appended to all individual page contexts) ;; Initialize global context (will be appended to all individual page contexts)
;; Used to store things like stylesheets, etc... ;; Used to store things like stylesheets, etc...
(defparameter *GLOBAL-CONTEXT* ()) (defparameter *GLOBAL-CONTEXT* ())
......
...@@ -14,4 +14,71 @@ ...@@ -14,4 +14,71 @@
(with-open-file (stream filepath) (with-open-file (stream filepath)
(let ((data (make-string (file-length stream)))) (let ((data (make-string (file-length stream))))
(read-sequence data stream) (read-sequence data stream)
data))) data)))
\ No newline at end of file
(defun populate-pages ()
"Each page is an alist containing info to be sent to the template via the context."
(mapcar (lambda (p)
(list (cons :content (file-namestring p))
(cons :title (file-namestring p))))
;;
;; At this point there could be duplicate, i.e. a .html and a .lisp file.
;;
(append
(directory (make-pathname :defaults *PAGES-DIR* :name :wild :type "html"))
(directory (make-pathname :defaults *PAGES-DIR* :name :wild :type "lisp")))))
(defun page-content (page) (rest (assoc :content page)))
(defun add-content (&key headers-plist html-string)
(setq *computed-page-content* (list :headers headers-plist :html-string html-string)))
;;
;; FLAG -- the following are from Gendl - remove if/when we start :depending
;; on :gendl or :gwl
;;
(defun plist-keys (plist)
"List of keyword symbols. Returns the keys from a plist.
:arguments (plist \"Plist\")"
(when plist
(cons (first plist)
(plist-keys (rest (rest plist))))))
(defun plist-values (plist)
"List of Lisp objects. Returns the values from a plist.
:arguments (plist \"Plist\")"
(when plist
(cons (second plist)
(plist-values (rest (rest plist))))))
(defmacro with-cl-who-string ((&rest args) &body body)
"Form. Sets up body to be evaluated with cl-who:with-html-output and return the resulting string instead
of writing to a stream."
(let ((ss (gensym)))
`(with-output-to-string (,ss)
(cl-who:with-html-output (,ss nil ,@args) ,@body))))
(defmacro wmd (string)
"Form suitable for inclusion in cl-who LHTML context. Returns an
`str` form after passing it through cl-markdown's markdown processor.
"
;;
;; FLAG -- should we be checking for loaded markdown package at compile-time instead?
;;
`(cl-who:str (cond ((find-package :markdown.cl)
(funcall (read-from-string "markdown.cl:parse") ,string))
((find-package :cl-markdown)
(with-output-to-string (ss)
(funcall (read-from-string "cl-markdown:markdown") ,string :stream ss))))))
;;
;; End of Gendl utilities.
;;
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
(let ((*output-dir* (or output-dir *output-dir*))) (let ((*output-dir* (or output-dir *output-dir*)))
(format t "Generating site in ~A.~%" *output-dir*) (format t "Generating site in ~A.~%" *output-dir*)
(process-static) (process-static)
(process-pages *pages*))) (process-pages (populate-pages))))
(defun make-clean (&optional (output-dir *output-dir*)) (defun make-clean (&optional (output-dir *output-dir*))
......
...@@ -49,7 +49,7 @@ ...@@ -49,7 +49,7 @@
(header content) (header content)
(split-content-from-header page-path) (split-content-from-header page-path)
(let* ((header-text (format nil "~{~A~%~}" header)) (let* ((header-text (format nil "~{~A~%~}" header))
(content-text (format nil "~{~A~%~}" (remove nil content))) (content-text (format nil "~{~A~%~}" content))
(parsed-header (yaml:parse header-text)) (parsed-header (yaml:parse header-text))
(page-context (page-context
(when parsed-header (when parsed-header
...@@ -65,8 +65,6 @@ ...@@ -65,8 +65,6 @@
(defun process-pages (pages) (defun process-pages (pages)
(format t "Processing pages...~%") (format t "Processing pages...~%")
...@@ -77,7 +75,7 @@ ...@@ -77,7 +75,7 @@
(let ((template-path (pathname (merge-pathnames *LAYOUT-DIR* *DEFAULT-PAGE-TEMPLATE*)))) (let ((template-path (pathname (merge-pathnames *LAYOUT-DIR* *DEFAULT-PAGE-TEMPLATE*))))
(ensure-directories-exist *OUTPUT-DIR*) (ensure-directories-exist *OUTPUT-DIR*)
(setq pages (populate-pages)) (setq pages (populate-pages)) ;; to pick up any newly generated .html files.
(dolist (page pages) (dolist (page pages)
(let ((page-pathname (merge-pathnames (page-content page) *pages-dir*))) (let ((page-pathname (merge-pathnames (page-content page) *pages-dir*)))
(when (string-equal (pathname-type page-pathname) "html") (when (string-equal (pathname-type page-pathname) "html")
...@@ -95,14 +93,16 @@ ...@@ -95,14 +93,16 @@
(let* ((lisp-file (page-content page))) (let* ((lisp-file (page-content page)))
(when (string-equal (pathname-type lisp-file) "lisp") (when (string-equal (pathname-type lisp-file) "lisp")
(let ((html-file (make-pathname :defaults lisp-file :type "html"))) (let ((html-file (make-pathname :defaults lisp-file :type "html")))
(format t "Compile/loading ~a and creating fresh ~a...~%" (format t "Loading ~a and creating fresh ~a...~%"
(file-namestring lisp-file) html-file) (file-namestring lisp-file) html-file)
(let ((fasl (compile-file (merge-pathnames lisp-file *pages-dir*))) (let (*computed-page-content*)
*computed-page-content*) (load (merge-pathnames lisp-file *pages-dir*))
(load fasl) (delete-file fasl)
(with-open-file (out (merge-pathnames html-file *pages-dir*) :if-exists :supersede (with-open-file (out (merge-pathnames html-file *pages-dir*) :if-exists :supersede
:if-does-not-exist :create :direction :output) :if-does-not-exist :create :direction :output)
(format out "title: ~a~%---~%" (getf *computed-page-content* :title)) (let ((headers (getf *computed-page-content* :headers)))
(mapc #'(lambda(key value) (format out "~a: ~a~%" key value))
(plist-keys headers)(plist-values headers)))
(format out "---~%")
(write-string (getf *computed-page-content* :html-string) out)))))))) (write-string (getf *computed-page-content* :html-string) out))))))))
;; Process news ;; Process news
...@@ -118,7 +118,7 @@ ...@@ -118,7 +118,7 @@
;; ;;
(defun generate-news () (defun generate-news ()
(let ((html (let ((html
(markdown:parse-file (merge-pathnames "news.md" *PAGES-DIR*)))) (markdown.cl:parse-file (merge-pathnames "news.md" *PAGES-DIR*))))
(with-open-file (f (merge-pathnames "news.html" *PAGES-DIR*) (with-open-file (f (merge-pathnames "news.html" *PAGES-DIR*)
:direction :output :direction :output
:if-does-not-exist :create :if-does-not-exist :create
...@@ -196,34 +196,8 @@ ...@@ -196,34 +196,8 @@
(plump:serialize news nil)))) (plump:serialize news nil))))
(defmacro with-cl-who-string ((&rest args) &body body)
"Form. Sets up body to be evaluated with cl-who:with-html-output and return the resulting string instead
of writing to a stream."
(let ((ss (gensym)))
`(with-output-to-string (,ss)
(cl-who:with-html-output (,ss nil ,@args) ,@body))))
(defmacro wmd (string)
"Form suitable for inclusion in cl-who LHTML context. Returns an
`str` form after passing it through cl-markdown's markdown processor.
"
;;
;; FLAG -- should we be checking for loaded markdown package at compile-time instead?
;;
`(cl-who:str (cond ((find-package :markdown.cl)
(funcall (read-from-string "markdown.cl:parse") ,string))
((find-package :cl-markdown)
(with-output-to-string (ss)
(funcall (read-from-string "cl-markdown:markdown") ,string :stream ss))))))
(defun page-content (page) (rest (assoc :content page)))
(defun add-content (&key title html-string)
(setq *computed-page-content* (list :title title :html-string html-string)))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment