Updated 2005-04-21 18:52:18 by suchenwi

if 0 {Richard Suchenwirth 2005-04-21 - Here's a little tool ("poor man's Doxygen") to produce TeX documentation from mildly marked-up Tcl source files (see itself for examples). The following markups are detected:
 if 0 {# block comment, can span multiple lines}
 ## description line, is associated with the following proc
 [email protected] 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.
 [email protected] 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.
 [email protected] fp   A file pointer open to read (stdin or an open file)
 [email protected] 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 "[email protected] *" $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.
 [email protected] name Name of the Tcl function
 [email protected] data List of: arguments, function description, parameter descriptions
 [email protected] _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
 [email protected] _procs Array name where seen proc definitions are stored
 [email protected] 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 $argv

if 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 }