format.lisp (4401B)
1 (in-package :miniblog.format) 2 3 (defparameter +short-date-format+ 4 '((:year 4) #\- (:month 2) #\- (:day 2)) 5 "Date in YYYY-MM-DD format") 6 7 (defparameter +long-date-format+ 8 '(:long-weekday ", " :long-month #\ :ordinal-day #\ (:year 4) 9 " at " :hour12 #\: (:min 2) #\ :ampm #\ :timezone) 10 "Long format datetime, like: 11 Monday, February 3rd 2020 at 2:46 PM PST") 12 13 (defun markdown (content) 14 "Translate CONTENT with 3bmd" 15 (with-output-to-string (os) 16 (3bmd:parse-string-and-print-to-stream content os))) 17 18 (defun rfc-822-format (datetime &optional (tz *default-timezone*)) 19 "RFC 822/1123 date formatter for RSS items" 20 (format-timestring nil datetime 21 :format +rfc-1123-format+ 22 :timezone tz)) 23 24 (defun short-date-format (datetime &optional (tz *default-timezone*)) 25 "Short-datetime formatter (see +short-date-format+)" 26 (format-timestring nil datetime 27 :format +short-date-format+ 28 :timezone tz)) 29 30 (defun long-date-format (datetime &optional (tz *default-timezone*)) 31 "Long-datetime formatter (see +long-date-format+)" 32 (format-timestring nil datetime 33 :format +long-date-format+ 34 :timezone tz)) 35 36 (defun make-content-formatter () 37 "Return the default content formatter (parses Markdown)" 38 #'markdown) 39 40 ;;; Djula formatting elements (tags and filters) 41 42 (def-tag-compiler :page-tree (path pages &optional (root-uri "/")) 43 (lambda (stream) 44 (labels ((% (x) 45 (etypecase x 46 (string x) 47 (number x) 48 (symbol (djula::resolve-variable-phrase (list x))))) 49 (descend (parent-path child-path pages) 50 (format stream "<ul class=\"page-list\">~%") 51 (loop for page in (getf pages :children) 52 do (let* ((next-name (car child-path)) 53 (descendents (cdr child-path)) 54 (page-name (getf page :name)) 55 (page-path (append parent-path (list page-name))) 56 (page-path-str (str:join "/" page-path))) 57 (format stream "<li><a href=\"~apage/~a\">~a</a>~%" (% root-uri) page-path-str (getf page :title)) 58 (if (and (string= page-name next-name) descendents) 59 (descend page-path descendents page)) 60 (format stream "</li>~%"))) 61 (format stream "</ul>~%"))) 62 (descend nil (% path) (% pages))))) 63 64 (def-tag-compiler :nav-calendar (archive-date-list &optional (root-uri "/")) 65 (flet ((% (x) 66 (etypecase x 67 (string x) 68 (number x) 69 (symbol (djula::resolve-variable-phrase (list x)))))) 70 (lambda (stream) 71 (let ((arc (copy-list (% archive-date-list)))) 72 (loop while arc do 73 (format stream "<table class=\"calendar\"><tr><th colspan=\"4\">~a</th></tr>~%" (caar arc)) 74 (let ((month-entries '()) 75 (month-names '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))) 76 (loop for cal-month downfrom 12 to 1 do 77 (if (and arc (= cal-month (cdar arc))) 78 (progn 79 (push (format nil "~d/~2,'0d/index.html" (caar arc) (cdar arc)) month-entries) 80 (pop arc)) 81 (push nil month-entries))) 82 (loop for row from 0 to 2 do 83 (format stream "<tr>~%") 84 (loop for cal-month from (* row 4) to (+ (* row 4) 3) do 85 (format stream "<td>") 86 (if (nth cal-month month-entries) 87 (format stream "<a href=\"~a~a\">~a</a>" 88 (% root-uri) 89 (nth cal-month month-entries) 90 (nth cal-month month-names)) 91 (format stream "~A" (nth cal-month month-names))) 92 (format stream "</td>~%")) 93 (format stream "</tr>~%"))) 94 (format stream "</table>~%")))))) 95 96 (def-filter :markdown (content) 97 (markdown content)) 98 99 (def-filter :strip-html (content) 100 (format nil "~{~A~}" 101 (mapcar 102 (lambda (s) 103 (let ((chunks (split ">" s))) 104 (or (second chunks) (first chunks)))) 105 (split "<" content))))