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
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
127
128
129
130
|
#| Copyright 2024 Peter McGoron
|
| Licensed under the Apache License, Version 2.0 (the "License");
|
| you may not use this file except in compliance with the License.
| You may obtain a copy of the License at
|
| http://www.apache.org/licenses/LICENSE-2.0
|
| Unless required by applicable law or agreed to in writing, software
| distributed under the License is distributed on an "AS IS" BASIS,
| WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
| See the License for the specific language governing permissions and
| limitations under the License.
|#
(define-record-type <block-node>
;; A <BLOCK-NODE> contains information on a block in a document that may
;; contain other blocks.
;;
;; DATA is arbitrary data associated with the node.
;;
;; (CONTINUES NODE LINE) is a procedure that takes a node and
;; the current line and returns
;;
;; 1) `#f`, denoting that the line does not continue the block, or
;; 2) the rest of the after consuming the continuation text of the block.
;;
;; (ALLOWED-INSIDE NODE LINE) is a procedure that takes the current node
;; and the current line and returns
;;
;; 1) `#f`, meaning that the line does not start a new node that can be
;; started inside of the block, or
;; 2) (VALUES NEW-NODE LINE), which are arguments to a tail-called
;; invocation of `parse-line-to-node!`. The parsing will continue at
;; `new-node` with the line `line`.
;;
;; CHILDREN is an SRFI-117 queue of child blocks of the node.
;;
;; ACTIVE is the active child in CHILDREN, or `#f` for no active child.
(make-block-node data continues allowed-inside children active)
block-node?
(data node-data)
(continues get-continues)
(allowed-inside get-allowed-inside set-allowed-inside!)
(children node-children)
(active get-active-child set-active-child!))
(cond-expand
(chicken
(begin
(set-record-printer!
<block-node>
(lambda (x port)
(pp `(block-node (data ,(node-data x))
(children ,@(list-queue-list (node-children x)))
(active-child ,(get-active-child x)))
port)))))
(else))
(define (make-empty-node data continues allowed-inside)
;; Create a new node with no children.
(make-block-node data continues allowed-inside
(list-queue) #f))
(define (allowed-inside node line)
((get-allowed-inside node) node line))
(define (continues node line)
((get-continues node) node line))
(define (close-active-children! node)
;; Close all active children in the current node.
(set-active-child! node #f))
(define (add-new-child! node child active-child?)
;; Add a new `child` to `node`. If `active-child?` is truthy, then
;; `child` is the new active child of `node`. Otherwise, `child` is added
;; and no child of `node` is active.
(list-queue-add-back! (node-children node) child)
(set-active-child! node (if active-child?
child
#f)))
(define (process-active-child node line active-child)
;; Act on the `active-child` with the given `line`.
(define (handle-xstring)
;; Handle insertion of a new line when the active child is a paragraph.
;;
;; If the new line is the start of a block allowed in `node` then close
;; `child` and add a new child. If the line is empty, put in a paragraph
;; break. Otherwise, add to the paragraph.
(cond
((allowed-inside node line) first-arg => parse-line-to-node!)
((empty-line? line) (close-active-children! node))
(else (xstring-append! active-child line #\newline))))
(define (handle-child-block)
;; Handle insertion of a new line when the active child is a block.
;;
;; Check if `line` continues `child`. If not, check if `line` is
;; allowed after `child` in this node. If not, check if `line` is
;; allowed inside this node. If not, check if line is a paragraph
;; break. If not, add the line as a paragraph.
(cond
((continues active-child line) => (cut parse-line-to-node! active-child <>))
((allowed-inside node line) first-arg => (cut parse-line-to-node! <...>))
((empty-line? line) (close-active-children! node))
(else (add-new-paragraph node line))))
(cond
((xstring? active-child)
(handle-xstring))
((block-node? active-child)
(handle-child-block))))
(define (add-new-paragraph node line)
;; Add new node as the active child to `node` with the data of `line`.
(let ((new-child (line->xstring line)))
(xstring-append! new-child #\newline)
(add-new-child! node new-child #t)))
(define (parse-line-to-node! node line)
;; If there is an active node, either add the line to the node or start a
;; new node. If there is no active node, start a new node, either by
;; starting a new block or by starting a new paragraph.
(cond
((get-active-child node)
=> (cut process-active-child node line <>))
((allowed-inside node line) first-arg => parse-line-to-node!)
((not (empty-line? line)) (add-new-paragraph node line))))
|
