ADDED dates.rkt Index: dates.rkt ================================================================== --- dates.rkt +++ dates.rkt @@ -0,0 +1,33 @@ +#lang racket/base + +;; Copyright (c) 2018 Joel Dueck. +;; +;; Licensed under the Apache License, Version 2.0 (the "License"); +;; you may not use this file except in compliance with the License. +;; A copy of the License is included with this source code, in the +;; file "LICENSE.txt". +;; You may also obtain a copy of the License at +;; +;; http://www.apache.org/licenses/LICENSE-2.0 +;; +;; Unless required by applicable law or agreed to in writing, software +;; distributed under the License is distributed on an "AS IS" BASIS, +;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;; See the License for the specific language governing permissions and +;; limitations under the License. +;; +;; Author contact information: +;; joel@jdueck.net +;; https://joeldueck.com +;; ------------------------------------------------------------------------- + +;; Convenience functions for date strings + +(require gregor + racket/string) + +(provide (all-defined-out)) + +;; Ignores everything after the first space +(define (ymd->english ymd-string) + (~t (iso8601->date (car (string-split ymd-string))) "MMMM d, yyyy")) ADDED pollen.rkt Index: pollen.rkt ================================================================== --- pollen.rkt +++ pollen.rkt @@ -0,0 +1,123 @@ +#lang racket/base + +;; Copyright (c) 2018 Joel Dueck. +;; +;; Licensed under the Apache License, Version 2.0 (the "License"); +;; you may not use this file except in compliance with the License. +;; A copy of the License is included with this source code, in the +;; file "LICENSE.txt". +;; You may also obtain a copy of the License at +;; +;; http://www.apache.org/licenses/LICENSE-2.0 +;; +;; Unless required by applicable law or agreed to in writing, software +;; distributed under the License is distributed on an "AS IS" BASIS, +;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;; See the License for the specific language governing permissions and +;; limitations under the License. +;; +;; Author contact information: +;; joel@jdueck.net +;; https://joeldueck.com +;; ------------------------------------------------------------------------- + +;; Functions for tags and template content used in all Pollen source files and templates. + +(require (for-syntax racket/base + racket/syntax + syntax/parse + pollen/setup)) + +(require pollen/tag + pollen/setup + racket/function + "tags-html.rkt" + "template-html.rkt") + +(provide (all-defined-out) + (all-from-out "template-html.rkt")) + +(module setup racket/base + (require syntax/modresolve) + (provide (all-defined-out)) + (define poly-targets '(html)) + (define cache-watchlist + (map resolve-module-path '("tags-html.rkt" + "template-html.rkt" + "dates.rkt")))) + +;; Macro for defining tag functions that automatically branch based on the +;; current output format and the list of poly-targets in the setup module. +;; +(define-syntax (poly-branch-tag stx) + (syntax-parse stx + [(_ TAG:id) + (with-syntax ([((POLY-TARGET POLY-FUNC) ...) + (for/list ([target (in-list (setup:poly-targets))]) + (list target (format-id stx "~a-~a" target #'TAG)))] + [DEFAULT-FUNC (format-id stx "html-~a" #'TAG)]) + #'(define-tag-function (TAG attributes elems) + (define args (cons attributes elems)) + (case (current-poly-target) + [(POLY-TARGET) (apply POLY-FUNC args)] ... + [else (apply DEFAULT-FUNC args)])))])) + +;; Like above, but uses define instead of define-tag-function, so arguments +;; are given ‘straight’ rather than being parsed out as attributes. +;; +(define-syntax (poly-branch-func stx) + (syntax-parse stx + [(_ TAG:id) + (with-syntax ([((POLY-TARGET POLY-FUNC) ...) + (for/list ([target (in-list (setup:poly-targets))]) + (list target (format-id stx "~a-~a" target #'TAG)))] + [DEFAULT-FUNC (format-id stx "html-~a" #'TAG)]) + #'(define (TAG . args) + (case (current-poly-target) + [(POLY-TARGET) (apply POLY-FUNC args)] ... + [else (apply DEFAULT-FUNC args)])))])) + +;; Define all the tag functions +(poly-branch-tag root) + +(poly-branch-tag p) +(poly-branch-tag i) +(poly-branch-tag em) +(poly-branch-tag b) +(poly-branch-tag strong) +(poly-branch-tag strike) +;(poly-branch-tag color) +(poly-branch-tag ol) +(poly-branch-tag ul) +(poly-branch-tag item) +(poly-branch-tag sup) +(poly-branch-tag blockquote) +(poly-branch-tag newthought) +(poly-branch-tag smallcaps) +(poly-branch-tag center) +(poly-branch-tag section) +(poly-branch-tag subsection) +(poly-branch-tag code) +(poly-branch-tag blockcode) +(poly-branch-tag verse) ; [#:title ""] [#:italic "no"] + +(poly-branch-func link) +(poly-branch-func url) +(poly-branch-func fn) +(poly-branch-func fndef) + +;; Not yet implemented +; (poly-branch-tag table) ; #:columns "" +; (poly-branch-tag inline-math) +; (poly-branch-tag margin-note) +; (poly-branch-tag noun) +; (poly-branch-func index-entry entry) +; (poly-branch-tag figure) ; #:src "img--sans-path.png" [#:has-print-version? "yes"] +; (poly-branch-tag spot-illustration) ; #:src "img--sans-path.png" [#:has-print-version? "yes"] + +;; My pet shortcut for for/splice. Greatly cuts down on parentheses for the +;; most common use case (looping through a single list). +(define-syntax (for/s stx) + (syntax-case stx () + [(_ thing listofthings result-expr ...) + #'(for/splice ([thing (in-list listofthings)]) result-expr ...)])) ADDED tags-html.rkt Index: tags-html.rkt ================================================================== --- tags-html.rkt +++ tags-html.rkt @@ -0,0 +1,190 @@ +#lang racket/base + +;; Copyright (c) 2018 Joel Dueck. +;; +;; Licensed under the Apache License, Version 2.0 (the "License"); +;; you may not use this file except in compliance with the License. +;; A copy of the License is included with this source code, in the +;; file "LICENSE.txt". +;; You may also obtain a copy of the License at +;; +;; http://www.apache.org/licenses/LICENSE-2.0 +;; +;; Unless required by applicable law or agreed to in writing, software +;; distributed under the License is distributed on an "AS IS" BASIS, +;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;; See the License for the specific language governing permissions and +;; limitations under the License. +;; +;; Author contact information: +;; joel@jdueck.net +;; https://joeldueck.com +;; ------------------------------------------------------------------------- + +;; Tag functions used by pollen.rkt when HTML is the output format. + +(require (for-syntax racket/base racket/syntax)) +(require racket/list + racket/function + pollen/decode + pollen/tag + txexpr) + +(provide html-fn + html-fndef) + +;; Customized paragraph decoder replaces single newlines within paragraphs +;; with single spaces instead of
tags. Allows for “semantic line wrapping”. +(define (decode-hardwrapped-paragraphs xs) + (define (no-linebreaks xs) + (decode-linebreaks xs " ")) + (decode-paragraphs xs #:linebreak-proc no-linebreaks)) + +;; A shortcut macro: lets me define a whole lot of tag functions of the form: +;; (define html-p (default-tag-function 'p) +(define-syntax (provide/define-html-default-tags stx) + (syntax-case stx () + [(_ TAG ...) + (let ([tags (syntax->list #'(TAG ...))]) + (with-syntax ([((HTML-TAG-FUNC HTML-TAG) ...) + (for/list ([htag (in-list tags)]) + (list (format-id stx "html-~a" (syntax-e htag)) (syntax-e htag)))]) + #'(begin + (provide HTML-TAG-FUNC ...) + (define HTML-TAG-FUNC (default-tag-function 'HTML-TAG)) ...)))])) + +;; Here we go: +(provide/define-html-default-tags p + b + strong + i + em + strike + ol + ul + sup + blockquote + code) + +(provide html-root + html-item + html-section + html-subsection + html-newthought + html-smallcaps + html-center + html-blockcode + html-verse + html-link + html-url + html-fn + html-fndef) + +(define html-item (default-tag-function 'li)) +(define html-section (default-tag-function 'h2)) +(define html-subsection (default-tag-function 'h3)) +(define html-newthought (default-tag-function 'span #:class "newthought")) +(define html-smallcaps (default-tag-function 'span #:class "smallcaps")) +(define html-center (default-tag-function 'div #:style "text-align: center")) + +(define-tag-function (html-root attrs elements) + (define first-pass + (decode-elements elements + #:txexpr-elements-proc decode-hardwrapped-paragraphs + #:exclude-tags '(script style figure table pre))) + (define second-pass + (decode-elements first-pass + #:block-txexpr-proc detect-newthoughts + #:inline-txexpr-proc decode-link-urls + #:string-proc (compose1 smart-quotes smart-dashes) + #:exclude-tags '(script style pre code))) + `(body ,@second-pass ,(html-footnote-block))) + +(define-tag-function (html-blockcode attrs elems) + (define file (or (assoc 'filename attrs) "")) + (define codeblock `(pre [[class "code"]] (code ,@elems))) + (cond [(string>? file "") `(@ (div [[class "listing-filename"]] 128196 " " ,file) ,codeblock)] + [else codeblock])) + +(define-tag-function (html-verse attrs elems) + (let* ([title (or (assoc 'title attrs) "")] + [italic? (assoc 'italic attrs)] + [pre-attrs (cond [italic? '([class "verse"] [style "font-style: italic"])] + [else '([class "verse"])])] + [pre-title (cond [(string>? title "") '(p [[class "verse-heading"]] ,title)] + [else ""])]) + `(div [[class "poem"]] (pre ,pre-attrs ,pre-title ,@elems)))) + +;; There is no way in vanilla CSS to create a selector for “p tags that contain +;; a span of class ‘newthought’”. So we can handle it at the Pollen processing level. +(define (detect-newthoughts block-xpr) + (define (is-newthought? tx) ; Helper function + (and (txexpr? tx) + (eq? 'span (get-tag tx)) + (attrs-have-key? tx 'class) + (string=? "newthought" (attr-ref tx 'class)))) + (if (and (eq? (get-tag block-xpr) 'p) + (is-newthought? (first (get-elements block-xpr)))) + (attr-set block-xpr 'class "pause-before") + block-xpr)) + +;; Links +;; +;; Private use: +(define link-urls (make-hash)) + +;; Provided tag functions: +(define (html-link . args) + `(link& [[ref ,(format "~a" (first args))]] ,@(rest args))) + +(define (html-url ref url) + (hash-set! link-urls (format "~a" ref) url)) + +;; Private use (by html-root): +(define (decode-link-urls tx) + (cond [(eq? (get-tag tx) 'link&) + (let* ([url-ref (attr-ref tx 'ref)] + [url (or (hash-ref link-urls url-ref #f) + (format "Missing reference: ~a" url-ref))]) + `(a [[href ,url]] ,@(get-elements tx)))] + [else tx])) + +;; Footnotes +;; +;; Private use: +(define fn-names null) +(define fn-definitions (make-hash)) +(define (fn-id x) (string-append x "_fn")) +(define (fndef-id x) (string-append x "_fndef")) + +;; Provided footnote tag functions: +(define (html-fn . args) + (define name (format "~a" (first args))) + (set! fn-names (cons name fn-names)) + (let* ([def-anchorlink (string-append "#" (fndef-id name))] + [nth-ref (number->string (count (curry string=? name) fn-names))] + [ref-id (string-append (fn-id name) nth-ref)] + [fn-number (+ 1 (index-of (remove-duplicates (reverse fn-names)) name))] + [ref-text (format "(~a)" fn-number)]) + (cond [(empty? (rest args)) `(sup (a [[href ,def-anchorlink] [id ,ref-id]] ,ref-text))] + [else `(span [[class "links-footnote"] [id ,ref-id]] + ,@(rest args) + (sup (a [[href ,def-anchorlink]] ,ref-text)))]))) + +(define (html-fndef . elems) + (hash-set! fn-definitions (format "~a" (first elems)) (rest elems))) + +;; Private use (by html-root) +(define (html-footnote-block) + (define note-items + (for/list ([fn-name (in-list (remove-duplicates (reverse fn-names)))]) + (let* ([definition-text (or (hash-ref fn-definitions fn-name #f) + '((i "Missing footnote definition!")))] + [backref-count (count (curry string=? fn-name) fn-names)] + [backrefs (for/list ([fnref-num (in-range backref-count)]) + `(a [[href ,(string-append "#" + (fn-id fn-name) + (format "~a" (+ 1 fnref-num)))]] "↩"))]) + `(li [[id ,(fndef-id fn-name)]] ,@definition-text ,@backrefs)))) + (cond [(null? note-items) ""] + [else `(section ((class "footnotes")) (hr) (ol ,@note-items))])) ADDED template-html.rkt Index: template-html.rkt ================================================================== --- template-html.rkt +++ template-html.rkt @@ -0,0 +1,70 @@ +#lang pollen/mode racket/base + +;; Copyright (c) 2018 Joel Dueck. +;; +;; Licensed under the Apache License, Version 2.0 (the "License"); +;; you may not use this file except in compliance with the License. +;; A copy of the License is included with this source code, in the +;; file "LICENSE.txt". +;; You may also obtain a copy of the License at +;; +;; http://www.apache.org/licenses/LICENSE-2.0 +;; +;; Unless required by applicable law or agreed to in writing, software +;; distributed under the License is distributed on an "AS IS" BASIS, +;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;; See the License for the specific language governing permissions and +;; limitations under the License. +;; +;; Author contact information: +;; joel@jdueck.net +;; https://joeldueck.com +;; ------------------------------------------------------------------------- + +;; Provides functions for displaying content in HTML templates. +(require pollen/core + "dates.rkt") + +(provide (all-defined-out)) + +(define (ht-head [title #f]) + ◊@{ + The Local Yarn◊when/splice[title]{: ◊title} + + + + }) + +(define (ht-page-top) + ◊@{
+
+ +

The Local Yarn

+
}) + +(define (ht-article-header) + (define title (select-from-metas 'title (current-metas))) + (define published (select-from-metas 'published (current-metas))) + (cond + [title + ◊@{
+

◊|title|

+

+ +

+
}] + [else + ◊@{
+

+ +

+
}])) + +(define (ht-article-footer) + ◊@{
+
(Part of ‘Talking About Poetry’. Once I threw a mudball at a birdhouse. I’m not exactly proud of it, though.)
+
}) + +(define (ht-page-bottom) + ◊@{ +
}) ADDED template.html.p Index: template.html.p ================================================================== --- template.html.p +++ template.html.p @@ -0,0 +1,14 @@ + + +◊ht-head[(select-from-metas 'title here)] + +◊ht-page-top[] + +◊ht-article-header[] +◊(->html (cdr doc)) +◊ht-article-footer[] + +◊ht-page-bottom[] + + +