format.lisp (5623B)
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 truncate-and-emit-read-more (rendered-content collapse-link) 14 "Cut RENDERED-CONTENT (HTML as emitted by 3BMD) at the first <hr/> and replace with a Read more... link." 15 (let ((rule-pos (search "<hr/>" rendered-content))) 16 (if rule-pos 17 (concatenate 'string 18 (subseq rendered-content 0 rule-pos) 19 (format nil "<a href=\"~a\">Read more...</a>~%" collapse-link)) 20 rendered-content))) 21 22 (defun markdown (content &optional collapse-link) 23 "Translate CONTENT with 3bmd. If COLLAPSE-LINK is NIL then unconditionally render the full post, otherwise cut at the first ---." 24 (let ((md-content (with-output-to-string (os) 25 (3bmd:parse-string-and-print-to-stream content os)))) 26 (if collapse-link 27 (truncate-and-emit-read-more md-content collapse-link) 28 md-content))) 29 30 (defun rfc-822-format (datetime &optional (tz *default-timezone*)) 31 "RFC 822/1123 date formatter for RSS items" 32 (format-timestring nil datetime 33 :format +rfc-1123-format+ 34 :timezone tz)) 35 36 (defun short-date-format (datetime &optional (tz *default-timezone*)) 37 "Short-datetime formatter (see +short-date-format+)" 38 (format-timestring nil datetime 39 :format +short-date-format+ 40 :timezone tz)) 41 42 (defun long-date-format (datetime &optional (tz *default-timezone*)) 43 "Long-datetime formatter (see +long-date-format+)" 44 (format-timestring nil datetime 45 :format +long-date-format+ 46 :timezone tz)) 47 48 (defun year (datetime &optional (tz *default-timezone*)) 49 (format-timestring nil datetime :format '((:year 4)) :timezone tz)) 50 51 (defun month (datetime &optional (tz *default-timezone*)) 52 (format-timestring nil datetime :format '((:month 2)) :timezone tz)) 53 54 (defun make-content-formatter () 55 "Return the default content formatter (parses Markdown)" 56 #'markdown) 57 58 ;;; Djula formatting elements (tags and filters) 59 60 (defun %resolve (x) 61 (etypecase x 62 (string x) 63 (number x) 64 (symbol (djula::resolve-variable-phrase (list x))))) 65 66 (def-tag-compiler :page-tree (path pages &optional (root-uri "/")) 67 (lambda (stream) 68 (labels ((descend (parent-path child-path pages) 69 (format stream "<ul class=\"page-list\">~%") 70 (loop for page in (getf pages :children) 71 do (let* ((next-name (car child-path)) 72 (descendents (cdr child-path)) 73 (page-name (getf page :name)) 74 (page-path (append parent-path (list page-name))) 75 (page-path-str (str:join "/" page-path))) 76 (format stream "<li><a href=\"~apage/~a\">~a</a>~%" (%resolve root-uri) page-path-str (getf page :title)) 77 (if (and (string= page-name next-name) descendents) 78 (descend page-path descendents page)) 79 (format stream "</li>~%"))) 80 (format stream "</ul>~%"))) 81 (descend nil (%resolve path) (%resolve pages))))) 82 83 (def-tag-compiler :nav-calendar (archive-date-list &optional (root-uri "/")) 84 (lambda (stream) 85 (let ((arc (copy-list (%resolve archive-date-list)))) 86 (loop while arc do 87 (format stream "<table class=\"calendar\"><tr><th colspan=\"4\">~a</th></tr>~%" (caar arc)) 88 (let ((month-entries '()) 89 (month-names '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))) 90 (loop for cal-month downfrom 12 to 1 do 91 (if (and arc (= cal-month (cdar arc))) 92 (progn 93 (push (format nil "~d/~2,'0d/index.html" (caar arc) (cdar arc)) month-entries) 94 (pop arc)) 95 (push nil month-entries))) 96 (loop for row from 0 to 2 do 97 (format stream "<tr>~%") 98 (loop for cal-month from (* row 4) to (+ (* row 4) 3) do 99 (format stream "<td>") 100 (if (nth cal-month month-entries) 101 (format stream "<a href=\"~a~a\">~a</a>" 102 (%resolve root-uri) 103 (nth cal-month month-entries) 104 (nth cal-month month-names)) 105 (format stream "~A" (nth cal-month month-names))) 106 (format stream "</td>~%")) 107 (format stream "</tr>~%"))) 108 (format stream "</table>~%"))))) 109 110 (def-filter :markdown (content &optional collapse-link) 111 (markdown content (when collapse-link (djula::resolve-variable-phrase (djula::parse-variable-phrase collapse-link))))) 112 113 (def-filter :read-more (content collapse-link) 114 (truncate-and-emit-read-more content (djula::resolve-variable-phrase (djula::parse-variable-phrase collapse-link)))) 115 116 (def-filter :strip-html (content) 117 (format nil "~{~A~}" 118 (mapcar 119 (lambda (s) 120 (let ((chunks (split ">" s))) 121 (or (second chunks) (first chunks)))) 122 (split "<" content))))