Newer
Older
#+xcvb
(module
(:depends-on
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
"exscribe/packages"
"exscribe/specials"
"exscribe/exscribe-data")))
(in-package :exscribe-txt)
(defun normalize-text (string)
(with-output-to-string
(s)
(loop
with has-space-p = nil
for c across string
as code = (char-code c) do
(cond
((or (<= code 32) (<= 127 code 160))
(setf has-space-p t))
(t
(when has-space-p
(write-char #\Space s))
(write-char c s)
(setf has-space-p nil))))))
(defun extract-text (node &aux strings)
"Extract text strings from a node."
(labels
((emit (x) (push x strings))
(space () (emit " "))
(emit-quote () (emit "\""))
(walk (x)
(match x
((tag :p * x) (space) (walk x) (space))
((tag :q * x) (emit-quote) (walk x) (emit-quote))
((tag :br * *) (space))
((tag :footnote * *) nil)
((tag * * x) (walk x))
((of-type string) (emit x))
((cons x y) (walk x) (walk y))
(* nil))))
(walk node)
(normalize-text
(apply #'concatenate 'string (nreverse strings)))))
(defun process-document ()
(NIY))
(defun init ()
(setf *exscribe-document-hook* 'process-document))