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 LINE) is a procedure that takes a line and returns either
;;
;; 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 is a procedure that takes a 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-CHILD NEW-NODE LINE), which returns
;;
;; 1) The new child node,
;; 2) The node from which to start processing the rest of the line,
;; 3) the rest of the 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)
(make-block-node data continues allowed-inside
(list-queue) #f))
(define (allowed-inside node line)
((get-allowed-inside node) line))
(define (continues node line)
((get-continues node) line))
(define (close-active-children node)
;; Close all active children in the current node.
(set-active-child! node #f))
(define (add-new-active-child! node child)
(list-queue-add-back! (node-children node) child)
(set-active-child! node child))
(define (add-new-child node new-child-of-node continue-node line)
;; Add `new-child-of-node` to `node`, and continue parsing with
;; `continue-node` and `line`.
(add-new-active-child! node new-child-of-node)
(parse-line-to-node continue-node line))
(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. Otherwise, add to the paragraph.
(cond
((allowed-inside node line) first-arg => (cut add-new-child 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. Finally, check if `line` is
;; allowed inside this node. 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 add-new-child 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-active-child! node new-child)))
(define (parse-line-to-node node line)
;; NODE.
;;
;; 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
((empty-line? line) (close-active-children node))
((get-active-child node)
=> (cut process-active-child node line <>))
((allowed-inside node line)
first-arg => (cut add-new-child node <...>))
(else (add-new-paragraph node line))))
|
