◊(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 Side-by-Side 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

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

@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!
}

@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]. 

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

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













+







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




-
-
-
+
-
-
-
-
+


-
-
-
+
+
+
+
+
+
+






-
-
-
+
+
+


+
+
+
+
-
+














-
+

-
-
-
-
+
+
+
+








#lang racket/base

; SPDX-License-Identifier: BlueOak-1.0.0
; This file is licensed under the Blue Oak Model License 1.0.0.

(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-values (doc-no-title maybe-title)
    (splitf-txexpr doc (make-tag-predicate 'title)))
  (define-values (body-txpr note-txprs)
  (define body-txpr (decode doc #:txexpr-proc filter-special-tags))
    (splitf-txexpr doc-no-title (make-tag-predicate 'note)))
  (define-values (disposition disp-note-id)
    (notes->last-disposition-values note-txprs))

  (current-notes (reverse (current-notes)))
  (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-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
                                               disposition
                                               disp-note-id
                                               (length note-txprs))]
                                               (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 note-txprs)])
         [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 note-txprs)
                  #:note-count (length (current-notes))
                  #:content-html doc-html
                  #:disposition disposition
                  #:disp-html-anchor disp-note-id
                  #:listing-full-html (string-append header doc-html footer)
                  #:listing-excerpt-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"))
︙
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

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








-
+
+
+
+
+
+
+
+













-
+
-
-
-
-
-
-
-
+








                           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)])
         [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 (html$-note-listing-full pagenode
                  #:listing-full-html listing-full
                                                               note-id
                                                               title-html
                                                               note-date
                                                               content-html
                                                               author
                                                               author-url)
                  #:listing-excerpt-html ""
                  #: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

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

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







-
+
-






-









+








#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
(require pollen/template
         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$-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)
︙
72
73
74
75
76
77
78






79
80
81
82
83
84
85

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








+
+
+
+
+
+









(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

49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65








+
+
+








                                  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
︙
97
98
99
100
101
102
103




104
105
106
107
108
109
110

100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117








+
+
+
+








  (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

385
386
387
388
389
390
391

392
393
394
395
396
397
398
399








-
+









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

p + p {
    text-indent: 2em;
    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;
}
︙
540
541
542
543
544
545
546






















547
548
549
550
551
552
553

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








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








    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.01s by Fossil 2.19 [318ab802db] 2022-05-27 02:05:21