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

Login
About History Code Code Docs Road Map Issues
Overview
Comment:Implement figure tags
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: e5a492affb112870a6e5c6002927d840457a9112de011186dcc2216ab06dd7b9
User & Date: joel on 2019-05-27 20:55:17
Other Links: manifest | tags
Context
2019-05-27
21:50
Make ◊index tag syntax more concise check-in: cffdbbee user: joel tags: trunk
20:55
Implement figure tags check-in: e5a492af user: joel tags: trunk
20:13
Make disposition marks superscript check-in: 0c319933 user: joel tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified code-docs/pollen.scrbl from [18a1b869] to [308e939b].

︙
134
135
136
137
138
139
140










141
142
143
144
145
146
147

134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157








+
+
+
+
+
+
+
+
+
+








  ◊url[1]{https://google.com}
}|

The @code{url} tag for a given identifier may be placed anywhere in the document, even before it is
referenced. If you create a @code{link} for an identifier that has no corresponding @code{url},
a @code{"Missing reference: [link-id]"} message will be substituted for the URL. Conversely, 
creating a @code{url} that is never referenced will produce no output and no warnings or errors.

@deftogether[(@defproc[(figure     [image-file string?] [caption xexpr?] ...) txexpr?]
              @defproc[(figure-@2x [image-file string?] [caption xexpr?] ...) txexpr?])]

Insert a block-level image. The @racket[_image-file] should be supplied as a filename only, with no
folder names. It is assumed that the image is located inside an @racket[images-folder] within the
same folder as the source document.

For web output, using @racket[figure-@2x] will produce an image hard-coded to display at half its
actual size, or the width of the text block, whichever is smaller.

@deftogether[(@defproc[(fn    [fn-id stringish?]) txexpr?]
              @defproc[(fndef [fn-id stringish?] [elements xexpr?] ...) txexpr?])]

As with hyperlinks, footnotes are specified reference-style. In the output, footnotes will be
numbered according to the order in which their identifiers are referenced in the source document.
︙

Modified pollen.rkt from [ee59101e] to [8f82b23e].

︙
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

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








+
+

















-









(poly-branch-tag center)
(poly-branch-tag section)
(poly-branch-tag subsection)
(poly-branch-tag code)
(poly-branch-tag dialogue)
(poly-branch-tag say)
(poly-branch-tag index)
(poly-branch-tag figure)
(poly-branch-tag figure-@2x)
(poly-branch-kwargs-tag blockcode)
(poly-branch-kwargs-tag verse)          ; [#:title ""] [#:italic "no"]

(poly-branch-tag link)
(poly-branch-tag url)
(poly-branch-tag fn)
(poly-branch-tag fndef)

(poly-branch-kwargs-tag note)
(poly-branch-tag block)

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

Modified tags-html.rkt from [fedcf631] to [8147764e]. 

1
2
3
4
5
6
7
8
9
10


11
12

13
14
15
16
17
18
19

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22











+
+


+








#lang racket/base

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

;; Tag functions used by pollen.rkt when HTML is the output format.

(require (for-syntax racket/base racket/syntax))
(require racket/list
         racket/function
         racket/draw
         racket/class
         pollen/decode
         pollen/tag
         pollen/setup
         net/uri-codec
         txexpr
         "dust.rkt")

(provide html-fn
         html-fndef)
︙
28
29
30
31
32
33
34
35

36
37
38
39
40
41
42

31
32
33
34
35
36
37

38
39
40
41
42
43
44
45








-
+








;;  (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)))])
                        (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
︙
56
57
58
59
60
61
62


63
64
65
66
67
68
69

59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74








+
+








         html-subsection
         html-newthought
         html-smallcaps
         html-center
         html-block
         html-blockcode
         html-index
         html-figure
         html-figure-@2x
         html-dialogue
         html-say
         html-verse
         html-link
         html-url
         html-fn
         html-fndef
︙
113
114
115
116
117
118
119
































120
121
122
123
124
125
126

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








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








  (let* ([title  (maybe-attr '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-title (pre ,pre-attrs ,@elems))))

;; (Private) Get the dimensions of an image file
(define (get-image-size filepath)
  (define bmp (make-object bitmap% filepath))
  (list (send bmp get-width) (send bmp get-height)))

;; (Private) Builds a path to an image in the [image-dir] subfolder of the current document's 
;; folder, relative to the current document’s folder
(define (image-source basename)
  (define here-path (string->path (maybe-meta 'here-path)))
  (define-values (_ here-rel-path-parts)
    (drop-common-prefix (explode-path (current-project-root))
                        (explode-path here-path)))
  (let* ([folder-parts (drop-right here-rel-path-parts 1)]
         [img-path-parts (append folder-parts (list images-folder basename))]
         [img-path (apply build-path/convention-type 'unix img-path-parts)])
    (path->string img-path)))

(define (html-figure-@2x . elems)
  (define src (image-source (car elems)))
  (define alt-text (tx-strs `(span ,@(cdr elems))))
  (define img-width (car (get-image-size (build-path (current-project-root) src))))
  (define style-str (format "width: ~apx" (/ img-width 2.0)))
  `(figure (img [[alt ,alt-text] [style ,style-str] [src ,(string-append web-root src)]])
           (figcaption ,@(cdr elems))))

(define (html-figure . elems)
  (define src (string-append web-root (image-source (car elems))))
  (define alt-text (tx-strs `(span ,@(cdr elems))))
  `(figure [[class "fullwidth"]]
           (img [[alt ,alt-text] [src ,src]])
           (figcaption ,@(cdr 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))
︙
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191








192
193
194
195
196

214
215
216
217
218
219
220








221
222
223
224
225
226
227
228
229
230
231
232
233








-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+






(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))))
      (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))]))

(define (html-note attrs elems)
  (txexpr 'note attrs (decode-hardwrapped-paragraphs elems)))

Modified web-extra/martin.css.pp from [d29db7ea] to [6d089e00].

︙
503
504
505
506
507
508
509

510
511
512
513
514

515
516
517
518
519
520
521

503
504
505
506
507
508
509
510
511
512
513
514

515
516
517
518
519
520
521
522








+




-
+








    figure>a {
        margin: 0;
        padding: 0;
        font-family: arial, sans-serif;
    }
    figure img {
        max-width: 100%;
        margin: 0 auto;
    }

    figcaption {
        font-size: 0.8rem;
        line-height: 0.8rem;
        line-height: ◊derive-lineheight[4 #:per-lines 3];
        margin-bottom: 0.3rem;
        text-align: left;
    }

    dl {
        margin: ◊x-lineheight[1] 0;
    }
︙

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