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
|
#| 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)
(write `(block-node (data ,(node-data x))
(children ,@(list-queue-list (node-children x))))
port)
(newline 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))))
(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`.
(add-new-active-child! node (line->xstring line)))
(define (parse-line-to-node node line)
;; Parse LINE as a part of 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))))
|
