%
% \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