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