commit c76060870e256c2a5623442aba9e24e80164a24b
parent a91c3801ae59a187adb0326d25da18537469c823
Author: Decay <decay@todayiwilllaunchmyinfantsonintoorbit.com>
Date: Tue, 15 Sep 2020 13:57:59 -0700
Page generation code
Still not wired yet. Also fixed up ASDF file to properly include rss
template.
Diffstat:
3 files changed, 136 insertions(+), 1 deletion(-)
diff --git a/miniblog.asd b/miniblog.asd
@@ -27,7 +27,9 @@ into date-structured directories as a normal HTML."
(:file "db")
(:file "content")
(:file "miniblog")
- (:static-file "template.lhtml")))
+ (:static-file "pagetemplate.lhtml")
+ (:static-file "template.lhtml")
+ (:static-file "rss.lxml")))
(:static-file "COPYING")
(:static-file "README")))
diff --git a/src/content.lisp b/src/content.lisp
@@ -5,6 +5,10 @@
(make-pathname :name "template" :type "lhtml"
:directory (pathname-directory this-file)
:defaults this-file))
+ (register-emb "default-page-template"
+ (make-pathname :name "pagetemplate" :type "lhtml"
+ :directory (pathname-directory this-file)
+ :defaults this-file))
(register-emb "rss"
(make-pathname :name "rss" :type "lxml"
:directory (pathname-directory this-file)
@@ -29,6 +33,22 @@
: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))))
+
(defun strip-html-tags (content)
(format nil "~{~A~}"
(mapcar
@@ -201,3 +221,11 @@
:enable-rss enable-rss
:archive-date-list archive-date-list
:tz tz))
+
+(defun gen-page (entry &key generator tz archive-date-list enable-rss)
+ "Generate a single page"
+ (funcall (or generator (make-page-generator))
+ entry
+ :enable-rss enable-rss
+ :archive-date-list archive-date-list
+ :tz tz))
diff --git a/src/pagetemplate.lhtml b/src/pagetemplate.lhtml
@@ -0,0 +1,105 @@
+<!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>
