@@ -24,52 +24,57 @@ ;; Provides functions for displaying content in HTML templates. (require pollen/core pollen/template pollen/decode 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$-notes-section + html$-paginate-navlinks) (define (html$-page-head [title #f]) ◊string-append{ ◊if[title title ""] }) -(define (html$-page-body-open) - ◊string-append{
+(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 title? title-tx published) +(define (html$-article-open pagenode title? title-tx published) (cond [title? ◊string-append{"])) - + +(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 author pagenode parent-title) - (define author-part - (cond [(and (non-empty-string? author) - (not (string-ci=? author default-authorname))) - (format "A note from ~a, " author)] - [else ""])) - (define article-part - (format "Re: ~a" - pagenode - parent-title)) - (string-append author-part article-part)) +(define (html$-note-title pagenode parent-title) + (format "Re: ~a" + pagenode + parent-title)) (define (html$-note-contents disposition-mark elems) - (define-values (first-tag first-attrs first-elems) (txexpr->values (car elems))) (define disposition (cond [(non-empty-string? disposition-mark) `(span [[class "disposition-mark"]] ,disposition-mark)] [else ""])) (define body-elems (cond - [(block-txexpr? (car elems)) + [(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))) @@ -120,18 +125,18 @@ }] [else ◊string-append{
    —◊|author|
    }])) - (define maybe-author-class? + (define maybe-author-class (cond [(string=? author default-authorname) "by-proprietor"] [else ""])) ◊string-append{ -
    -

    ◊|title-html-flow|

    -

    +

    +

    ◊|title-html-flow|

    +

    ◊|contents|
    ◊author-part @@ -157,5 +162,53 @@ (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)))