if 0 {# block comment, can span multiple lines}
## description line, is associated with the following proc
##@param name description of a parameter to the following proc
proc name ...The feature I like best is the cross-reference xref, which adds to a proc's description which other procs it calls, and by which other procs (inside the examined file) it is called. For testing, remove the leading blank I had to add to proc and # lines so they come in code style. Example of the produced output:tcl2tex fp ?name?The worker function that operates on one file pointer, called one or more times. Returns nothing.Calls: tex_escape,tex_render.Called by: main.Parameters:fp A file pointer open to read (stdin or an open file)name The name of the file. Optional, defaults to {}. }
if 0 {# tcl2tex.tcl -- extract TeX documentation from a Tcl source file.
Given one or more Tcl source file, this script extracts special comments
of the form ##..., or "if 0 {#...}" for multi-line comments, and produces
LATeX source code on stdout.
}
## The main function of this script.
## Returns nothing.
##@param argv List of the arguments on the command line
proc main argv {
if [llength $argv] {
foreach file $argv {
set fp [open $file]
tcl2tex $fp $file
close $fp
}
} else {tcl2tex stdin}
}
## The worker function that operates on one file pointer, called one or more times.
## Returns nothing.
##@param fp A file pointer open to read (stdin or an open file)
##@param name The name of the file.
proc tcl2tex {fp {name {}}} {
set mode ""
set params {}
puts "\\subsection{Commands provided by [tex_escape [file tail $name]]}"
while {[gets $fp line] >= 0} {
if {$mode eq "block"} {
append block \n$line
if [info complete $block] {
set mode ""
puts [tex_escape [string range $block 7 end-1]]\\\\\n
set block ""
}
} elseif {$mode eq "proc"} {
append proc \n$line
if [info complete $proc] {
set mode ""
set procs($name) $proc
set proc ""
}
} elseif [string match "if 0 \{#*" $line] {
set mode block
set block $line
} elseif [string match "## *" $line] {
append comment [string range $line 2 end]
} elseif [string match "##@param *" $line] {
lappend params [string range $line 9 end]
} elseif [string match "proc *" $line] {
foreach {- name arguments} [string trimright $line \{] break
set a($name) [list $arguments $comment $params]
set comment ""
set params ""
set mode proc
set proc $line
}
}
#-- loop over commands in alphabetic order
foreach name [lsort [array names a]] {
tex_render $name $a($name) procs
}
array unset default
}
## Output a function documentation to stdout.
##@param name Name of the Tcl function
##@param data List of: arguments, function description, parameter descriptions
##@param _procs Array name where seen proc definitions are stored
proc tex_render {name data _procs} {
upvar 1 $_procs procs
foreach {arguments comment params} $data break
append comment [xref procs $name]
set args {}
foreach arg $arguments {
if {[llength $arg]==2} {
set default([lindex $arg 0]) [lindex $arg 1]
set arg ?[lindex $arg 0]?
}
lappend args $arg
}
set name [tex_escape $name]
set args [tex_escape $args]
puts "\\rule{16.3cm}{0.1mm}\\\\"
puts "\\texttt{\\textbf{$name} \\textit{$args}}\\newline"
puts -nonewline [tex_escape $comment]
if [llength $params] {
puts "\\begin{tabbing}"
puts "\\textbf{Parameters:}\\=\\\\"
foreach param $params {
regexp {([^ ]+) +(.+)} $param -> name text
if [info exists default($name)] {
append text " Optional, defaults to [list $default($name)]."
}
puts "\\textit{[tex_escape $name]}\\>[tex_escape $text]\\\\"
}
puts "\\end{tabbing}"
} else {puts "\\bigskip"}
puts ""
}
## Escapes characters special to TeX: underscore _, braces {},
## pound sign(#), by prefixing a backslash.
## Returns the escaped string.
proc tex_escape string {
string map {_ \\_ \{ \\\{ \} \\\} # \\# $ \\$ & \\& % \\%} $string
}
## Creates a cross reference of what functions are mentioned in which
## function bodies
##@param _procs Array name where seen proc definitions are stored
##@param name Name of the Tcl function
proc xref {_procs name} {
upvar 1 $_procs procs
set calls {}
set called {}
foreach i [lsort [array names procs]] {
if {$i eq $name} continue
if {[string first $i $procs($name)]>=0} {lappend calls $i}
if {[string first $name $procs($i)]>=0} {lappend called $i}
}
set res ""
if [llength $calls] {append res "\n\nCalls: [join $calls ,]."}
if [llength $called] {append res "\n\nCalled by: [join $called ,]."}
set res
}
main $argvif 0 {Lars H: That tex_escape procedure leads me to believe that this hasn't been tested much. You don't escape $, %, &, or \ itself (now, the backslash is indeed tricky to escape)!?! Other unsafe characters include ", <, >, ~, and ^. - RS: As only dedicated comments and proc lines are extracted, no special characters have shown up with problems yet... But % and & may of course occur in comments. Thanks, updated :)
Category Documentation | Arts and crafts of Tcl-Tk programming }
