◊(Local Yarn Code "Check-in [c120ca37]")

Login
About History Code Code Docs Road Map Issues
Overview
Comment:Add ability to render basic pages. Closes [63a9b7141f]
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: c120ca372382d89629e51a66f61f302f802d696b0a105b14101f17ba6353abe3
User & Date: joel on 2018-08-08 21:49:22
Other Links: manifest | tags
Context
2018-08-08
22:24
Update normalize.css to v8.0.0 and add license/copyright to NOTICE.txt check-in: 3529ca01 user: joel tags: trunk
21:49
Add ability to render basic pages. Closes [63a9b7141f] check-in: c120ca37 user: joel tags: trunk
21:47
Additions to site CSS check-in: 8f75998a user: joel tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Added dates.rkt version [9a276406]. 



































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
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 version [08e62a8c].































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
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 version [ebae6f02].


































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
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 <br> 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 version [45af1f57].










































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
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])
  ◊@{<head>
     <title>The Local Yarn◊when/splice[title]{: ◊title}</title>
     <meta charset="utf-8" />
     <meta name="viewport" content="width=device-width, initial-scale=1">
     <link rel="stylesheet" type="text/css" href="/web-extra/martin.css">
     </head>})

(define (ht-page-top)
  ◊@{<body><main>
     <a href="/"><header>
     <img src="/web-extra/logo.png" height="103" width="129" class="logo">
     <h1>The Local Yarn</h1>
     </header></a>})

(define (ht-article-header)
  (define title (select-from-metas 'title (current-metas)))
  (define published (select-from-metas 'published (current-metas)))
    (cond
      [title
       ◊@{<article class="with-title hentry">
          <h1 class="entry-title">◊|title|</h1>
          <p class="time"><a href="#" class="rel-bookmark">
          <time datetime="◊published" class="published">◊ymd->english[published]</time>
          </a></p>
          <section class="entry-content">}]
      [else
       ◊@{<article class="no-title hentry">
          <h1><a href="#" class="rel-bookmark">
          <time datetime="◊published" class="entry-title">◊ymd->english[published]</time>
          </a></h1>
          <section class="entry-content">}]))

(define (ht-article-footer)
  ◊@{</section>
     <footer class="article-info"><span class="x">(</span>Part of ‘Talking About Poetry’. Once I threw a mudball at a birdhouse. I’m not exactly proud of it, though.<span class="x">)</span></footer>
     </article>})
  
(define (ht-page-bottom)
  ◊@{<footer>By Joel Dueck</footer>
     </main></body>})








Added template.html.p version [be27a755].


















1
2
3
4
5
6
7
8
9
10
11
12
13
14

+
+
+
+
+
+
+
+
+
+
+
+
+
+

<!DOCTYPE html>
<html>
◊ht-head[(select-from-metas 'title here)]

◊ht-page-top[]

◊ht-article-header[]
◊(->html (cdr doc))
◊ht-article-footer[]

◊ht-page-bottom[]

</html>












This page was generated in about
0.018s by
Fossil 2.19 [318ab802db] 2022-05-27 02:05:21