blob: 0fecb1cd5f2554e46f1b9840f45a382ff2b18588 (
plain)
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
|
#
# Documentation.tcl
#
# TCL procedures to process documentation files
#
#
# Read a file
# The array subTitles binds the subTitles for each title (or empty list)
# The array texts binds the text for each title
#
# Titles are of the form {Title subTitle subTitle}
#
proc readFile {filename} {
global subTitles texts
if {! [file readable $filename]} return
foreach ar {subTitles texts} {if [info exists $ar] {unset $ar}}
set title "Top"
set stitle "Top"
set subTitles($stitle) {}
set level 1
set f [open $filename r]
while {[gets $f line] >= 0} {
if [regexp {^[ ]*(\*+)[ ]*(.*$)} $line dummy s t] {
# it is a new title
set l [string length $s]
# at a deepest level go down enough levels
while {$level < $l} {
set up($title) $stitle
set stitle $title
lappend title $t
incr level
}
# at an upper level go up enough level
while {$level > $l} {
set title stitle
set stitle $up($stitle)
incr level -1
}
# at the current level
lappend subTitles($stitle) $t
set title [concat $stitle $t]
set texts($title) ""
} else {
# it is a line for the current title
lappend texts($title) $line
}
}
close $f
}
#
# call on each title : titleProc title level
# call on each text : textProc text
proc dump {titleProc textProc {title Top} {level 1}} {
global subTitles texts
if [info exists texts($title)] {$textProc $texts($title)}
if [info exists subTitles($title)] {
set l $level
incr l
foreach t $subTitles($title) {
$titleProc $t $level
dump $titleProc $textProc [concat $title $t] $l
}
}
}
# cut a text into sections
# and call on each section : sectionProc section text
proc sectionText {aText aSectionProc} {
set section ""
set text {}
foreach line $aText {
if {[string index $line 0] == "."} {
$aSectionProc $section $text
set section $line
set text {}
} else {
lappend text $line
}
}
$aSectionProc $section $text
}
|
