#lang pollen/mode racket/base ; 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 pollen/decode pollen/private/version racket/string racket/function racket/list txexpr openssl/sha1 "dust.rkt") (provide html$-page-head html$-page-body-open html$-article-open html$-article-close html$-article-listing-short html$-page-body-close html$-note-title html$-note-contents html$-note-listing-full html$-note-in-article html$-notes-section html$-paginate-navlinks) (define (html$-page-head [title #f]) ◊string-append{ ◊if[title title ""] }) (define (html$-page-body-open [class ""]) (define body-class (if (non-empty-string? class) (format " class=\"~a\"" class) "")) ◊string-append{

The Local Yarn

}) (define (html$-article-open pagenode title? title-tx published) (cond [title? ◊string-append{
◊(->html `(h1 [[class "entry-title"]] ,@(get-elements title-tx)))

}] [else ◊string-append{

}])) (define (html$-article-close footertext) (cond [(non-empty-string? footertext) ◊string-append{
(◊|footertext|)
}] [else "
"])) (define (html$-article-listing-short pagenode pubdate title) ◊string-append{
  • ◊(ymd->english pubdate)
    ◊|title|
  • }) (define (html$-page-body-close) ◊string-append{
    By Joel Dueck
    }) ;; Notes ;; (define (html$-note-title pagenode parent-title) (format "Re: ~a" pagenode parent-title)) (define (html$-note-contents disposition-mark elems) (define disposition (cond [(non-empty-string? disposition-mark) `(span [[class "disposition-mark"]] ,disposition-mark)] [else ""])) (define body-elems (cond [(and (block-txexpr? (car elems)) (non-empty-string? disposition-mark)) (define-values (first-tag first-attrs first-elems) (txexpr->values (car elems))) (cons (txexpr first-tag first-attrs (cons disposition first-elems)) (cdr elems))] [else (cons disposition elems)])) (string-append* (map ->html body-elems))) (define (html$-note-listing-full pagenode note-id title-html-flow date contents [author default-authorname] [author-url ""]) (define author-part (cond [(non-empty-string? author-url) ◊string-append{
    ◊|author|
    }] [else ◊string-append{
    ◊|author|
    }])) (define maybe-author-class (cond [(string=? author default-authorname) "by-proprietor"] [else ""])) ◊string-append{

    ◊|title-html-flow|

    ◊|contents|
    ◊author-part
    }) (define (html$-note-in-article id date contents author author-url) (define maybe-author-class? (cond [(or (string=? author default-authorname) (string=? author "")) "by-proprietor"] [else ""])) (define author-part (cond [(non-empty-string? author-url) ◊string-append{◊|author|}] [else ◊string-append{◊|author|}])) ◊string-append{

    ◊contents
    —◊author-part
    }) (define (html$-notes-section note-htmls) ◊string-append{

    Further Notes

    ◊(apply string-append note-htmls)
    }) ;; (private) Returns HTML for a list-item link to a particular page in a set of numbered pages (define (html$-paginate-link basename pagenum [linktext (number->string pagenum)] [class ""]) (define cstr (if (non-empty-string? class) (format " class=\"~a\"" class) "")) (format "~a" cstr basename pagenum linktext)) ;; Returns HTML for a series of list items with links to numbered pages (define (html$-paginate-navlinks pagenum pagecount basename) (define slots 9) (define on-first-group? (<= pagenum (- slots 4))) (define on-last-group? (>= pagenum (- pagecount slots -4))) (define only-one-group? (<= pagecount slots)) (define group-start (- pagenum (quotient (- slots 4) 2))) ; not always used! (define page-func (curry html$-paginate-link basename)) (define page-group-syms (cond [only-one-group? `(,@(range 1 (+ 1 pagecount)))] [on-first-group? `(,@(range 1 (min (+ 1 pagecount) (- slots 1))) "..." ,pagecount)] [on-last-group? `(1 "..." ,@(range (- pagecount slots -3) (+ pagecount 1)))] [else `(1 "..." ,@(range group-start (min (+ 1 pagecount) (+ group-start (- slots 4)))) "..." ,pagecount)])) (define page-group (for/list ([psym (in-list page-group-syms)]) (cond [(and (number? psym) (equal? psym pagenum)) (format "
  • ~a
  • " psym)] [(number? psym) (page-func psym)] [else "
  • "]))) (define prev-link (if (eq? 1 pagenum) "
  • ←Newer
  • " (page-func (- pagenum 1) "← Newer" "nav-text"))) (define next-link (if (eq? pagecount pagenum) "
  • Older→
  • " (page-func (+ pagenum 1) "Older →" "nav-text"))) (string-join `(,prev-link ,@page-group ,next-link)))