summaryrefslogtreecommitdiff
path: root/macros/latex/contrib/tclldoc/tools/sourcedtx.dtx
diff options
context:
space:
mode:
Diffstat (limited to 'macros/latex/contrib/tclldoc/tools/sourcedtx.dtx')
-rw-r--r--macros/latex/contrib/tclldoc/tools/sourcedtx.dtx234
1 files changed, 234 insertions, 0 deletions
diff --git a/macros/latex/contrib/tclldoc/tools/sourcedtx.dtx b/macros/latex/contrib/tclldoc/tools/sourcedtx.dtx
new file mode 100644
index 0000000000..3b024427ab
--- /dev/null
+++ b/macros/latex/contrib/tclldoc/tools/sourcedtx.dtx
@@ -0,0 +1,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
+
+ \ No newline at end of file