miniblog

Miniblog: A command-line static blog system in Common Lisp
Log | Files | Refs | README | LICENSE

commit 80f0856b7d8892f253f6fdc3d6bea44df473d5a8
parent b4f6e20ff3862358a8e106920422b3396b3a8da7
Author: Decay <decaydjk@tilde.town>
Date:   Fri,  7 Feb 2020 23:41:58 +0000

Initial implementation of archive dates

Diffstat:
Msrc/content.lisp | 68+++++++++++++++++++++++++++++++++++++++++++++++++-------------------
Msrc/template.lhtml | 39++++++++++++++++-----------------------
2 files changed, 65 insertions(+), 42 deletions(-)

diff --git a/src/content.lisp b/src/content.lisp @@ -1,12 +1,13 @@ (in-package :miniblog.content) (defun make-generator (&optional title) - (lambda (entries &key year month tz) + (lambda (entries &key year month archive-date-list tz) (execute-emb "default-template" :env (list :title title :posts entries + :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*)))))) @@ -56,25 +57,47 @@ (cdr entries) year month tz))) (cons (cons (car entries) (car collected)) (cdr collected))))))) +(defun get-archive-date-list (entries tz) + (labels + ((get-year-month-pair-for-entry (entry) + (let* ((real-tz (or tz *default-timezone*)) + (created-at (nth 1 entry)) + (year (timestamp-year created-at :timezone real-tz)) + (month (timestamp-month created-at :timezone real-tz))) + (cons year month))) + (year-month-pairs-equal-p (a b) + (and (= (car a) (car b)) (= (cdr a) (cdr b))))) + (remove-duplicates + (mapcar #'get-year-month-pair-for-entry entries) + :test #'year-month-pairs-equal-p))) + (defun gen-all (entries &key generator tz) (labels - ((gen-all-years (entries next-year generator tz) - (let ((year (gen-year entries next-year :generator generator :tz tz))) - (if (cdr year) - (append - (car year) - (gen-all-years - (cdr year) - (car (year-month-of-latest-entry (cdr year) :tz tz)) - generator tz)) - (car year))))) - (cons - (list :index :index (gen-index entries :generator generator :tz tz)) - (gen-all-years - entries (car (year-month-of-latest-entry entries :tz tz)) - generator tz)))) + ((gen-all-years (entries archive-date-list generator tz) + (format t "ENTRIES ~a~%ARC ~a~%" entries archive-date-list) + (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) + :archive-date-list archive-date-list + :generator generator + :tz tz))) + (setf rest-entries (cdr month-content)) + (setf content + (nconc content (list (car month-content)))))) + content))) + (let ((archive-date-list (get-archive-date-list entries tz))) + (cons + (list :index :index (gen-index-impl entries + archive-date-list + :generator generator + :tz tz)) + (gen-all-years + entries archive-date-list + generator tz))))) -(defun gen-index (entries &key generator tz) +(defun gen-index-impl (entries archive-date-list &key generator tz) (if (not entries) (funcall (or generator (make-generator)) nil :tz tz) (let* ((year-month (year-month-of-latest-entry entries :tz tz)) @@ -83,12 +106,18 @@ (latest-month-entries (collect-entries-for-month entries entry-year entry-month tz))) (funcall (or generator (make-generator)) (car latest-month-entries) + :archive-date-list archive-date-list :tz tz)))) -(defun gen-year (entries year &key generator tz) +(defun gen-index (entries &key generator tz) + (gen-index-impl entries (get-archive-date-list entries tz) + :generator generator :tz tz)) + +(defun gen-year (entries year &key archive-date-list generator tz) (labels ((gen-month-and-earlier (entries year month tz) (let ((this-month (gen-month entries year month + :archive-date-list archive-date-list :generator generator :tz tz))) (if (> month 1) @@ -106,7 +135,7 @@ (cdr this-month)))))) (gen-month-and-earlier entries year 12 tz))) -(defun gen-month (entries year month &key generator tz) +(defun gen-month (entries year month &key archive-date-list generator tz) (let* ((entries-at-month (monthcdr entries year month tz)) (collected (collect-entries-for-month entries-at-month year month tz)) @@ -119,6 +148,7 @@ month-entries :year year :month month + :archive-date-list archive-date-list :tz tz)) nil) rest-entries))) diff --git a/src/template.lhtml b/src/template.lhtml @@ -35,34 +35,27 @@ <% @endif %> <nav> <% @if archive-date-list %> - <% (let ((arc (copy-list (getf env :archive-date-list)))) %> - <% (loop while arc do %> - <div class="cal-title"><%= (car (car arc)) %></div> - <% + <% + (let ((arc (copy-list (getf env :archive-date-list)))) + (loop while arc do + (format t "<div class=\"cal-title\">~a</div>" (caar arc)) (let ((month-entries '()) (month-names '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))) - (loop for cal-month from 12 to 1 do - (if (= cal-month (cdr (car arc))) + (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" (car (car arc)) (cdr (car arc))) month-entries) + (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 %> - <div class="cal-row"> - <% (loop for cal-month from (* row 4) to (+ (* row 4) 3) do %> - <span class="cal-cell"> - <% - (if (nth cal-month month-entries) - (format t "<a href=\"~a\">~a</a>" (nth cal-month month-entries) (nth cal-month month-names)) - (format t "~A" (nth cal-month month-names))) - %> - </span> - <% ) %> - </div> - <% ) %> - <% ) %> - <% ) %> - <% ) %> + (loop for row from 0 to 2 do + (format t "<div class=\"cal-row\">~%") + (loop for cal-month from (* row 4) to (+ (* row 4) 3) do + (format t "<span class=\"cal-cell\">") + (if (nth cal-month month-entries) + (format t "<a href=\"~a\">~a</a>" (nth cal-month month-entries) (nth cal-month month-names)) + (format t "~A" (nth cal-month month-names))) + (format t "</span>~%")) + (format t "</div>~%"))))) %> <% @endif %> </nav> </body>