@@ -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))