Index: code-docs/pollen.scrbl ================================================================== --- code-docs/pollen.scrbl +++ code-docs/pollen.scrbl @@ -34,19 +34,24 @@ These are the tags that can be used in any of @italic{The Local Yarn}’s Pollen documents (articles, etc). @defproc[(title [element xexpr?] ...) txexpr?]{ -@margin-note{The @code{title} function is not actually defined in @filepath{pollen.rkt} or anywhere -else. In Pollen, any undefined function @tt{title} defaults to @racket[(default-tag-function -title)], which is what I want. It is documented here because its presence or absence has -side-effects on the display of the article.} - Supplies a title for the document. You can use any otherwise-valid markup within the title tag. Titles are optional; if you don’t specify a title, the article will appear without one. This is a feature! +} + +@deftogether[(@defproc[(excerpt [elements xexpr?] ...) txexpr?] + @defproc[(excerpt* [elements xexpr?] ...) txexpr?])]{ + +Specify an excerpt to be used when the article or note included in an excerpt-style listing (such as +the blog). The contents of @racket[excerpt] will be extracted out of the article and note and only +appear in listings; if @racket[excerpt*] is used, its contents will be left in place in the +article/note and @emph{reused} as the excerpt in listings. + } @defproc[(p [element xexpr?] ...) txexpr?]{ Wrap text in a paragraph. You almost never need to use this tag explicitly; Index: crystalize.rkt ================================================================== --- crystalize.rkt +++ crystalize.rkt @@ -8,45 +8,68 @@ threading racket/match racket/string txexpr pollen/template + pollen/decode (except-in pollen/core select) ; avoid conflict with deta ) (require "dust.rkt" "cache.rkt" "snippets-html.rkt") (provide parse-and-cache-article! cache-series!) + +(define current-title (make-parameter #f)) +(define current-excerpt (make-parameter #f)) +(define current-notes (make-parameter '())) +(define current-disposition (make-parameter "")) +(define current-disp-id (make-parameter "")) + +(define (filter-special-tags tx) + (match (get-tag tx) + ['title (current-title tx) ""] + ['excerpt (current-excerpt tx) ""] + ['excerpt* (current-excerpt tx) `(@ ,@(get-elements tx))] ; splice contents back in + ['note + (define note-id (build-note-id tx)) + (cond [(attrs-have-key? tx 'disposition) + (current-disp-id note-id) + (current-disposition (attr-ref tx 'disposition))]) + (current-notes (cons (attr-set tx 'note-id note-id) (current-notes))) ""] + [_ tx])) ;; Save an article and its notes (if any) to the database, and return ;; (values plain-title [rendered HTML of the complete article]) (define (parse-and-cache-article! pagenode doc) - (define-values (doc-no-title maybe-title) - (splitf-txexpr doc (make-tag-predicate 'title))) - (define-values (body-txpr note-txprs) - (splitf-txexpr doc-no-title (make-tag-predicate 'note))) - (define-values (disposition disp-note-id) - (notes->last-disposition-values note-txprs)) - + (define body-txpr (decode doc #:txexpr-proc filter-special-tags)) + (current-notes (reverse (current-notes))) (let* ([pubdate (select-from-metas 'published (current-metas))] [doc-html (->html body-txpr #:splice? #t)] - [title-specified? (not (equal? '() maybe-title))] - [title-val (if (not (null? maybe-title)) (car maybe-title) (check-for-poem-title doc))] - [title-tx (make-article-title pagenode title-val body-txpr disposition disp-note-id)] + [title-specified? (if (current-title) #t #f)] + [title-val (or (current-title) (check-for-poem-title doc))] + [title-tx (make-article-title pagenode + title-val + body-txpr + (current-disposition) + (current-disp-id))] [title-html (->html title-tx #:splice? #t)] [title-plain (tx-strs title-tx)] [header (html$-article-open pagenode title-specified? title-tx pubdate)] [series-node (metas-series-pagenode)] [footertext (make-article-footertext pagenode series-node - disposition - disp-note-id - (length note-txprs))] + (current-disposition) + (current-disp-id) + (length (current-notes)))] [footer (html$-article-close footertext)] [listing-short (html$-article-listing-short pagenode pubdate title-html)] - [notes-section-html (cache-notes! pagenode title-plain note-txprs)]) + [listing-full (string-append header doc-html footer)] + [listing-excerpt (match (current-excerpt) + [#f listing-full] + [(var e) (string-append header (html$-article-excerpt pagenode e) footer)])] + [notes-section-html (cache-notes! pagenode title-plain (current-notes))]) (cache-index-entries! pagenode doc) ; note original doc is used here (delete-article! pagenode) (insert-one! (cache-conn) (make-cache:article #:page pagenode @@ -57,16 +80,16 @@ #:updated (maybe-meta 'updated) #:author (maybe-meta 'author default-authorname) #:conceal (maybe-meta 'conceal) #:series-page series-node #:noun-singular (maybe-meta 'noun (series-metas-noun)) - #:note-count (length note-txprs) + #:note-count (length (current-notes)) #:content-html doc-html - #:disposition disposition - #:disp-html-anchor disp-note-id - #:listing-full-html (string-append header doc-html footer) - #:listing-excerpt-html "" + #:disposition (current-disposition) + #:disp-html-anchor (current-disp-id) + #:listing-full-html listing-full + #:listing-excerpt-html listing-excerpt #:listing-short-html listing-short)) (values title-plain (string-append header doc-html notes-section-html footer)))) (define (check-for-poem-title doc-txpr) (match (car (get-elements doc-txpr)) @@ -159,11 +182,18 @@ (let* ([note-id (build-note-id note-tx)] [title-tx (make-note-title pagenode parent-title-plain)] [title-html (->html title-tx #:splice? #t)] [author (maybe-attr 'author attrs default-authorname)] [author-url (maybe-attr 'author-url attrs)] - [content-html (html$-note-contents disp-mark disp-verb elems)]) + [content-html (html$-note-contents disp-mark disp-verb elems)] + [listing-full (html$-note-listing-full pagenode + note-id + title-html + note-date + content-html + author + author-url)]) (insert-one! (cache-conn) (make-cache:note #:page pagenode #:html-anchor note-id #:title-html-flow title-html @@ -173,18 +203,12 @@ #:author-url author-url #:disposition disposition-attr #:series-page (metas-series-pagenode) #:conceal (or (maybe-attr 'conceal attrs #f) (maybe-meta 'conceal)) #:content-html content-html - #:listing-full-html (html$-note-listing-full pagenode - note-id - title-html - note-date - content-html - author - author-url) - #:listing-excerpt-html "" + #:listing-full-html listing-full + #:listing-excerpt-html listing-full #:listing-short-html "")) (html$-note-in-article note-id note-date content-html author author-url))) (define (make-note-title pagenode parent-title-plain) `(note-title "Re: " (a [[class "cross-reference"] Index: pollen.rkt ================================================================== --- pollen.rkt +++ pollen.rkt @@ -73,10 +73,13 @@ [(POLY-TARGET) (apply POLY-FUNC args)] ... [else (apply DEFAULT-FUNC args)])))])) ;; Define all the tag functions (poly-branch-tag root) +(poly-branch-tag title) +(poly-branch-tag excerpt) +(poly-branch-tag excerpt*) (poly-branch-tag p) (poly-branch-tag i) (poly-branch-tag em) (poly-branch-tag b) Index: snippets-html.rkt ================================================================== --- snippets-html.rkt +++ snippets-html.rkt @@ -2,28 +2,27 @@ ; SPDX-License-Identifier: BlueOak-1.0.0 ; This file is licensed under the Blue Oak Model License 1.0.0. ;; Provides functions for displaying content in HTML templates. -(require pollen/core - pollen/template +(require pollen/template pollen/decode pollen/private/version racket/string racket/function racket/list txexpr - openssl/sha1 "cache.rkt" "dust.rkt") (provide html$-page-head html$-page-body-open html$-series-list html$-article-open html$-article-close html$-article-listing-short + html$-article-excerpt html$-page-footer html$-page-body-close html$-note-contents html$-note-listing-full html$-note-in-article @@ -74,10 +73,16 @@ ◊string-append{

◊|title|

}) + +(define (html$-article-excerpt pagenode excerpt-tx) + ◊string-append{ + ◊(->html excerpt-tx #:splice? #t) +

Read more…

+}) (define (html$-page-footer) ◊string-append{