bkyk8rc3zvpnsf5inmcqq4n3k98cv6hj-my-site-hyper-literate-git.test.suzanne.soy-0.0.1

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README | LICENSE

footnote.rkt (2923B)

      1 #lang scheme/base
      2 
      3 (require scribble/core
      4          scribble/decode
      5          scribble/html-properties
      6          scribble/latex-properties
      7          racket/promise
      8          setup/main-collects
      9          "private/counter.rkt")
     10 
     11 (provide note
     12          define-footnote)
     13 
     14 (define footnote-style-extras
     15   (let ([abs (lambda (s)
     16                (path->main-collects-relative
     17                 (collection-file-path s "scriblib")))])
     18     (list (make-css-addition (abs "footnote.css"))
     19           (make-tex-addition (abs "footnote.tex")))))
     20 
     21 
     22 (define note-box-style (make-style "NoteBox" footnote-style-extras))
     23 (define note-content-style (make-style "NoteContent" footnote-style-extras))
     24 
     25 (define (note . text)
     26   (make-element 
     27    note-box-style
     28    (make-element note-content-style
     29                  (decode-content text))))
     30 
     31 
     32 (define footnote-style (make-style "Footnote" footnote-style-extras))
     33 (define footnote-ref-style (make-style "FootnoteRef" footnote-style-extras))
     34 (define footnote-content-style (make-style "FootnoteContent" footnote-style-extras))
     35 (define footnote-target-style (make-style "FootnoteTarget" footnote-style-extras))
     36 (define footnote-block-style (make-style "FootnoteBlock" footnote-style-extras))
     37 (define footnote-block-content-style (make-style "FootnoteBlockContent" footnote-style-extras))
     38 
     39 (define-syntax-rule (define-footnote footnote footnote-part)
     40   (begin
     41     (define footnotes (new-counter "footnote"))
     42     (define id (gensym))
     43     (define (footnote . text) (do-footnote footnotes id text))
     44     (define (footnote-part . text) (do-footnote-part footnotes id))))
     45 
     46 (define (do-footnote footnotes id text)
     47   (let ([tag (generated-tag)]
     48         [content (decode-content text)])
     49     (make-traverse-element
     50      (lambda (get set)
     51        (set id (cons (cons
     52                       (make-element footnote-target-style
     53                                     (make-element
     54                                      'superscript
     55                                      (counter-target footnotes tag #f)))
     56                       content)
     57                      (get id null)))
     58        (make-element footnote-style
     59                      (list
     60                       (make-element 
     61                        footnote-ref-style
     62                        (make-element
     63                         'superscript
     64                         (counter-ref footnotes tag #f)))
     65                       (make-element
     66                        footnote-content-style
     67                        content)))))))
     68 
     69 (define (do-footnote-part footnotes id)
     70   (make-part
     71    #f
     72    (list `(part ,(generated-tag)))
     73    #f
     74    (make-style #f '(unnumbered hidden toc-hidden))
     75    null
     76    (list
     77     (make-traverse-block
     78      (lambda (get set)
     79        (make-compound-paragraph
     80         footnote-block-style
     81         (map (lambda (content)
     82                (make-paragraph
     83                 footnote-block-content-style
     84                 content))
     85              (reverse (get id null)))))))
     86    null))