Index: crystalize.rkt ================================================================== --- crystalize.rkt +++ crystalize.rkt @@ -95,10 +95,11 @@ (define table_articles (make-table-schema "articles" table_articles-fields)) (define table_notes (make-table-schema "notes" table_notes-fields #:primary-key-cols '(pagenode note_id))) (define table_series (make-table-schema "series" table_series-fields)) +;; Split all ◊note tags out of the Pollen doc (define (doc->body/notes doc) (define (is-note? tx) (and (txexpr? tx) (equal? 'note (get-tag tx)))) (splitf-txexpr doc is-note?)) ;; ~~~ Provided functions: Initializing; Saving posts and notes @@ -119,12 +120,15 @@ (define-values (disposition disp-note-id) (notes->last-disposition-values note-txprs)) (define-values (title-plain title-html-flow) (make-article-titles (maybe-meta 'title (default-title pubdate)) disposition)) + (define series-node (maybe-meta 'series)) (define header (html$-article-open title-html-flow pubdate)) - (define footer (html$-article-close)) + + (define footertext (make-article-footertext pagenode series-node disposition disp-note-id (length note-txprs))) + (define footer (html$-article-close footertext)) (define notes-section-html (crystalize-notes! pagenode title-plain note-txprs)) ;; Values must come in the order defined in table_article_fields (define article-record @@ -133,11 +137,11 @@ title-html-flow pubdate (maybe-meta 'updated) (maybe-meta 'author default-authorname) (maybe-meta 'conceal) - (maybe-meta 'series) + series-node (maybe-meta 'noun (series-noun)) (length note-txprs) doc-html disposition disp-note-id @@ -147,10 +151,14 @@ (apply query! (make-insert/replace-query 'articles table_articles-fields) article-record) ◊string-append{◊header ◊doc-html ◊notes-section-html ◊footer}) +;; ~~~ Article-related helper functions ~~~ +;; + +;; Given a disposition and title, return both a plain-text and HTML version of the title (define (make-article-titles title-val disposition) (define disposition-part (cond [(non-empty-string? disposition) (define-values (mark _) (disposition-values disposition)) (format "~a" mark)] @@ -158,20 +166,61 @@ (cond [(txexpr? title-val) (values (apply string-append (tx-strs title-val)) (string-append (->html title-val) disposition-part))] [else (values title-val (string-append title-val disposition-part))])) + +;; Convert a bunch of information about an article into some nice English and links. +(define (make-article-footertext pagenode series disposition disp-note-id note-count) + (define s-title (series-title)) + (define s-noun (series-noun)) + (define series-part + (cond [(non-empty-string? series-title) + (format "This is ~a, part of ‘~a’." + s-noun + series + s-title)] + [else ""])) + (define disp-part + (cond [(non-empty-string? disposition) + (define-values (mark verb) (disposition-values disposition)) + (format "Now considered ~a ~a." + pagenode + disp-note-id + mark + verb)] + [else ""])) + (define notes-part + (cond [(note-count . > . 1) + (format "There are ~a notes appended." + pagenode + note-count)] + [(and (note-count . > . 0) (string=? disposition "")) + (format "There is a note appended." + pagenode)] + [else ""])) + (format "~a ~a ~a" series-part disp-part notes-part)) + + +;; ~~~ Notes ~~~ + +;; Save a collection of ◊note tags to the DB, and return the HTML of the complete +;; “Further Notes” section at the end +;; (define (crystalize-notes! pagenode parent-title note-txprs) (define (crystalizer note-tx) (crystalize-note! note-tx (symbol->string pagenode) parent-title)) (cond [((length note-txprs) . > . 0) (define notes-html (map crystalizer note-txprs)) (html$-notes-section notes-html)] [else ""])) +;; Save an individual note to the DB and return the HTML of the complete note as +;; it should appear on an individual article page +;; (define (crystalize-note! note-tx pagenode parent-title-plain) (define-values (_ attrs elems) (txexpr->values note-tx)) (define disposition-attr (maybe-attr 'disposition attrs)) (define note-date (maybe-attr 'date attrs)) Index: dust.rkt ================================================================== --- dust.rkt +++ dust.rkt @@ -32,10 +32,11 @@ ;; Provides common helper functions used throughout the project (provide maybe-meta ; Select from (current-metas) or default value ("") if not available maybe-attr ; Return an attribute’s value or a default ("") if not available series-noun ; Retrieve noun-singular from current 'series meta, or "" + series-title ; Retrieve title of series in current 'series meta, or "" attr-present? ; Test if an attribute is present disposition-values ymd->english ymd->dateformat default-authorname @@ -57,10 +58,16 @@ (define series-pagenode (->pagenode (or (select-from-metas 'series (current-metas)) ""))) (case series-pagenode ['|| ""] ; no series specified [else (or (select-from-metas 'noun-singular series-pagenode) "")])) +(define (series-title) + (define series-pagenode (->pagenode (or (select-from-metas 'series (current-metas)) ""))) + (case series-pagenode + ['|| ""] ; no series specified + [else (or (select-from-metas 'title series-pagenode) "")])) + (define (attr-present? name attrs) (for/or ([attr-pair (in-list attrs)]) (equal? name (car attr-pair)))) (define (maybe-attr name attrs [missing ""]) @@ -98,12 +105,11 @@ (values (car splut) (string-join (cdr splut))))])) ;; The format of a note’s ID is “HTML-driven” (used as an anchor link) but is included ;; here since it also serves as a primary key in the DB. (define (build-note-id txpr) - (string-append "#" - (maybe-attr 'date (get-attrs txpr)) + (string-append (maybe-attr 'date (get-attrs txpr)) "_" (uri-encode (maybe-attr 'author (get-attrs txpr) default-authorname)))) ;; Extract the last disposition (if any), and the ID of the disposing note, out of a list of notes (define (notes->last-disposition-values txprs) Index: template-html.rkt ================================================================== --- template-html.rkt +++ template-html.rkt @@ -71,16 +71,15 @@

}])) -(define (html$-article-close) +(define (html$-article-close footertext) ◊string-append{
- + }) - (define (html$-page-body-close) ◊string-append{ }) ;; Notes @@ -136,11 +135,11 @@ }) (define (html$-note-in-article id date author author-url contents) ◊string-append{
-

+

◊contents
@@ -147,9 +146,9 @@ —◊|author|

}) (define (html$-notes-section note-htmls) - ◊string-append{
+ ◊string-append{

Further Notes

◊(apply string-append note-htmls)
})