◊(Local Yarn Code "markup.rkt at [cf83a366]")

File yarn-lib/markup.rkt artifact e117b7ce part of check-in cf83a366


#lang racket/base

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

;; Pollen “tag functions” that return elements of a Yarn AST. This AST can be
;; rendered into HTML or other formats (using, e.g., the yarn/render/html module).

(require pollen/decode
         pollen/tag
         racket/string
         txexpr
         "index.rkt"
         "string.rkt"
         "tools.rkt"
         yarn/path)

(provide (all-defined-out))

(define (root . elems)
  (print (validate-txexpr `(test ,@elems)))
  (check-title elems)
  (serialize-article-placeholder)
  `(document ,@(decode-hardwrapped-paragraphs elems)))

;; Customized paragraph decoder replaces single newlines within paragraphs
;; with single spaces instead of <br> tags (allow hard-wrapped paragraphs)
(define (decode-hardwrapped-paragraphs xs)
  (define (no-linebreaks xs)
    (decode-linebreaks xs " "))
  (decode-paragraphs xs 'paragraph #:linebreak-proc no-linebreaks))

;; Set a title if not already set
(define (check-title elems)
  (cond
    [(and (not (meta-set? 'title))
          (pair? elems)
          ((tx-is? 'poetry #:has-attrs 'title) (car elems)))
     (set-meta 'title (format "‘~a’" (attr-ref (car elems) 'title)))
     (set-meta 'title-supplied? #t)]
    [(not (meta-set? 'title))
     (set-meta 'title (if (pair? elems) (first-words elems 5) ""))]))

;; Yarn AST:
;;  (document Block-Contents)
;;  Footnote definitions, index entry keys are stored in the metas

;;  Block-Content := 
;;    (heading #:level Inline-Contents)
;;    | (paragraph Inline-Contents)
;;    | (thematic-break style)
;;    | (codeblock info Inline-Contents)
;;    | (blockquote items := (item Block-Contents))
;;    | (poetry title style Block-Contents)
;;    | (itemization style start Block-Contents)
;;    | (dialogue speeches := (speech interlocutor Block-Contents))
;;    | (figure source caption)
;;    | (margin-note Block-Contents)

;;  Inline-Content :=
;;    string?
;;    | (italic Inline-Contents)
;;    | (bold Inline-Contents)
;;    | (link destination Inline-Contents)
;;    | (monospace Inline-Contents)
;;    | (strikethrough Inline-Contents)
;;    | (caps Inline-Contents)
;;    | (image description source)
;;    | (xref type dest-key Inline-Contents)
;;    | (footnote-ref label)
;;    | line-break

(define blocks-elements
  '(heading
    paragraph
    thematic-break
    codeblock
    blockquote
    poetry
    itemization
    dialogue
    figure
    margin-note))

(define inline-elements
  '(italic
    bold
    link
    image
    xref
    footnote-ref
    line-break))

(define (title . t) (set-meta 'title t) (set-meta 'title-supplied? #t) "")
(define (section . s) `(heading [[level "2"]] ,@s))
(define (subsection . s) `(heading [[level "3"]] ,@s))
(define (excerpt . e) (set-meta 'excerpt e))
(define (excerpt* . e) (apply excerpt e) `(@ ,@e))

(define (pause [type 'blank]) `(thematic-break ,type)) ; type = blank | mark

(define codeblock (default-tag-function 'codeblock #:info ""))
(define blockquote (default-tag-function 'blockquote)) ; #:caption
(define figure (default-tag-function 'figure))

(define (i . inline) `(italic ,@inline))
(define em i)
(define (b . inline) `(bold ,@inline))
(define (mono . inline) `(monospace ,@inline))
(define (caps . inline) `(caps ,@inline))
(define (strike . inline) `(strikethrough ,@inline))
(define br 'line-break)

(define (link ref . elems) `(link ,ref ,@elems))
(define (url ref URL) (update-metas-subhash 'urls ref URL) "")

(define (xref type elems k)
  (define key (or k (normalize-key (->text elems))))
  (cons-to-metas-list 'xref-keys key)
  `(xref ,type ,key ,@elems))

(define (pin #:key [key #f] . elems) (xref 'idx elems key))
(define (def #:key [key #f] . elems) (xref 'def elems key))
(define (ref #:key [key #f] . elems) (xref 'ref elems key))

(define (fn ref) `(footnote-ref ,ref))
(define (fndef ref . elems) (update-metas-subhash 'footnote-defs ref elems) "")

(define (ol . elems) `(itemization [[start "1"]] ,@elems))     ; #:style
(define (ul . elems) `(itemization ,@elems))       ; #:style
(define (item . blocks) `(item ,@blocks))

(define (dialogue . speeches) `(dialogue ,@speeches))
(define (say interlocutor elems) `(speech ,interlocutor ,@elems))
(define (saylines interlocutor elems)
  `(speech ,interlocutor ,@(decode-linebreaks elems 'line-break)))

(define verse (default-tag-function 'poetry)) ; #:title, #:style

(define-tag-function (note attrs elems)
  (let* ([note-count (update-meta 'note-count add1 0)]
         [note-id    (string-append (attr-ref attrs 'date) (format "_~a" note-count))]
         [maybe-disp (string-split (attr-ref attrs 'disposition ""))]
         [the-note (attr-set* `(note ,attrs ,@elems) 'id note-id 'parent (here-output-path))])
    (cond
      [(> (length maybe-disp) 1)
       (set-meta 'disposition `(,(car maybe-disp)
                                ,(string-join (cdr maybe-disp))
                                ,note-id))])
    (cons-to-metas-list 'notes the-note)
    (serialize-note the-note note-count)
    ""))