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

Login
About History Code Code Docs Road Map Issues
Overview
Comment:Implement excerpts ([10e20e5ab65])
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: 8af3b9ce0c30051a50f2e1de9f9388296b7388ae311bb6635127ccab1c8870f0
User & Date: joel on 2020-02-29 16:12:23
Other Links: manifest | tags
References
2020-02-29
16:16 • Closed ticket [10e20e5a]: Implement excerpts plus 4 other changes artifact: debcb1da user: joel
Context
2020-02-29
16:35
Proper sticky footer check-in: cd7ac6e3 user: joel tags: trunk
16:12
Implement excerpts ([10e20e5ab65]) check-in: 8af3b9ce user: joel tags: trunk
15:51
Make relativize script play nice with tidy-introduced line breaks check-in: fcaf9eac user: joel tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified code-docs/pollen.scrbl from [885fb15f] to [0570e08d]. 

32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47










48
49
50
51
52
53
54

@section{Markup reference}

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!










}

@defproc[(p [element xexpr?] ...) txexpr?]{

Wrap text in a paragraph. You almost never need to use this tag explicitly; 
just separate paragraphs by an empty line.









<
<
<
<
<




>
>
>
>
>
>
>
>
>
>








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

@section{Markup reference}

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?]{






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; 
just separate paragraphs by an empty line.

Modified crystalize.rkt from [c9517191] to [ffde9e3c]. 

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
...
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
191
192

(require deta
         db/base
         threading
         racket/match
         racket/string
         txexpr
         pollen/template

         (except-in pollen/core select) ; avoid conflict with deta
         )

(require "dust.rkt" "cache.rkt" "snippets-html.rkt")

(provide parse-and-cache-article!
         cache-series!)




















;; 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))

  (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-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))]
         [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)])
    (cache-index-entries! pagenode doc) ; note original doc is used here
    (delete-article! pagenode)
    (insert-one! (cache-conn)
                 (make-cache:article
                  #:page pagenode
                  #:title-plain title-plain
                  #:title-html-flow title-html
................................................................................
                  #:title-specified? title-specified?
                  #:published pubdate
                  #: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)
                  #:content-html doc-html
                  #:disposition disposition
                  #:disp-html-anchor disp-note-id
                  #:listing-full-html (string-append header doc-html footer)
                  #:listing-excerpt-html ""
                  #: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))
    [(txexpr 'div
             (list (list 'class "poem"))
................................................................................
                           disposition-attr))
  (define-values (disp-mark disp-verb) (disposition-values disposition-attr))
  (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)])







    (insert-one! (cache-conn)
                 (make-cache:note
                  #:page pagenode
                  #:html-anchor note-id
                  #:title-html-flow title-html
                  #:title-plain (tx-strs title-tx)
                  #:published note-date
                  #:author author
                  #: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-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"]
                          [href ,(format "~a~a" web-root pagenode)]]
                         ,parent-title-plain)))








>







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>




|
|
|
|
|
|
|
|
|
|
|
<






|
|
|


>
>
>
>
|







 







|

|
|
|
|







 







|
>
>
>
>
>
>
>













|
<
<
<
<
<
<
|








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
...
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208






209
210
211
212
213
214
215
216

(require deta
         db/base
         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 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? (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
                                               (current-disposition)
                                               (current-disp-id)
                                               (length (current-notes)))]
         [footer (html$-article-close footertext)]
         [listing-short (html$-article-listing-short pagenode pubdate title-html)]
         [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
                  #:title-plain title-plain
                  #:title-html-flow title-html
................................................................................
                  #:title-specified? title-specified?
                  #:published pubdate
                  #: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 (current-notes))
                  #:content-html doc-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))
    [(txexpr 'div
             (list (list 'class "poem"))
................................................................................
                           disposition-attr))
  (define-values (disp-mark disp-verb) (disposition-values disposition-attr))
  (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)]
         [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
                  #:title-plain (tx-strs title-tx)
                  #:published note-date
                  #:author author
                  #: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 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"]
                          [href ,(format "~a~a" web-root pagenode)]]
                         ,parent-title-plain)))

Modified pollen.rkt from [19ce46ba] to [da1550cf]. 

71
72
73
74
75
76
77



78
79
80
81
82
83
84

       #'(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)








>
>
>








71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87

       #'(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 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)
(poly-branch-tag strong)
(poly-branch-tag strike)

Modified snippets-html.rkt from [e27d9d6e] to [224fe07f]. 

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
..
72
73
74
75
76
77
78






79
80
81
82
83
84
85

#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
         "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$-page-footer
         html$-page-body-close
         html$-note-contents
         html$-note-listing-full
         html$-note-in-article
         html$-notes-section
         html$-paginate-navlinks)
................................................................................

(define (html$-article-listing-short pagenode pubdate title)
  ◊string-append{
 <article class="short-listing"><a href="/◊(symbol->string pagenode)">
  <time datetime="◊pubdate" class="caps">◊(ymd->english pubdate)</time>
  <h3>◊|title|</h3>
 </a></article>})







(define (html$-page-footer)
  ◊string-append{
<footer id="main">
 <p class="title">The Local Yarn</p>
 <nav><a href="/">Home</a> •
    <a href="/blog-pg1.html">Blog</a> •







<
|






<









>







 







>
>
>
>
>
>








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
..
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90

#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/template
         pollen/decode
         pollen/private/version
         racket/string
         racket/function
         racket/list
         txexpr

         "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
         html$-notes-section
         html$-paginate-navlinks)
................................................................................

(define (html$-article-listing-short pagenode pubdate title)
  ◊string-append{
 <article class="short-listing"><a href="/◊(symbol->string pagenode)">
  <time datetime="◊pubdate" class="caps">◊(ymd->english pubdate)</time>
  <h3>◊|title|</h3>
 </a></article>})

(define (html$-article-excerpt pagenode excerpt-tx)
  ◊string-append{
   ◊(->html excerpt-tx #:splice? #t)
   <p class="further-reading"><a href="◊|web-root|◊symbol->string[pagenode]">Read more…</a></p>
})

(define (html$-page-footer)
  ◊string-append{
<footer id="main">
 <p class="title">The Local Yarn</p>
 <nav><a href="/">Home</a> •
    <a href="/blog-pg1.html">Blog</a> •

Modified tags-html.rkt from [d9318d98] to [d7a74b7d]. 

49
50
51
52
53
54
55



56
57
58
59
60
61
62
..
97
98
99
100
101
102
103




104
105
106
107
108
109
110

                                  ol
                                  ul
                                  sup
                                  blockquote
                                  code)

(provide html-root



         html-item
         html-section
         html-subsection
         html-newthought
         html-caps
         html-center
         html-strike
................................................................................
  (define second-pass
    (decode-elements first-pass
                     #:block-txexpr-proc detect-newthoughts
                     #:inline-txexpr-proc decode-link-urls
                     #:exclude-tags '(script style pre code)))
  `(body ,@second-pass))





(define (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 (html-index attrs elems)








>
>
>







 







>
>
>
>








49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
...
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117

                                  ol
                                  ul
                                  sup
                                  blockquote
                                  code)

(provide html-root
         html-title
         html-excerpt
         html-excerpt*
         html-item
         html-section
         html-subsection
         html-newthought
         html-caps
         html-center
         html-strike
................................................................................
  (define second-pass
    (decode-elements first-pass
                     #:block-txexpr-proc detect-newthoughts
                     #:inline-txexpr-proc decode-link-urls
                     #:exclude-tags '(script style pre code)))
  `(body ,@second-pass))

(define (html-title . elements) `(title ,@elements))
(define (html-excerpt . elements) `(excerpt ,@elements))
(define (html-excerpt* . elements) `(excerpt* ,@elements))

(define (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 (html-index attrs elems)

Modified web-extra/martin.css.pp from [d5244fee] to [bcad2246]. 

385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
...
540
541
542
543
544
545
546






















547
548
549
550
551
552
553


p {
    margin: 0;
    text-indent: 0;
}

p + p {
    text-indent: 2em;
}

section.entry-content blockquote {
    font-size: ◊x-lineheight[0.7];
    line-height: ◊derive-lineheight[7 #:per-lines 6];
    margin: ◊x-lineheight[1.0] 2em;
}
................................................................................
    text-align: left;
}

section.footnotes ol {
    margin: ◊x-lineheight[0.5] 0 0 0;
}























/* ******* “Further Notes” added to articles ********
 */

div.further-notes {
    margin-top: ◊x-lineheight[3];
}









|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
...
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575


p {
    margin: 0;
    text-indent: 0;
}

p + p {
    text-indent: 1em;
}

section.entry-content blockquote {
    font-size: ◊x-lineheight[0.7];
    line-height: ◊derive-lineheight[7 #:per-lines 6];
    margin: ◊x-lineheight[1.0] 2em;
}
................................................................................
    text-align: left;
}

section.footnotes ol {
    margin: ◊x-lineheight[0.5] 0 0 0;
}


p.further-reading {
   margin-top: ◊x-lineheight[1];
   text-indent: 0;
   background: #eee;
   padding-left: 0.3rem;
   border-radius: 3px;
}

p.further-reading:hover {
    background-color: #ddd;
}

p.further-reading a {
    color: ◊color-bodytext !important;
    font-style: italic;
}

p.further-reading a:hover, p.further-reading a:active {
    background-color: #ddd;
}

/* ******* “Further Notes” added to articles ********
 */

div.further-notes {
    margin-top: ◊x-lineheight[3];
}

This page was generated in about 0.008s by Fossil 2.12 [405457c161] 2020-07-03 20:54:08