commit 2546858f6901d7b206f204a7936924e61f29bf25
parent c6270e1a6f8219f621c124d2cfc6e7ff2a3db3d4
Author: Decay <decay@todayiwilllaunchmyinfantsonintoorbit.com>
Date: Mon, 28 Nov 2022 21:57:15 -0800
Implement support for collapsibles and individual post pages links
Also simplify the main post template. Need to implement post page
generation next.
Diffstat:
5 files changed, 84 insertions(+), 64 deletions(-)
diff --git a/src/content.lisp b/src/content.lisp
@@ -10,7 +10,7 @@
(defun render-posts (posts pages &key stream title root-uri header links
stylesheet year month archive-date-list
- enable-rss twitter-card)
+ enable-rss twitter-card collapse-posts-p)
(render-template* *posts-template* stream
:posts posts
:pages pages
@@ -23,7 +23,8 @@
:month month
:archive-date-list archive-date-list
:enable-rss enable-rss
- :twitter-card twitter-card))
+ :twitter-card twitter-card
+ :collapse-posts-p collapse-posts-p))
(defun render-page (page path pages &key stream title root-uri header links
stylesheet year month
@@ -57,10 +58,11 @@
:managing-editor managing-editor
:webmaster webmaster
:category category
- :build-date (miniblog.format:rfc-822-format (now)) ))
+ :build-date (miniblog.format:rfc-822-format (now))
+ :collapse-posts-p t))
(defun make-generator (&key title root-uri header links stylesheet)
- (lambda (posts pages &key year month archive-date-list enable-rss twitter-card)
+ (lambda (posts pages &key year month archive-date-list enable-rss twitter-card collapse-posts-p)
(render-posts posts pages
:title title
:root-uri root-uri
@@ -71,7 +73,8 @@
:month month
:archive-date-list archive-date-list
:enable-rss enable-rss
- :twitter-card twitter-card)))
+ :twitter-card twitter-card
+ :collapse-posts-p collapse-posts-p)))
(defun make-page-generator (&key title root-uri header links stylesheet)
(lambda (page path pages &key archive-date-list enable-rss twitter-card)
@@ -257,7 +260,8 @@
index-entries pages
:twitter-card twitter-card
:enable-rss enable-rss
- :archive-date-list archive-date-list))))
+ :archive-date-list archive-date-list
+ :collapse-posts-p t))))
(defun gen-month (entries year month pages &key generator archive-date-list enable-rss twitter-card)
"Generate a page with all posts for the given year and month"
@@ -277,7 +281,8 @@
:month month
:twitter-card twitter-card
:enable-rss enable-rss
- :archive-date-list archive-date-list))
+ :archive-date-list archive-date-list
+ :collapse-posts-p t))
nil)
rest-entries))))
diff --git a/src/data.lisp b/src/data.lisp
@@ -1,5 +1,7 @@
(in-package :miniblog.data)
+(defparameter +post-link-format+ "~a/~a/~a.html")
+
(defun format-dates (content)
(let ((created-at (getf content :created-at))
(last-updated-at (getf content :last-updated-at)))
@@ -11,6 +13,10 @@
(setf (getf content :last-updated-at-long) (miniblog.format:long-date-format last-updated-at))
content))
+(defun format-post-link (entry)
+ (let ((created-at (mito.dao.mixin:object-created-at entry)))
+ (format nil +post-link-format+ (miniblog.format:year created-at) (miniblog.format:month created-at) (mito.dao.mixin:object-id entry))))
+
(defgeneric xform (entry)
(:documentation "Transform an entry of some type into an idiomatic p-list"))
@@ -23,7 +29,8 @@
:title (entry-title entry)
:content (entry-content entry)
:created-by (entry-username entry)
- :last-updated-by (entry-last-updated-by entry))))
+ :last-updated-by (entry-last-updated-by entry)
+ :link (format-post-link entry))))
(defmethod xform ((entry blog-pages))
"Transform a blog-pages object into an idiomatic p-list"
diff --git a/src/format.lisp b/src/format.lisp
@@ -10,10 +10,16 @@
"Long format datetime, like:
Monday, February 3rd 2020 at 2:46 PM PST")
-(defun markdown (content)
- "Translate CONTENT with 3bmd"
- (with-output-to-string (os)
- (3bmd:parse-string-and-print-to-stream content os)))
+(defun markdown (content &optional collapse-link)
+ "Translate CONTENT with 3bmd. If EXPAND is true then render the full post, otherwise cut at the first ---."
+ (let* ((md-content (with-output-to-string (os)
+ (3bmd:parse-string-and-print-to-stream content os)))
+ (rule-pos (search "<hr/>" md-content)))
+ (if (and rule-pos collapse-link)
+ (concatenate 'string
+ (subseq md-content 0 rule-pos)
+ (format nil "<a href=\"~a\">Read more...</a>~%" collapse-link))
+ md-content)))
(defun rfc-822-format (datetime &optional (tz *default-timezone*))
"RFC 822/1123 date formatter for RSS items"
@@ -33,20 +39,27 @@
:format +long-date-format+
:timezone tz))
+(defun year (datetime &optional (tz *default-timezone*))
+ (format-timestring nil datetime :format '((:year 4)) :timezone tz))
+
+(defun month (datetime &optional (tz *default-timezone*))
+ (format-timestring nil datetime :format '((:month 2)) :timezone tz))
+
(defun make-content-formatter ()
"Return the default content formatter (parses Markdown)"
#'markdown)
;;; Djula formatting elements (tags and filters)
+(defun %resolve (x)
+ (etypecase x
+ (string x)
+ (number x)
+ (symbol (djula::resolve-variable-phrase (list x)))))
+
(def-tag-compiler :page-tree (path pages &optional (root-uri "/"))
(lambda (stream)
- (labels ((% (x)
- (etypecase x
- (string x)
- (number x)
- (symbol (djula::resolve-variable-phrase (list x)))))
- (descend (parent-path child-path pages)
+ (labels ((descend (parent-path child-path pages)
(format stream "<ul class=\"page-list\">~%")
(loop for page in (getf pages :children)
do (let* ((next-name (car child-path))
@@ -54,47 +67,42 @@
(page-name (getf page :name))
(page-path (append parent-path (list page-name)))
(page-path-str (str:join "/" page-path)))
- (format stream "<li><a href=\"~apage/~a\">~a</a>~%" (% root-uri) page-path-str (getf page :title))
+ (format stream "<li><a href=\"~apage/~a\">~a</a>~%" (%resolve root-uri) page-path-str (getf page :title))
(if (and (string= page-name next-name) descendents)
(descend page-path descendents page))
(format stream "</li>~%")))
(format stream "</ul>~%")))
- (descend nil (% path) (% pages)))))
+ (descend nil (%resolve path) (%resolve pages)))))
(def-tag-compiler :nav-calendar (archive-date-list &optional (root-uri "/"))
- (flet ((% (x)
- (etypecase x
- (string x)
- (number x)
- (symbol (djula::resolve-variable-phrase (list x))))))
- (lambda (stream)
- (let ((arc (copy-list (% archive-date-list))))
- (loop while arc do
- (format stream "<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 stream "<tr>~%")
- (loop for cal-month from (* row 4) to (+ (* row 4) 3) do
- (format stream "<td>")
- (if (nth cal-month month-entries)
- (format stream "<a href=\"~a~a\">~a</a>"
- (% root-uri)
- (nth cal-month month-entries)
- (nth cal-month month-names))
- (format stream "~A" (nth cal-month month-names)))
- (format stream "</td>~%"))
- (format stream "</tr>~%")))
- (format stream "</table>~%"))))))
+ (lambda (stream)
+ (let ((arc (copy-list (%resolve archive-date-list))))
+ (loop while arc do
+ (format stream "<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 stream "<tr>~%")
+ (loop for cal-month from (* row 4) to (+ (* row 4) 3) do
+ (format stream "<td>")
+ (if (nth cal-month month-entries)
+ (format stream "<a href=\"~a~a\">~a</a>"
+ (%resolve root-uri)
+ (nth cal-month month-entries)
+ (nth cal-month month-names))
+ (format stream "~A" (nth cal-month month-names)))
+ (format stream "</td>~%"))
+ (format stream "</tr>~%")))
+ (format stream "</table>~%")))))
-(def-filter :markdown (content)
- (markdown content))
+(def-filter :markdown (content &optional collapse-link)
+ (markdown content (when collapse-link (djula::resolve-variable-phrase (djula::parse-variable-phrase collapse-link)))))
(def-filter :strip-html (content)
(format nil "~{~A~}"
diff --git a/src/packages.lisp b/src/packages.lisp
@@ -8,6 +8,7 @@
(:import-from :str :split)
(:import-from :djula :def-tag-compiler :def-filter)
(:export #:markdown #:rfc-822-format #:short-date-format #:long-date-format
+ #:year #:month
#:make-content-formatter
#:make-rfc-822-date-formatter
#:make-short-date-formatter
diff --git a/templates/posts.dtl b/templates/posts.dtl
@@ -7,16 +7,8 @@
<meta name="twitter:image" content="{{ twitter-card.image }}">
{% endif %}
{% if posts %}
- {% comment %}
- Djula doesn't offer a clean way to just grab the CAR from posts so this
- is a placeholder.
- {% endcomment %}
- {% for post in posts %}
- {% if forloop.first %}
- <meta name="twitter:title" content="{{ post.title }}">
- <meta name="twitter:description" content="{{ post.content|markdown|strip-html|truncatechars:200 }}">
- {% endif %}
- {% endfor %}
+ <meta name="twitter:title" content="{{ posts.0.title }}">
+ <meta name="twitter:description" content="{{ posts.0.content|markdown|strip-html|truncatechars:200 }}">
{% else %}
<meta name="twitter:title" content="{{ title }}">
{% endif %}
@@ -32,8 +24,15 @@
<h1>{{ post.created-at-short }}</h1>
{% endifchanged %}
<a name="{{ post.id }}"></a>
- <h2>{{ post.title }}</h2>
- <article>{{ post.content|safe|markdown }}</article>
+ {% if collapse-posts-p %}
+ <h2><a href="{{ post.link }}">{{ post.title }}</a></h2>
+ <article>
+ {{ post.content|safe|markdown:post.link }}
+ </article>
+ {% else %}
+ <h2>{{ post.title }}</h2>
+ <article>{{ post.content|safe|markdown }}</article>
+ {% endif %}
<p role="note">
<small>
Posted by {{ post.created-by }} on {{ post.created-at-long }}
