blob: 7f305e46e3862319628d66f9829021f2bbc58bb8 (
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
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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
|
# -*- tcl -*-
# checker_toc.tcl
#
# Code used inside of a checker interpreter to ensure correct usage of
# doctoc formatting commands.
#
# Copyright (c) 2003-2009 Andreas Kupries <andreas_kupries@sourceforge.net>
# L10N
package require msgcat
proc ::msgcat::mcunknown {locale code} {
return "unknown error code \"$code\" (for locale $locale)"
}
if {0} {
puts stderr "Locale [::msgcat::mcpreferences]"
foreach path [dt_search] {
puts stderr "Catalogs: [::msgcat::mcload $path] - $path"
}
} else {
foreach path [dt_search] {
::msgcat::mcload $path
}
}
# State, and checker commands.
# -------------------------------------------------------------
#
# Note that the code below assumes that a command XXX provided by the
# formatter engine is accessible under the name 'fmt_XXX'.
#
# -------------------------------------------------------------
global state
# State machine ... State centered
# --------------+-----------------------+----------------------
# state | allowed commands | new state (if any)
# --------------+-----------------------+----------------------
# all except | include vset |
# ==============+=======================+======================
# toc_begin | toc_begin | -> contents
# --------------+-----------------------+----------------------
# contents | item | -> contents //
# +-----------------------+-----------
# | division_start | -> end, PUSH division
# +-----------------------+-----------
# | toc_end | -> done
# --------------+-----------------------+----------------------
# division | item | -> division //
# +-----------------------+-----------
# | division_start | -> division, PUSH division
# +-----------------------+-----------
# | division_end | POP (-> division / -> end)
# --------------+-----------------------+----------------------
# end | toc_end | -> done
# +-----------------------+-----------
# | division_start | PUSH division
# --------------+-----------------------+----------------------
# State machine, as above ... Command centered
# --------------+-----------------------+----------------------
# state | allowed commands | new state (if any)
# --------------+-----------------------+----------------------
# all except | include vset |
# ==============+=======================+======================
# toc_begin | toc_begin | -> contents
# --------------+-----------------------+----------------------
# contents | item | -> contents
# division | | -> division
# --------------+-----------------------+----------------------
# contents | division_start | -> end, PUSH division
# division | | -> divison, PUSH division
# end | | PUSH division
# --------------+-----------------------+----------------------
# division | division_end | POP (-> division / -> end)
# --------------+-----------------------+----------------------
# contents | toc_end | -> done
# end | | -> done
# --------------+-----------------------+----------------------
# -------------------------------------------------------------
# Helpers
proc Error {code {text {}}} {
global state
# Problematic command with all arguments (we strip the "ck_" prefix!)
# -*- future -*- count lines of input, maintain history buffer, use
# -*- future -*- that to provide some context here.
set cmd [lindex [info level 1] 0]
set args [lrange [info level 1] 1 end]
if {$args != {}} {append cmd " [join $args]"}
# Use a message catalog to map the error code into a legible message.
set msg [::msgcat::mc $code]
if {$text != {}} {
set msg [string map [list @ $text] $msg]
}
dt_error "TOC error ($code), \"$cmd\" : ${msg}."
return
}
proc Warn {code text} {
set msg [::msgcat::mc $code]
dt_warning "TOC warning ($code): [join [split [format $msg $text] \n] "\nTOC warning ($code): "]"
return
}
proc Is {s} {global state ; return [string equal $state $s]}
proc IsNot {s} {global state ; return [expr {![string equal $state $s]}]}
proc Go {s} {Log " >>\[$s\]" ; global state ; set state $s; return}
proc Push {s} {Log " //\[$s\]" ; global state stack ; lappend stack $state ; set state $s; return}
proc Pop {} {Log* " pop" ; global state stack ; set state [lindex $stack end] ; set stack [lrange $stack 0 end-1] ; Log " \\\\\[$state\]" ; return}
proc State {} {global state stack ; return "$stack || $state"}
proc Enter {cmd} {Log* "\[[State]\] $cmd"}
#proc Log* {text} {puts -nonewline $text}
#proc Log {text} {puts $text}
proc Log* {text} {}
proc Log {text} {}
# -------------------------------------------------------------
# Framing
proc ck_initialize {} {
global state ; set state toc_begin
global stack ; set stack [list]
}
proc ck_complete {} {
if {[Is done]} {
return
} else {
Error end/open/toc
}
return
}
# -------------------------------------------------------------
# Plain text
proc plain_text {text} {
# Ignore everything which is only whitespace ...
# Beyond that plain text is not allowed.
set redux [string map [list " " "" "\t" "" "\n" ""] $text]
if {$redux == {}} {return [fmt_plain_text $text]}
Error toc/plaintext
return ""
}
# -------------------------------------------------------------
# Variable handling ...
proc vset {var args} {
switch -exact -- [llength $args] {
0 {
# Retrieve contents of variable VAR
upvar #0 __$var data
return $data
}
1 {
# Set contents of variable VAR
global __$var
set __$var [lindex $args 0]
return "" ; # Empty string ! Nothing for output.
}
default {
return -code error "wrong#args: set var ?value?"
}
}
}
# -------------------------------------------------------------
# Formatting commands
proc toc_begin {label title} {
Enter toc_begin
if {[IsNot toc_begin]} {Error toc/begincmd}
Go contents
fmt_toc_begin $label $title
}
proc toc_end {} {
Enter toc_end
if {[IsNot end] && [IsNot contents]} {Error toc/endcmd}
Go done
fmt_toc_end
}
proc division_start {title {symfile {}}} {
Enter division_start
if {
[IsNot contents] && [IsNot end] && [IsNot division]
} {Error toc/sectcmd}
if {[Is contents] || [Is end]} {Go end} else {Go division}
Push division
fmt_division_start $title $symfile
}
proc division_end {} {
Enter division_end
if {[IsNot division]} {Error toc/sectecmd [State]}
Pop
fmt_division_end
}
proc item {file label desc} {
Enter item
if {[IsNot contents] && [IsNot division]} { Error toc/itemcmd }
fmt_item $file $label $desc
}
proc comment {text} {
if {[Is done]} {Error toc/nodonecmd}
return ; #fmt_comment $text
}
# -------------------------------------------------------------
|
