commit bacd99dcb980281b7a575763510c61e092e881d0
parent c76060870e256c2a5623442aba9e24e80164a24b
Author: Decay <decay@todayiwilllaunchmyinfantsonintoorbit.com>
Date: Fri, 18 Sep 2020 14:04:36 -0700
Support for static pages!
There is now a parallel tree of pages that can be created outside the
post structure in the fashion of Wordpress or other heavier-duty
blogging platforms. See the README to get started!
Diffstat:
15 files changed, 620 insertions(+), 373 deletions(-)
diff --git a/README b/README
@@ -45,10 +45,13 @@ $ ~/miniblog.lisp -h
--list -l boolean List posts
--start -s integer When listing posts, first post to list (default 0)
-n integer When listing posts, max number of posts to list (default all)
+ --page -p boolean This parameter specifies operations to be done on pages, rather than posts. EG saying -a -p means you intend to add a new page rather than a new post. Page IDs are in a separate namespace from post IDs.
+ --move -m integer Move a page from its current path to a new one.
+ --uri -u string When adding a new page, this specifies the path to the new page in relative URI format. For instance, "-a -p -u foo/bar" would specify that the new page should be created with the name bar as a child of page foo. This is only valid if root page foo actually exists. This isalso used in conjunction with -m to specify the target path for the page being moved, with the same restriction. A leading / will be ignored so "-u /foo/bar/baz" and "-u foo/bar/baz" mean the same thing.
+ --children-to-root -c boolean When deleting a page, normally child pages of the page being deleted will be moved to the parent page of the deleted page. If -c is specified, the pages will instead be moved to the root.
--regen-all -r boolean When adding or editing, regenerate all pages instead of just those miniblog thinks have changed. Can also be invoked standalone to regenerate the HTML directly.
- --help -h boolean This help information
-By default, add and edit will use whatever editor you have specified in EDITOR, otherwise will fall back to vi. Posts are written in a convenient format:
+By default, add and edit will use whatever editor you have specified in EDITOR, otherwise will fall back to vi. Posts (and pages) are written in a convenient format:
[Title]
diff --git a/miniblog.asd b/miniblog.asd
@@ -11,6 +11,7 @@ into date-structured directories as a normal HTML."
:author "DecayDJK <decaydjk@tilde.town>"
:license "GPLv3 or later"
:depends-on ("uiop"
+ "alexandria"
"cl-fad"
"cl-markdown"
"cl-emb"
@@ -26,7 +27,11 @@ into date-structured directories as a normal HTML."
(:file "edit")
(:file "db")
(:file "content")
- (:file "miniblog")
+ (:file "miniblog")))
+ (:module "templates"
+ :components ((:static-file "html-head.lhtml")
+ (:static-file "header.lhtml")
+ (:static-file "left-column.lhtml")
(:static-file "pagetemplate.lhtml")
(:static-file "template.lhtml")
(:static-file "rss.lxml")))
diff --git a/src/content.lisp b/src/content.lisp
@@ -1,53 +1,61 @@
(in-package :miniblog.content)
-(let ((this-file #.(or *compile-file-truename* *load-truename*)))
+(let* ((this-file #.(or *compile-file-truename* *load-truename*))
+ (src-dir (pathname-directory this-file))
+ (templates-dir (append (butlast src-dir) '("templates"))))
+ (defparameter *templates-dir* (make-pathname :directory templates-dir))
(register-emb "default-template"
(make-pathname :name "template" :type "lhtml"
- :directory (pathname-directory this-file)
+ :directory templates-dir
:defaults this-file))
(register-emb "default-page-template"
(make-pathname :name "pagetemplate" :type "lhtml"
- :directory (pathname-directory this-file)
+ :directory templates-dir
:defaults this-file))
(register-emb "rss"
(make-pathname :name "rss" :type "lxml"
- :directory (pathname-directory this-file)
+ :directory templates-dir
:defaults this-file)))
(defun make-generator (&key title root-uri header links stylesheet)
- (lambda (entries &key year month archive-date-list tz enable-rss)
- (execute-emb
- "default-template"
- :env (list
- :title title
- :root-uri root-uri
- :header header
- :links links
- :stylesheet stylesheet
- :enable-rss enable-rss
- :posts entries
- :year year
- :month month
- :archive-date-list archive-date-list
- :content-formatter (miniblog.format:make-content-formatter)
- :short-date-formatter (miniblog.format:make-short-date-formatter (or tz *default-timezone*))
- :long-date-formatter (miniblog.format:make-long-date-formatter (or tz *default-timezone*))))))
+ (lambda (entries pages &key year month archive-date-list tz enable-rss)
+ (let ((*default-pathname-defaults* *templates-dir*))
+ (execute-emb
+ "default-template"
+ :env (list
+ :title title
+ :root-uri root-uri
+ :header header
+ :links links
+ :stylesheet stylesheet
+ :enable-rss enable-rss
+ :posts entries
+ :year year
+ :month month
+ :pages pages
+ :archive-date-list archive-date-list
+ :content-formatter (miniblog.format:make-content-formatter)
+ :short-date-formatter (miniblog.format:make-short-date-formatter (or tz *default-timezone*))
+ :long-date-formatter (miniblog.format:make-long-date-formatter (or tz *default-timezone*)))))))
(defun make-page-generator (&key title root-uri header links stylesheet)
- (lambda (entry &key archive-date-list tz enable-rss)
- (execute-emb
- "default-page-template"
- :env (list
- :title title
- :root-uri root-uri
- :header header
- :links links
- :stylesheet stylesheet
- :enable-rss enable-rss
- :archive-date-list archive-date-list
- :content-formatter (miniblog.format:make-content-formatter)
- :long-date-formatter (miniblog.format:make-long-date-formatter (or tz *default-timezone*))
- :post entry))))
+ (lambda (entry path pages &key archive-date-list tz enable-rss)
+ (let ((*default-pathname-defaults* *templates-dir*))
+ (execute-emb
+ "default-page-template"
+ :env (list
+ :title title
+ :root-uri root-uri
+ :header header
+ :links links
+ :stylesheet stylesheet
+ :enable-rss enable-rss
+ :pages pages
+ :post entry
+ :path path
+ :archive-date-list archive-date-list
+ :content-formatter (miniblog.format:make-content-formatter)
+ :long-date-formatter (miniblog.format:make-long-date-formatter (or tz *default-timezone*)))))))
(defun strip-html-tags (content)
(format nil "~{~A~}"
@@ -61,26 +69,48 @@
copyright managing-editor webmaster category)
(if (and title link description)
(lambda (entries &key tz)
- (execute-emb
- "rss"
- :env (list
- :title title
- :link link
- :description description
- :image-url image-url
- :language language
- :copyright copyright
- :managing-editor managing-editor
- :webmaster webmaster
- :category category
- :posts entries
- :build-date (now)
- :content-formatter (miniblog.format:make-content-formatter)
- :content-stripper #'strip-html-tags
- :rfc-822-date-formatter (miniblog.format:make-rfc-822-date-formatter (or tz *default-timezone*)))))
+ (let ((*default-pathname-defaults* *templates-dir*))
+ (execute-emb
+ "rss"
+ :env (list
+ :title title
+ :link link
+ :description description
+ :image-url image-url
+ :language language
+ :copyright copyright
+ :managing-editor managing-editor
+ :webmaster webmaster
+ :category category
+ :posts entries
+ :build-date (now)
+ :content-formatter (miniblog.format:make-content-formatter)
+ :content-stripper #'strip-html-tags
+ :rfc-822-date-formatter (miniblog.format:make-rfc-822-date-formatter (or tz *default-timezone*))))))
(lambda (entries &key tz)
(declare (ignore entries tz)))))
+(defun get-page-by-path (path pages)
+ (labels ((get-page-name (name page-list)
+ (find-if #'(lambda (page) (string= name (getf page :name)))
+ page-list)))
+ (car (last (loop for path-elem in path
+ for curr-page = pages then next-page
+ for page-list = (getf curr-page :children)
+ for next-page = (get-page-name path-elem page-list)
+ when (null next-page) return nil
+ collect next-page)))))
+
+(defun get-page-id-by-path (path pages)
+ (getf (get-page-by-path path pages) :id))
+
+(defun get-path-to-page (id pages-table)
+ (reverse (loop for next-id = id then (getf page :parent)
+ until (zerop next-id)
+ for page = (gethash next-id pages-table)
+ when (null page) return nil
+ collect (getf page :name))))
+
(defun year-month-of-entry (entry &key tz)
(if (not entry)
(error "Entry cannot be nil")
@@ -133,39 +163,68 @@
(mapcar #'get-year-month-pair-for-entry entries)
:test #'year-month-pairs-equal-p)))
-(defun gen-all (entries &key generator rss-generator tz)
- "Generate a list of all monthly pages as well as the index and RSS feed"
+(defun gen-all-pages (pages &key prefix all-pages archive-date-list generator tz enable-rss)
+ "Generate all pages in the tree rooted at PAGES. PREFIX may be supplied if this is a subtree, in which case ALL-PAGES should also be supplied so that the page nav can render correctly."
+ (labels ((with-paths (parent-path entries)
+ (mapcar #'(lambda (entry)
+ (cons entry
+ (append parent-path (cons (getf entry :name) nil))))
+ entries))
+ (gen-pages-recur (generated queue)
+ (if (= 0 (length queue))
+ generated
+ (let* ((next-page (caar queue))
+ (path (cdar queue))
+ (next-page-content (gen-page next-page
+ path
+ (or all-pages pages)
+ :generator generator
+ :tz tz
+ :archive-date-list archive-date-list
+ :enable-rss enable-rss))
+ (next-page-entry (list :page path next-page-content))
+ (queue-rest (cdr queue))
+ (queue-new (with-paths path (getf next-page :children))))
+ (gen-pages-recur (append generated (cons next-page-entry nil))
+ (append queue-rest queue-new))))))
+ (gen-pages-recur nil (with-paths prefix (getf pages :children)))))
+
+(defun gen-all (entries pages &key generator page-generator rss-generator tz)
+ "Generate a list of all monthly pages and hierarchical pages as well as the index and RSS feed"
(labels
- ((gen-all-years (entries archive-date-list generator tz enable-rss)
+ ((gen-all-years (entries pages archive-date-list generator tz enable-rss)
(let ((rest-entries (copy-list entries))
(content '()))
(loop for year-month in archive-date-list do
(let ((month-content
(gen-month rest-entries
(car year-month) (cdr year-month)
+ pages
:enable-rss enable-rss
:archive-date-list archive-date-list
:generator generator
:tz tz)))
(setf rest-entries (cdr month-content))
- (setf content
- (nconc content (list (car month-content))))))
+ (setf content (cons (car month-content) content))))
content)))
(let ((archive-date-list (get-archive-date-list entries tz))
(rss-content (gen-rss-feed entries
:generator rss-generator
:tz tz)))
- (cons
- (list :rss nil rss-content)
- (cons
- (list :index nil (gen-index entries
- :enable-rss rss-content
- :archive-date-list archive-date-list
- :generator generator
- :tz tz))
- (gen-all-years
- entries archive-date-list
- generator tz rss-content))))))
+ (append (list
+ (list :rss nil rss-content)
+ (list :index nil (gen-index entries pages
+ :enable-rss rss-content
+ :archive-date-list archive-date-list
+ :generator generator
+ :tz tz)))
+ (gen-all-pages pages
+ :archive-date-list archive-date-list
+ :generator page-generator
+ :tz tz
+ :enable-rss rss-content)
+ (gen-all-years entries pages
+ archive-date-list generator tz rss-content)))))
(defun top-ten (entries)
(if (>= (length entries) 10)
@@ -179,7 +238,7 @@
index-entries
:tz tz)))
-(defun gen-index (entries &key generator tz archive-date-list enable-rss)
+(defun gen-index (entries pages &key generator tz archive-date-list enable-rss)
"Generate the index (front page) with the latest ten posts"
(if (not entries)
(funcall (or generator (make-generator)) nil :tz tz)
@@ -187,12 +246,12 @@
(get-archive-date-list entries tz)))
(index-entries (top-ten entries)))
(funcall (or generator (make-generator))
- index-entries
+ index-entries pages
:enable-rss enable-rss
:archive-date-list archive-date-list
:tz tz))))
-(defun gen-month (entries year month &key generator tz archive-date-list enable-rss)
+(defun gen-month (entries year month pages &key generator tz archive-date-list enable-rss)
"Generate a page with all posts for the given year and month"
(let ((archive-date-list (or archive-date-list
(get-archive-date-list entries tz))))
@@ -205,7 +264,7 @@
(if month-entries
(list year month
(funcall (or generator (make-generator))
- month-entries
+ month-entries pages
:year year
:month month
:enable-rss enable-rss
@@ -214,18 +273,18 @@
nil)
rest-entries))))
-(defun gen-post (entry &key generator tz archive-date-list enable-rss)
+(defun gen-post (entry pages &key generator tz archive-date-list enable-rss)
"Generate a single post page"
(funcall (or generator (make-generator))
- (list entry)
+ (list entry) pages
:enable-rss enable-rss
:archive-date-list archive-date-list
:tz tz))
-(defun gen-page (entry &key generator tz archive-date-list enable-rss)
+(defun gen-page (entry path pages &key generator tz archive-date-list enable-rss)
"Generate a single page"
(funcall (or generator (make-page-generator))
- entry
+ entry path pages
:enable-rss enable-rss
:archive-date-list archive-date-list
:tz tz))
diff --git a/src/db.lisp b/src/db.lisp
@@ -164,6 +164,15 @@
(if entry
(xform entry))))
+(defmacro with-page-id (page id &rest body)
+ "Takes a varname to hold the entry list and a page id
+ and executes the forms in body with the entry bound
+ to the specified entry variable"
+ `(let ((,page (miniblog.db:get-page ,id)))
+ (if ,page
+ (progn ,@body)
+ (format t "Page ID ~d not found~%" ,id))))
+
(defun build-tree-table (dao-list &optional (xform #'xform))
(let ((entry-table (make-hash-table)))
(labels ((build-tree (raw-entry)
@@ -180,9 +189,9 @@
entry-table)))
(defun get-pages (&optional (root-id 0))
- "Get all pages in a tree, or optionally a subtree starting from a given id"
+ "Get all pages in a tree, or optionally a subtree starting from a given id. Returns the subtree as the first return value and the (unconditionally) full hashtable as the second."
(let* ((entry-table (build-tree-table (select-dao 'blog-pages))))
- (gethash root-id entry-table)))
+ (values (gethash root-id entry-table) entry-table)))
(defun update-page (id name title content &key (username "nobody"))
"Update page by id. Returns the updated page or nil if the id doesn't exist."
diff --git a/src/miniblog.lisp b/src/miniblog.lisp
@@ -13,7 +13,8 @@
; If it's set to a string in .miniblogrc, will be
; translated with uiop:parse-native-namestring
(defvar *root-uri*) ; Absolute or relative root uri, defaults to "~username"
-(defvar *generator*) ; Function to generate content page, see content.lisp
+(defvar *generator*) ; Function to generate post pages, see content.lisp
+(defvar *page-generator*) ; Function to generate hierarchical pages, see content.lisp
(defvar *rss-generator*) ; Function to generate RSS feed, see content.lisp
;;; The following are all used to populate RSS channel elements.
@@ -38,6 +39,10 @@
:documentation "When listing posts, first post to list (default 0)")
((#\n) :type integer :optional t
:documentation "When listing posts, max number of posts to list (default all)")
+ (("page" #\p) :type boolean :optional t :documentation "This parameter specifies operations to be done on pages, rather than posts. EG saying -a -p means you intend to add a new page rather than a new post. Page IDs are in a separate namespace from post IDs.")
+ (("move" #\m) :type integer :optional t :documentation "Move a page from its current path to a new one.")
+ (("uri" #\u) :type string :optional t :documentation "When adding a new page, this specifies the path to the new page in relative URI format. For instance, \"-a -p -u foo/bar\" would specify that the new page should be created with the name bar as a child of page foo. This is only valid if root page foo actually exists. This is also used in conjunction with -m to specify the target path for the page being moved, with the same restriction. A leading / will be ignored so \"-u /foo/bar/baz\" and \"-u foo/bar/baz\" mean the same thing.")
+ (("children-to-root" #\c) :type boolean :optional t :documentation "When deleting a page, normally child pages of the page being deleted will be moved to the parent page of the deleted page. If -c is specified, the pages will instead be moved to the root.")
(("regen-all" #\r) :type boolean :optional t
:documentation "When adding or editing, regenerate all pages instead of just those miniblog thinks have changed. Can also be invoked standalone to regenerate the HTML directly.")
(("help" #\h) :type boolean :optional t :documentation "This help information")))
@@ -62,6 +67,12 @@
:header *blog-header*
:links *blog-links*
:stylesheet *blog-stylesheet*))
+ (setf *page-generator*
+ (miniblog.content:make-page-generator :title *blog-title*
+ :root-uri *root-uri*
+ :header *blog-header*
+ :links *blog-links*
+ :stylesheet *blog-stylesheet*))
(setf *rss-generator*
(miniblog.content:make-rss-generator :title *blog-title*
:link *blog-link*
@@ -81,6 +92,11 @@
(defun get-index-file ()
(get-index-file-for-path *public-html*))
+(defun get-page-path (path-list)
+ (merge-pathnames
+ (make-pathname :directory (append '(:relative "page") path-list))
+ *public-html*))
+
(defun get-rss-file ()
(merge-pathnames
(make-pathname :name "rss" :type "xml")
@@ -93,11 +109,38 @@
(format nil "~2,'0d" month)))
*public-html*))
+(defun cleanup-path (filepath)
+ (format t "Cleaning ~S...~%" filepath)
+ (cond
+ ((and (string= (pathname-name filepath) "index")
+ (string= (pathname-type filepath) "html"))
+ (delete-file filepath))
+ ((fad:directory-pathname-p filepath)
+ (handler-case (uiop:delete-empty-directory filepath)
+ (file-error (e)
+ (declare (ignore e))
+ (format t "~cDirectory ~a not empty...~%" #\tab filepath))))
+ (t (format t "~cUnrecognized file ~a, ignoring...~%" #\tab filepath))))
+
+(defun flush-path (path)
+ (fad:walk-directory path #'cleanup-path
+ :directories :depth-first
+ :if-does-not-exist :ignore
+ :follow-symlinks nil))
+
+(defun flush-page-path (path-list)
+ (flush-path (get-page-path path-list)))
+
+(defun flush-monthly-path (year month)
+ (flush-path (get-monthly-path year month)))
+
(defun get-path-and-description-for-entry (entry)
(let* ((year (nth 0 entry))
(month (nth 1 entry)))
(cond
((eql year :index) (values (get-index-file) "index"))
+ ((eql year :page) (values (get-index-file-for-path (get-page-path month))
+ (str:join "/" month)))
((eql year :rss) (values (get-rss-file) "RSS feed"))
(t (values
(get-index-file-for-path (get-monthly-path year month))
@@ -131,11 +174,48 @@
:generator *generator*
:tz *blog-timezone*)))))
-(defun regenerate-all (entries)
- (let ((all (miniblog.content:gen-all entries
- :generator *generator*
- :rss-generator *rss-generator*
- :tz *blog-timezone*)))
+(defun regenerate-page-and-parent-and-children (parent-path page-id pages)
+ (let* ((entries (miniblog.db:get-entries))
+ (subtree-root (miniblog.content:get-page-by-path parent-path pages))
+ (archive-date-list (miniblog.content:get-archive-date-list entries
+ *blog-timezone*))
+ (rss-content (miniblog.content:gen-rss-feed entries
+ :generator *rss-generator*
+ :tz *blog-timezone*)))
+ (regenerate-file (list :page parent-path
+ (miniblog.content:gen-page subtree-root
+ parent-path
+ pages
+ :enable-rss rss-content
+ :generator *page-generator*
+ :tz *blog-timezone*
+ :archive-date-list archive-date-list)))
+ (loop for page in (getf subtree-root :children)
+ do (let ((path (append parent-path (list (getf page :name)))))
+ (regenerate-file (list :page
+ path
+ (miniblog.content:gen-page
+ page path pages
+ :enable-rss rss-content
+ :generator *page-generator*
+ :tz *blog-timezone*
+ :archive-date-list archive-date-list)))))
+ (let ((this-page (find-if #'(lambda (entry) (= page-id (getf entry :id))) (getf subtree-root :children))))
+ (mapcar #'regenerate-file (miniblog.content:gen-all-pages this-page
+ :prefix parent-path
+ :all-pages pages
+ :enable-rss rss-content
+ :generator *page-generator*
+ :tz *blog-timezone*
+ :archive-date-list archive-date-list)))))
+
+(defun regenerate-all ()
+ (let ((all (miniblog.content:gen-all (miniblog.db:get-entries)
+ (miniblog.db:get-pages)
+ :generator *generator*
+ :page-generator *page-generator*
+ :rss-generator *rss-generator*
+ :tz *blog-timezone*)))
(mapcar #'regenerate-file all)))
(defun entries-in-month (year month)
@@ -147,30 +227,61 @@
"Determine if there is only one entry in a given month and year"
(eql (entries-in-month year month) 1))
-(defun add-new (regen)
- (let ((text (miniblog.edit:edit-text)))
- (if text
- (let* ((post (miniblog.edit:get-title-and-content text))
- (title (nth 0 post))
- (content (nth 1 post))
- (new-entry (miniblog.db:add-entry
- (or title "Untitled")
- content
- :username (get-username)))
- (year-month (miniblog.content:year-month-of-entry
- new-entry :tz *blog-timezone*))
- (year (car year-month))
- (month (cdr year-month))
- (entries (miniblog.db:get-entries)))
- (if (or regen (new-month-p year month))
- (regenerate-all entries)
- (regenerate-index-and-given-month entries year month)))
- (format t "Abandoning post...~%"))))
+(defgeneric add-entry (entry-type uri regen)
+ (:documentation "Add a new entry of type ENTRY-TYPE. URI specifies the logical location of the new entry which is only valid for certain entry types."))
+
+(defmethod add-entry ((entry-type (eql :post)) uri regen)
+ (declare (ignore uri))
+ (if-let ((text (miniblog.edit:edit-text)))
+ (let* ((post (miniblog.edit:get-title-and-content text))
+ (title (nth 0 post))
+ (content (nth 1 post))
+ (new-entry (miniblog.db:add-entry
+ (or title "Untitled")
+ content
+ :username (get-username)))
+ (year-month (miniblog.content:year-month-of-entry
+ new-entry :tz *blog-timezone*))
+ (year (car year-month))
+ (month (cdr year-month)))
+ (if (or regen (new-month-p year month))
+ (regenerate-all)
+ (regenerate-index-and-given-month (miniblog.db:get-entries) year month)))
+ (format t "Abandoning post...~%")))
+
+(defmethod add-entry ((entry-type (eql :page)) uri regen)
+ (or (when-let* ((uri-components (str:split "/" uri))
+ (name (car (last uri-components)))
+ (parent-path (butlast uri-components))
+ (parent-id (miniblog.content:get-page-id-by-path
+ parent-path
+ (miniblog.db:get-pages))))
+ (if-let ((text (miniblog.edit:edit-text)))
+ (let* ((post (miniblog.edit:get-title-and-content text))
+ (title (nth 0 post))
+ (content (nth 1 post))
+ (new-entry (miniblog.db:add-page
+ name
+ (or title "Untitled")
+ content
+ :parent parent-id
+ :username (get-username))))
+ (if (or regen (= (length uri-components) 1))
+ (regenerate-all)
+ (regenerate-page-and-parent-and-children parent-path
+ (getf new-entry :id)
+ (miniblog.db:get-pages))))
+ (format t "Abandoning page...~%"))
+ t)
+ (format t "Invalid page name ~a~%" uri)))
(defun date-format (datetime)
(funcall (miniblog.format:make-long-date-formatter *blog-timezone*) datetime))
-(defun get-post (id)
+(defgeneric get-entry (entry-type id)
+ (:documentation "Get an entry of type ENTRY-TYPE with id ID"))
+
+(defmethod get-entry ((entry-type (eql :post)) id)
(miniblog.db:with-entry-id entry id
(format t "ID: ~d~%" (getf entry :id))
(format t "Created: ~A by ~A~%"
@@ -180,6 +291,19 @@
(format t "Title: ~A~%" (getf entry :title))
(format t "Content:~%~A~%" (getf entry :content))))
+(defmethod get-entry ((entry-type (eql :page)) id)
+ (miniblog.db:with-page-id page id
+ (format t "ID: ~d~%" (getf page :id))
+ (format t "Path: page/~a~%" (str:join "/" (miniblog.content:get-path-to-page
+ id
+ (cadr (multiple-value-list (miniblog.db:get-pages))))))
+ (format t "Created: ~A by ~A~%"
+ (date-format (getf page :created-at)) (getf page :created-by))
+ (format t "Last updated: ~A by ~A~%"
+ (date-format (getf page :last-updated-at)) (getf page :last-updated-by))
+ (format t "Title: ~A~%" (getf page :title))
+ (format t "Content:~%~A~%" (getf page :content))))
+
(defun make-template (title content)
(with-output-to-string (out)
(princ (or title "Untitled post") out)
@@ -187,33 +311,59 @@
(terpri out)
(princ content out)))
-(defun edit-post (id regen)
+(defgeneric edit-entry (entry-type id regen)
+ (:documentation "Edit an entry of type ENTRY-TYPE with id ID"))
+
+(defmethod edit-entry ((entry-type (eql :post)) id regen)
(miniblog.db:with-entry-id entry id
- (let ((text (miniblog.edit:edit-text
- :template (make-template (getf entry :title) (getf entry :content)))))
- (if text
- (let* ((post (miniblog.edit:get-title-and-content text))
- (title (nth 0 post))
- (content (nth 1 post)))
- (miniblog.db:update-entry
- id title content
- :username (get-username))
- (let* ((created-at (getf entry :created-at))
- (year (timestamp-year created-at
- :timezone *blog-timezone*))
- (month (timestamp-month created-at
- :timezone *blog-timezone*))
- (entries (miniblog.db:get-entries)))
- (if (not regen)
- (regenerate-index-and-given-month entries year month)
- (regenerate-all entries))))
- (format t "No change, abandoning...~%")))))
+ (if-let ((text (miniblog.edit:edit-text
+ :template (make-template (getf entry :title) (getf entry :content)))))
+ (let* ((post (miniblog.edit:get-title-and-content text))
+ (title (nth 0 post))
+ (content (nth 1 post)))
+ (miniblog.db:update-entry
+ id title content
+ :username (get-username))
+ (let* ((created-at (getf entry :created-at))
+ (year (timestamp-year created-at
+ :timezone *blog-timezone*))
+ (month (timestamp-month created-at
+ :timezone *blog-timezone*)))
+ (if (not regen)
+ (regenerate-index-and-given-month (miniblog.db:get-entries) year month)
+ (regenerate-all))))
+ (format t "No change, abandoning...~%"))))
+
+(defmethod edit-entry ((entry-type (eql :page)) id regen)
+ (miniblog.db:with-page-id entry id
+ (if-let ((text (miniblog.edit:edit-text
+ :template (make-template (getf entry :title) (getf entry :content)))))
+ (let* ((page (miniblog.edit:get-title-and-content text))
+ (title (nth 0 page))
+ (content (nth 1 page))
+ (new-entry (miniblog.db:update-page
+ id (getf entry :name) title content
+ :username (get-username))))
+ (if (not regen)
+ (let* ((pages-tuple (multiple-value-list (miniblog.db:get-pages)))
+ (page-table (cadr pages-tuple))
+ (parent-id (getf new-entry :parent))
+ (root (gethash 0 page-table))
+ (path (miniblog.content:get-path-to-page parent-id page-table)))
+ (regenerate-page-and-parent-and-children path id root))
+ (regenerate-all)))
+ (format t "No change, abandoning...~%"))))
+
(defun removed-month-p (year month)
"Determine if there are 0 entries in the given month and year"
(eql (entries-in-month year month) 0))
-(defun delete-post (id regen)
+(defgeneric delete-entry (entry-type id children-to-root regen)
+ (:documentation "Delete entry of type ENTRY-TYPE with id ID. CHILDREN-TO-ROOT specifies how child entries will be rerooted; only applies to hierarchical entry types."))
+
+(defmethod delete-entry ((entry-type (eql :post)) id children-to-root regen)
+ (declare (ignore children-to-root))
(miniblog.db:with-entry-id entry id
(format t "Deleting post ID ~d...~%" id)
(miniblog.db:delete-entry id)
@@ -221,20 +371,87 @@
(year (timestamp-year created-at
:timezone *blog-timezone*))
(month (timestamp-month created-at
- :timezone *blog-timezone*))
- (entries (miniblog.db:get-entries)))
+ :timezone *blog-timezone*)))
+ (flush-monthly-path year month)
(if (or regen (removed-month-p year month))
- (regenerate-all entries)
- (regenerate-index-and-given-month entries year month)))))
+ (regenerate-all)
+ (regenerate-index-and-given-month (miniblog.db:get-entries) year month)))))
+
+(defmethod delete-entry ((entry-type (eql :page)) id children-to-root regen)
+ (miniblog.db:with-page-id page id
+ (format t "Delete page ID ~d...~%" id)
+ (let* ((pages-tuple (multiple-value-list (miniblog.db:get-pages)))
+ (page-table (cadr pages-tuple))
+ (path (miniblog.content:get-path-to-page id page-table)))
+ (miniblog.db:delete-page id :children (if children-to-root
+ :children-to-root
+ :children-to-parent))
+ (flush-page-path path)
+ (if (or children-to-root (< (length path) 3))
+ (regenerate-all)
+ (let* ((parent-id (getf page :parent))
+ (pages-tuple (multiple-value-list (miniblog.db:get-pages)))
+ (page-table (cadr pages-tuple))
+ (parent (gethash parent-id page-table))
+ (parent-of-parent-id (getf parent :parent))
+ (root (gethash 0 page-table))
+ (path (miniblog.content:get-path-to-page parent-of-parent-id page-table)))
+ (regenerate-page-and-parent-and-children path parent-id root))))))
+
+(defgeneric move-entry (entry-type id uri regen)
+ (:documentation "Move entry ID of type ENTRY-TYPE to location specified in URI. Only applies to hierarchical entry types."))
+
+(defmethod move-entry ((entry-type (eql :post)) id uri regen)
+ (declare (ignore id uri regen))
+ (format t "Posts can't be moved!~%"))
-(defun list-posts (start n)
+(defmethod move-entry ((entry-type (eql :page)) id uri regen)
+ (declare (ignore regen))
+ (or (when-let* ((uri-components (str:split "/" uri))
+ (name (car (last uri-components)))
+ (parent-path (butlast uri-components))
+ (parent-id (miniblog.content:get-page-id-by-path
+ parent-path
+ (miniblog.db:get-pages))))
+
+ (miniblog.db:move-page id parent-id)
+ ;; FIXME: Regeneration logic for moving pages is complex so
+ ;; we're punting for now but we should avoid doing a full
+ ;; regen unless we have to. The basic logic should look
+ ;; something like:
+ ;; IF regen is true OR old path is top-level OR new path top-level
+ ;; THEN
+ ;; regenerate-all
+ ;; ELSE
+ ;; regenerate old parent tree
+ ;; regenerate new parent tree
+ (regenerate-all)
+ t)
+ (format t "Invalid path ~a~%" uri)))
+
+(defgeneric list-entries (entry-type start n)
+ (:documentation "List entries of type ENTRY-TYPE, possibly restricted to entries START through N. For hierarchical entry types, only START is consumed, specifying which entry to start listing from in the tree."))
+
+(defmethod list-entries ((entry-type (eql :post)) start n)
(let* ((entries (miniblog.db:get-entries))
(first (or start 0))
(last (if n
(+ first n)
(length entries))))
(dolist (entry (subseq entries first last))
- (format t "~d \"~A\" ~A~%" (getf entry :id) (getf entry :title) (getf entry :created-by)))))
+ (format t "~d \"~a\" ~a~%" (getf entry :id) (getf entry :title) (getf entry :created-by)))))
+
+(defmethod list-entries ((entry-type (eql :post)) start n)
+ (declare (ignore n))
+ (labels ((traverse (node depth)
+ (destructuring-bind (&key id name title children created-by &allow-other-keys)
+ node
+ (if (not (or (null id) (= id 0)))
+ (format t "~v{~a~:*~}~a (ID ~d) - \"~a\" ~a~%" depth '(" ") name id title created-by))
+ (loop for entry in children
+ do (traverse entry (1+ depth))))))
+ (let ((pages (miniblog.db:get-pages start)))
+ (traverse pages 0))))
(defun init-tz ()
(reread-timezone-repository))
@@ -265,13 +482,16 @@
(set-config-and-defaults)
(make-generators))
-(defun miniblog (&key add get edit delete list start n regen-all help)
+(defun miniblog (&key add get edit delete list start n page move uri children-to-root regen-all help)
+ (declare (ignore help))
(initialize)
(miniblog.db:init :sqlite3 :database-name (get-db-filename))
- (cond (add (add-new regen-all))
- (get (get-post get))
- (edit (edit-post edit regen-all))
- (delete (delete-post delete regen-all))
- (list (list-posts start n))
- (regen-all (regenerate-all (miniblog.db:get-entries)))
- (t (show-option-help +command-line-spec+))))
+ (let ((entry-type (if page :page :post)))
+ (cond (add (add-entry entry-type uri regen-all))
+ (get (get-entry entry-type get))
+ (edit (edit-entry entry-type edit regen-all))
+ (delete (delete-entry entry-type delete children-to-root regen-all))
+ (list (list-entries entry-type start n))
+ (move (move-entry entry-type move uri regen-all))
+ (regen-all (regenerate-all))
+ (t (show-option-help +command-line-spec+)))))
diff --git a/src/packages.lisp b/src/packages.lisp
@@ -16,23 +16,26 @@
(:export #:init #:init-tables #:add-entry #:get-entry
#:with-entry-id
#:get-entries #:update-entry #:delete-entry
- #:add-page #:get-page #:get-pages #:update-page
- #:delete-page))
+ #:add-page #:get-page #:with-page-id
+ #:get-pages #:update-page #:delete-page
+ #:move-page))
(defpackage :miniblog.content
(:use :cl :local-time :cl-emb :str)
- (:export #:make-generator #:make-rss-generator
- #:get-archive-date-list
+ (:export #:make-generator #:make-page-generator
+ #:make-rss-generator #:get-archive-date-list
+ #:get-page-id-by-path #:get-page-by-path #:get-path-to-page
#:year-month-of-entry #:year-month-of-latest-entry
- #:gen-all #:gen-index #:gen-month #:gen-rss-feed
- #:gen-post))
+ #:gen-all #:gen-all-pages #:gen-index #:gen-month
+ #:gen-rss-feed #:gen-page #:gen-post))
(defpackage :miniblog
(:use :cl :command-line-arguments :local-time)
+ (:import-from :alexandria :if-let :when-let*)
(:export #:initialize #:entry-point
*blog-title* *blog-header* *blog-links* *blog-stylesheet*
*blog-timezone* *public-html* *root-uri*
- *generator* *rss-generator*
+ *generator* *page-generator* *rss-generator*
*blog-description* *blog-link* *blog-image-url* *blog-language*
*blog-category* *blog-copyright* *blog-managing-editor*
*blog-webmaster*))
diff --git a/src/pagetemplate.lhtml b/src/pagetemplate.lhtml
@@ -1,105 +0,0 @@
-<!DOCTYPE html>
-<html>
- <head>
- <title>
- <%= (or (getf env :title) "Miniblog") %>
- <% @if post/title %>
- - <% @var post/title %>
- <% @endif %>
- </title>
- <style>
- header#miniblog-header { width: 100%; }
- section#miniblog-left { float: left; width: 15%; }
- section#miniblog-main { float: left; width: <%= (if (getf env :links) "65%" "80%") %>; }
- nav#miniblog-nav { float: left; width: 20%; }
- div#miniblog-rss { clear: both; }
- table.calendar { padding: 10px; float: left; }
- table.calendar td { width: 25%; }
- @media screen and (max-aspect-ratio: 1/1) {
- section#miniblog-left { float: none; width: 100%; }
- section#miniblog-main { float: none; width: 100%; }
- nav#miniblog-nav { float: none; width: 100%; }
- }
- </style>
- <% @if stylesheet %>
- <link rel="stylesheet" type="text/css" href="<% @var stylesheet %>">
- <% @endif %>
- <% @if enable-rss %>
- <link rel="alternate" type="application/rss+xml"
- title="RSS feed for <%= (or (getf env :title) "Miniblog") %>"
- href="<% @var root-uri %>rss.xml">
- <% @endif %>
- </head>
- <body>
- <header id="miniblog-header">
- <% @if header %>
- <% @includevar header %>
- <% @endif %>
- </header>
- <section id="miniblog-left">
- <% @if links %>
- <% @loop links %>
- <a href="<% @var link %>"><% @var text %></a><br>
- <% @endloop %>
- <% @endif %>
- </section>
- <section id="miniblog-main">
- <% @if post/content %>
- <% (destructuring-bind (&key ((:post (&key content created-at last-updated-at last-updated-by &allow-other-keys))) content-formatter long-date-formatter &allow-other-keys) env %>
- <h2><% @var post/title %></h2>
- <article>
- <%= (funcall content-formatter content) %>
- </article>
- <p>
- <small>
- Posted by <% @var post/created-by %> on
- <%= (funcall long-date-formatter created-at) %>
- <% (if (local-time:timestamp/= created-at last-updated-at)
- (format t "<br>~%Last updated by ~A on ~A~%"
- last-updated-by
- (funcall long-date-formatter last-updated-at))) %>
- </small>
- </p>
- <% ) %>
- <% @else %>
- No page found.
- <% @endif %>
- </section>
- <nav id="miniblog-nav">
- <% @if archive-date-list %>
- <%
- (let ((arc (copy-list (getf env :archive-date-list))))
- (loop while arc do
- (format t "<table class=\"calendar\"><tr><th colspan=\"4\">~a</th></tr>~%" (caar arc))
- (let ((month-entries '())
- (month-names '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")))
- (loop for cal-month downfrom 12 to 1 do
- (if (and arc (= cal-month (cdar arc)))
- (progn
- (push (format nil "~d/~2,'0d/index.html" (caar arc) (cdar arc)) month-entries)
- (pop arc))
- (push nil month-entries)))
- (loop for row from 0 to 2 do
- (format t "<tr>~%")
- (loop for cal-month from (* row 4) to (+ (* row 4) 3) do
- (format t "<td>")
- (if (nth cal-month month-entries)
- (format t "<a href=\"~a~a\">~a</a>"
- (or (getf env :root-uri) "")
- (nth cal-month month-entries)
- (nth cal-month month-names))
- (format t "~A" (nth cal-month month-names)))
- (format t "</td>~%"))
- (format t "</tr>~%")))
- (format t "</table>~%"))) %>
- <% @endif %>
- <% @if enable-rss %>
- <div id="miniblog-rss">
- <a href="<% @var root-uri %>rss.xml" target="_blank">
- Subscribe to <%= (or (getf env :title) "Miniblog") %>
- </a>
- </div>
- <% @endif %>
- </nav>
- </body>
-</html>
diff --git a/src/template.lhtml b/src/template.lhtml
@@ -1,119 +0,0 @@
-<!DOCTYPE html>
-<html>
- <head>
- <title>
- <%= (or (getf env :title) "Miniblog") %>
- <% @if year %>
- - <% @var year %>/<% @var month %>
- <% @endif %>
- </title>
- <style>
- header#miniblog-header { width: 100%; }
- section#miniblog-left { float: left; width: 15%; }
- section#miniblog-main { float: left; width: <%= (if (getf env :links) "65%" "80%") %>; }
- nav#miniblog-nav { float: left; width: 20%; }
- div#miniblog-rss { clear: both; }
- table.calendar { padding: 10px; float: left; }
- table.calendar td { width: 25%; }
- @media screen and (max-aspect-ratio: 1/1) {
- section#miniblog-left { float: none; width: 100%; }
- section#miniblog-main { float: none; width: 100%; }
- nav#miniblog-nav { float: none; width: 100%; }
- }
- </style>
- <% @if stylesheet %>
- <link rel="stylesheet" type="text/css" href="<% @var stylesheet %>">
- <% @endif %>
- <% @if enable-rss %>
- <link rel="alternate" type="application/rss+xml"
- title="RSS feed for <%= (or (getf env :title) "Miniblog") %>"
- href="<% @var root-uri %>rss.xml">
- <% @endif %>
- </head>
- <body>
- <header id="miniblog-header">
- <% @if header %>
- <% @includevar header %>
- <% @endif %>
- </header>
- <section id="miniblog-left">
- <% @if links %>
- <% @loop links %>
- <a href="<% @var link %>"><% @var text %></a><br>
- <% @endloop %>
- <% @endif %>
- </section>
- <section id="miniblog-main">
- <% @if posts %>
- <% (let ((short-date) (render-hr nil)) %>
- <% (loop for post in (getf env :posts) do %>
- <% (destructuring-bind (&key id created-at last-updated-at title content created-by last-updated-by) post %>
- <% (let ((curr-short-date (funcall (getf env :short-date-formatter) created-at))) %>
- <% (if render-hr %>
- <hr>
- <% ) %>
- <% (setf render-hr t) %>
- <% (if (string/= short-date curr-short-date)
- (progn
- (setf short-date curr-short-date)
- (format t "<h1>~A</h1>~%" short-date)))) %>
- <a name="<%= id %>"></a>
- <h2><%= title %></h2>
- <article>
- <%= (funcall (getf env :content-formatter) content) %>
- </article>
- <p>
- <small>
- Posted by <%= created-by %> on
- <%= (funcall (getf env :long-date-formatter) created-at) %>
- <% (if (local-time:timestamp/= created-at last-updated-at)
- (format t "<br>~%Last updated by ~A on ~A~%"
- last-updated-by
- (funcall (getf env :long-date-formatter) last-updated-at))) %>
- </small>
- </p>
- <% ) %>
- <% ) %>
- <% ) %>
- <% @else %>
- No posts found.
- <% @endif %>
- </section>
- <nav id="miniblog-nav">
- <% @if archive-date-list %>
- <%
- (let ((arc (copy-list (getf env :archive-date-list))))
- (loop while arc do
- (format t "<table class=\"calendar\"><tr><th colspan=\"4\">~a</th></tr>~%" (caar arc))
- (let ((month-entries '())
- (month-names '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")))
- (loop for cal-month downfrom 12 to 1 do
- (if (and arc (= cal-month (cdar arc)))
- (progn
- (push (format nil "~d/~2,'0d/index.html" (caar arc) (cdar arc)) month-entries)
- (pop arc))
- (push nil month-entries)))
- (loop for row from 0 to 2 do
- (format t "<tr>~%")
- (loop for cal-month from (* row 4) to (+ (* row 4) 3) do
- (format t "<td>")
- (if (nth cal-month month-entries)
- (format t "<a href=\"~a~a\">~a</a>"
- (or (getf env :root-uri) "")
- (nth cal-month month-entries)
- (nth cal-month month-names))
- (format t "~A" (nth cal-month month-names)))
- (format t "</td>~%"))
- (format t "</tr>~%")))
- (format t "</table>~%"))) %>
- <% @endif %>
- <% @if enable-rss %>
- <div id="miniblog-rss">
- <a href="<% @var root-uri %>rss.xml" target="_blank">
- Subscribe to <%= (or (getf env :title) "Miniblog") %>
- </a>
- </div>
- <% @endif %>
- </nav>
- </body>
-</html>
diff --git a/templates/header.lhtml b/templates/header.lhtml
@@ -0,0 +1,5 @@
+<header id="miniblog-header">
+ <% @if header %>
+ <% @includevar header %>
+ <% @endif %>
+</header>
diff --git a/templates/html-head.lhtml b/templates/html-head.lhtml
@@ -0,0 +1,31 @@
+<head>
+ <title>
+ <%= (or (getf env :title) "Miniblog") %>
+ <% @if year %>
+ - <% @var year %>/<% @var month %>
+ <% @endif %>
+ </title>
+ <style>
+ header#miniblog-header { width: 100%; }
+ section#miniblog-left { float: left; width: 15%; }
+ section#miniblog-main { float: left; width: <%= (if (getf env :links) "65%" "80%") %>; }
+ nav#miniblog-nav { float: left; width: 20%; }
+ div#miniblog-rss { clear: both; }
+ table.calendar { padding: 10px; float: left; }
+ table.calendar td { width: 25%; }
+ ul.page-list { list-style: none; margin: 0; padding: 0 0 0 10px; }
+ @media screen and (max-aspect-ratio: 1/1) {
+ section#miniblog-left { float: none; width: 100%; }
+ section#miniblog-main { float: none; width: 100%; }
+ nav#miniblog-nav { float: none; width: 100%; }
+ }
+ </style>
+ <% @if stylesheet %>
+ <link rel="stylesheet" type="text/css" href="<% @var stylesheet %>">
+ <% @endif %>
+ <% @if enable-rss %>
+ <link rel="alternate" type="application/rss+xml"
+ title="RSS feed for <%= (or (getf env :title) "Miniblog") %>"
+ href="<% @var root-uri %>rss.xml">
+ <% @endif %>
+</head>
diff --git a/templates/left-column.lhtml b/templates/left-column.lhtml
@@ -0,0 +1,24 @@
+<section id="miniblog-left">
+ <a href="/">Home</a><br>
+ <% @if pages %><%
+ (labels ((descend (parent-path child-path pages)
+ (format t "<ul class=\"page-list\">~%")
+ (loop for page in (getf pages :children)
+ do (let* ((next-name (car child-path))
+ (descendents (cdr child-path))
+ (page-name (getf page :name))
+ (page-path (append parent-path (list page-name)))
+ (page-path-str (str:join "/" page-path)))
+ (format t "<li><a href=\"~apage/~a\">~a</a></li>~%" (getf env :root-uri) page-path-str (getf page :title))
+ (if (string= page-name next-name)
+ (descend page-path descendents page))))
+ (format t "</ul>~%")))
+ (descend nil (getf env :path) (getf env :pages)))
+ %><% @endif %>
+ <br>
+ <% @if links %>
+ <% @loop links %>
+ <a href="<% @var link %>"><% @var text %></a><br>
+ <% @endloop %>
+ <% @endif %>
+</section>
diff --git a/templates/nav.lhtml b/templates/nav.lhtml
@@ -0,0 +1,36 @@
+<nav id="miniblog-nav">
+ <% @if archive-date-list %>
+ <%
+ (let ((arc (copy-list (getf env :archive-date-list))))
+ (loop while arc do
+ (format t "<table class=\"calendar\"><tr><th colspan=\"4\">~a</th></tr>~%" (caar arc))
+ (let ((month-entries '())
+ (month-names '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")))
+ (loop for cal-month downfrom 12 to 1 do
+ (if (and arc (= cal-month (cdar arc)))
+ (progn
+ (push (format nil "~d/~2,'0d/index.html" (caar arc) (cdar arc)) month-entries)
+ (pop arc))
+ (push nil month-entries)))
+ (loop for row from 0 to 2 do
+ (format t "<tr>~%")
+ (loop for cal-month from (* row 4) to (+ (* row 4) 3) do
+ (format t "<td>")
+ (if (nth cal-month month-entries)
+ (format t "<a href=\"~a~a\">~a</a>"
+ (or (getf env :root-uri) "")
+ (nth cal-month month-entries)
+ (nth cal-month month-names))
+ (format t "~A" (nth cal-month month-names)))
+ (format t "</td>~%"))
+ (format t "</tr>~%")))
+ (format t "</table>~%"))) %>
+ <% @endif %>
+ <% @if enable-rss %>
+ <div id="miniblog-rss">
+ <a href="<% @var root-uri %>rss.xml" target="_blank">
+ Subscribe to <%= (or (getf env :title) "Miniblog") %>
+ </a>
+ </div>
+ <% @endif %>
+</nav>
diff --git a/templates/pagetemplate.lhtml b/templates/pagetemplate.lhtml
@@ -0,0 +1,31 @@
+<!DOCTYPE html>
+<html>
+ <% @include html-head.lhtml %>
+ <body>
+ <% @include header.lhtml %>
+ <% @include left-column.lhtml %>
+ <section id="miniblog-main">
+ <% @if post/content %>
+ <% (destructuring-bind (&key ((:post (&key content created-at last-updated-at last-updated-by &allow-other-keys))) content-formatter long-date-formatter &allow-other-keys) env %>
+ <h2><% @var post/title %></h2>
+ <article>
+ <%= (funcall content-formatter content) %>
+ </article>
+ <p>
+ <small>
+ Posted by <% @var post/created-by %> on
+ <%= (funcall long-date-formatter created-at) %>
+ <% (if (local-time:timestamp/= created-at last-updated-at)
+ (format t "<br>~%Last updated by ~A on ~A~%"
+ last-updated-by
+ (funcall long-date-formatter last-updated-at))) %>
+ </small>
+ </p>
+ <% ) %>
+ <% @else %>
+ No page found.
+ <% @endif %>
+ </section>
+ <% @include nav.lhtml %>
+ </body>
+</html>
diff --git a/src/rss.lxml b/templates/rss.lxml
diff --git a/templates/template.lhtml b/templates/template.lhtml
@@ -0,0 +1,45 @@
+<!DOCTYPE html>
+<html>
+ <% @include html-head.lhtml %>
+ <body>
+ <% @include header.lhtml %>
+ <% @include left-column.lhtml %>
+ <section id="miniblog-main">
+ <% @if posts %>
+ <% (let ((short-date) (render-hr nil)) %>
+ <% (loop for post in (getf env :posts) do %>
+ <% (destructuring-bind (&key id created-at last-updated-at title content created-by last-updated-by) post %>
+ <% (let ((curr-short-date (funcall (getf env :short-date-formatter) created-at))) %>
+ <% (if render-hr %>
+ <hr>
+ <% ) %>
+ <% (setf render-hr t) %>
+ <% (if (string/= short-date curr-short-date)
+ (progn
+ (setf short-date curr-short-date)
+ (format t "<h1>~A</h1>~%" short-date)))) %>
+ <a name="<%= id %>"></a>
+ <h2><%= title %></h2>
+ <article>
+ <%= (funcall (getf env :content-formatter) content) %>
+ </article>
+ <p>
+ <small>
+ Posted by <%= created-by %> on
+ <%= (funcall (getf env :long-date-formatter) created-at) %>
+ <% (if (local-time:timestamp/= created-at last-updated-at)
+ (format t "<br>~%Last updated by ~A on ~A~%"
+ last-updated-by
+ (funcall (getf env :long-date-formatter) last-updated-at))) %>
+ </small>
+ </p>
+ <% ) %>
+ <% ) %>
+ <% ) %>
+ <% @else %>
+ No posts found.
+ <% @endif %>
+ </section>
+ <% @include nav.lhtml %>
+ </body>
+</html>
