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
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
|
%
% \iffalse
%<*driver>
\documentclass{tclldoc}
\begin{document}
\DocInput{sourcedtx.dtx}
\end{document}
%</driver>
% \fi
%
% \title{The \textsf{sourcedtx} package}
% \author{Lars Hellstr\"om}
% \date{18 July 2003}
% \maketitle
%
% \begin{abstract}
% The \textsf{sourcedtx} package provides a \Tcllogo\ command
% |dtx::source| that makes it possible to |source| \Tcllogo\ code
% from a \textsf{doc}-style \texttt{.dtx} file without docstripping
% it first.
% \end{abstract}
%
%
% \begin{tcl}
%<*pkg>
namespace eval dtx {}
% \end{tcl}
% \setnamespace{dtx}
%
% \begin{proc}{strip_string}
% The |strip_string| procedure does the actual docstripping for
% |source_dtx|. The syntax is
% \begin{quote}
% |dtx::strip_string| \word{text} \word{option list}
% \word{meta prefix}\regopt\ \word{interaction}\regopt
% \end{quote}
% where \word{text} is the string to docstrip and \word{option list}
% is the list of options to use. The \word{meta prefix} (by default
% two percent signs) is the string to use for the \textsc{docstrip}
% parameter \verb|\MetaPrefix|. The \word{interation} (by default 1)
% is a flag for the ``interaction'' level to use. |0| means error
% messages are simply written to |stderr|, whereas |1| means an error
% will be raised. (It is possible that \word{interaction} will be
% extended to a ``flag word'' where each bit controls some aspect of
% the interaction.)
%
% When errors are raised, the |errorCode| is set to a list with the
% format
% \begin{quote}
% |DOCSTRIP| \word{situation} \word{lineno}
% \end{quote}
% where \word{lineno} is the line number (starting at one) of the line
% where the error was detected. The \word{situation}s are described
% below, at the positions in the code where they can occur.
%
% \begin{tcl}
proc dtx::strip_string {text options {metaprefix %%} {interaction 1}} {
% \end{tcl}
% The |O| array has entires for precisely the specified options, so
% that an opion can be tested using |info exists|.
% \begin{tcl}
foreach option $options {set O($option) ""}
% \end{tcl}
% |stripped| is where the text that passes docstripping is collected.
% \begin{tcl}
set stripped ""
% \end{tcl}
% |block_stack| is the list of modules inside which the current line
% lies. |offlevel| is the number of modules that must be exited
% before code lines should once again be included. |verbatim| is a
% flag for whether verbatim mode is in force.
% \begin{tcl}
set block_stack [list]
set offlevel 0
set verbatim 0
% \end{tcl}
% |lineno| is the input line number counter, for use in error
% messages.
% \begin{tcl}
set lineno 1
% \end{tcl}
% Here starts the main loop over lines in the \word{text}. It
% constitutes the majority of the procedure and is split in two
% parts. The smaller part handles lines in verbatim mode (unusual),
% the large part handles lines in normal mode (with comment lines,
% code lines, guard lines, and so on).
% \begin{tcl}
foreach line [split $text \n] {
if {$verbatim} then {
if {$line eq $endverbline} then {
set verbatim 0
} elseif {!$offlevel} then {
append stripped $line \n
}
} else {
switch -glob -- $line %%* {
if {!$offlevel} then {
append stripped $metaprefix\
[string range $line 2 end] \n
}
} %<<* {
set endverbline "%[string range $line 3 end]"
set verbatim 1
} %<* {
if {[regexp -- {^%<([*/+-]?)([^>]*)>(.*)$} $line ""\
modifier expression line]} then {
% \end{tcl}
% There is a well-formed guard line. First the expression is
% evaluated, by converting it to an |expr| expression.
% \begin{tcl}
regsub -all -- {\\|\{|\}|\$|\[|\]| |;} $expression\
{\\&} E
regsub -all -- {,} $E {|} E
regsub -all -- {[^()|&!]+} $E {[info exists O(&)]} E
set val [expr $E]
switch -exact -- $modifier * {
lappend block_stack $expression
if {$offlevel || !$val} then {incr offlevel}
} / {
if {![llength $block_stack]} then {
% \end{tcl}
% In this case there was no open block for this guard to end. That
% is a \describestring[error situation]{SPURIOUS}|SPURIOUS|
% \word{situation}.
% \begin{tcl}
if {$interaction} then {
error "Spurious end block </$expression>\
ignored." ""\
[list DOCSTRIP SPURIOUS $lineno]
} else {
puts stderr "docstrip: Spurious end\
block </$expression> ignored on line\
$lineno."
}
} else {
if {[string compare $expression\
[lindex $block_stack end]]} then {
% \end{tcl}
% In this case the expression of the block being closed does not match
% the expression on the block on top of the stack. That is a
% \describestring[error situation]{MISMATCH}|MISMATCH|
% \word{situation}. \textsc{docstrip} by default raises an error and
% recovers by treating this situation as a typo.
% \begin{tcl}
if {$interaction} then {
error "Found </$expression> instead of\
</[lindex $block_stack end]>." ""\
[list DOCSTRIP MISMATCH $lineno]
}
puts stderr "docstrip:\
Found </$expression> instead of\
</[lindex $block_stack end]> on line\
$lineno."
}
% \end{tcl}
% All that error processing makes it easy to lose track, but the
% following two lines are what does the real work for an end of block
% guard: pop a block off the stack and decrement the |offlevel|.
% \begin{tcl}
if {$offlevel} then {incr offlevel -1}
set block_stack [lreplace $block_stack end end]
}
} - {
if {!$offlevel && !$val} then {
append stripped $line \n
}
} default {
if {!$offlevel && $val} then {
append stripped $line \n
}
}
} else {
% \end{tcl}
% In this case the line looks like a guard line, but there is no |>|
% terminating the guard expression. This is a
% \describestring[error situation]{BADGUARD}|BADGUARD|
% \word{situation}.
% \begin{tcl}
if {$interaction} then {
error "Malformed guard on line $lineno." ""\
[list DOCSTRIP BADGUARD $lineno]
} else {
puts stderr "docstrip: Malformed guard\
on line $lineno:"
puts stderr $line
}
}
} %* {}\
% \end{tcl}
% With comment lines, nothing is done. A line being the exact string
% |\endinput| terminates the stripping.
% \begin{tcl}
{\\endinput} {
break
} default {
% \end{tcl}
% Other lines are code lines. These are included or not, depending on
% the |offlevel|.
% \begin{tcl}
if {!$offlevel} then {append stripped $line \n}
}
}
incr lineno
}
return $stripped
}
% \end{tcl}
% \end{proc}
%
%
% \begin{proc}{source}
% This procedure behaves as a docstripping |source| command: it reads
% a file, docstrips its contents in memory, and evaluates the result
% as a \Tcllogo\ script in the context of the caller. The syntax is
% \begin{quote}
% |dtx::source| \word{dtx-file} \word{options}
% \end{quote}
% where \word{dtx-file} is the file name and \word{options} is the
% list of options.
% \begin{tcl}
proc dtx::source {name options} {
set F [open $name r]
set text [read $F]
close $F
uplevel 1 [dtx::strip_string $text $options #]
}
%</pkg>
% \end{tcl}
% \end{proc}
%
%
\endinput
|
