can't read "argv0": no such variable
while executing
"file dirname $argv0"
(in namespace eval "::request" script line 20)
invoked from within
"namespace eval ::request $script"
("::try" body line 12)
OUTPUT BUFFER:
#!/usr/local/bin/tclsh
# $Id: tcldoc.tcl,v 1.2 2004/11/05 17:36:48 tang Exp $
#//#
# TclDoc parses the declarations and documentation comments in a set
# of Tcl source files and produces a corresponding set of HTML pages
# describing procedure declarations. Run TclDoc on a set of files
# and/or directories. It builds a rich internal representation of the
# files, determining both procedure declarations and procedure
# calls. TclDoc will run on .tcl and .tsh source files that are pure
# stub files with no procedure bodies. This means you can write
# documentation comments and run TclDoc in the earliest stages of
# design while creating the API, before writing the implementation.
#
# @author Jason Tang (tang@jtang.org)
# @version 1.0
# @see http://mini.net/tcl/TclDoc
#//#
source "[file join [file dirname $argv0] tcldoc_scanner.tcl]"
set TCLDOC_VERSION 0.3
######################################################################
# main TclDoc functions
# Initialize all of the various cross-reference tables used by TclDoc.
# If an import record was given then merge that record with these
# tables.
proc initialize_tables {} {
set ::all_files ""
foreach c { : 1 A B C D E F G H I J K L M N O P Q R S T U V W X Y Z } {
set ::toc_table($c) 0
}
}
# Creates the destination directory as necessary. Copy over the
# overview file (if --overview specified) and doc files
# (--doc-files) as necessary.
proc prepare_destination {} {
# create the destination directory if needed
print_status "Writing to directory $::dest_dir."
if [file exists $::dest_dir] {
if {![file isdir $::dest_dir]} {
tcldoc_error "Destination is not a directory." $::IO_ERROR
}
if {!$::force_overwrite} {
puts -nonewline "Warning: Destination already exists. Proceed? "
flush stdout
gets stdin in
if {![string equal -length 1 -nocase $in "y"]} {
exit
}
}
} elseif [catch {file mkdir $::dest_dir}] {
tcldoc_error "Could not create directory $::dest_dir." $::IO_ERROR
}
if {$::doc_dir != ""} {
print_status "Copying doc files..."
foreach doc $::doc_dir {
if {[file exists $doc] && [file isfile $doc]} {
# copy invidiual file
file copy -force -- $doc $::dest_dir
} elseif {[file exists $doc] && [file isdirectory $doc]} {
# copy entire directory
set doc_dest_dir [file join $::dest_dir [file tail $doc]]
if {![file exists $doc_dest_dir]} {
if [catch {file mkdir $doc_dest_dir}] {
tcldoc_error "Could not create $doc_dest_dir for doc-files." $::IO_ERROR
}
}
foreach doc_file [glob -directory $doc *] {
file copy -force -- $doc_file $doc_dest_dir
}
} else {
tcldoc_error puts stderr "Invalid doc-files file or directory $doc." $::IO_ERROR
}
}
}
if {$::overview_file != ""} {
print_status "Copying overview file..."
if {[file exists $::overview_file] && [file isfile $::overview_file]} {
if [catch {file copy -force $::overview_file $::dest_dir}] {
tcldoc_error "Could not copy overview file $::overview_file." $::IO_ERROR
}
} else {
tcldoc_error "Invalid overview file: $::overview_file." $::IO_ERROR
}
}
}
proc write_export_file {} {
}
######################################################################
# functions affecting individual files
# Scans a file for all instances of lines beginning with
# proc indicating a procedure declaration. Add
# discovered declarations to the procedure table along with its line
# number in the file.
#
# @param filename file to scan for procedure declarations
proc declaration_scan {filename} {
set basename [file tail $filename]
set newhtmlname "${basename}.html"
print_status "Scanning $filename:"
if [catch {open $filename r} src] {
puts stderr " Unable to open $filename -- skipping."
break
}
set ::current_file $filename
set ::line_number 0
while {[gets $src line] >= 0} {
incr ::line_number
if [regexp {\A\s*proc\s+([^\s\{]+)} $line foo procname] {
# add the procedure and line number to the file index
lappend ::file_table($basename) [list $procname $::line_number]
# add the filename and line number to the procedure index
lappend ::proc_table($procname) [list $basename $::line_number]
print_status " $procname"
}
}
close $src
}
# Take a single source Tcl file and scan it intensively, generating
# its HTML version. Identify comment blocks and highlight them in the
# HTML version. If the comment is a procedure-level or file-level
# comment then pipe it through the scanner for annotation purposes.
# Identify procedure declarations, add <a name> anchors and add
# their parameters to the function table. Identify procedure calls
# and add <a href> hypertext. Substitute proper html codes for
# special symbols <, >, &, and ". Write the HTML marked version
# as well as the annotations.
#
# @param filename file to scan
# @see scan_recursively
proc deep_scan {filename} {
set basename [file tail $filename]
set htmlname "${basename}.html"
set annothtmlname "${basename}-annot.html"
set txtname "${basename}.txt"
print_status "Building $htmlname..."
# figure out my "docroot" path
# *** FIX ME ***: until the notion of 'packages' is added
# here, docroot will be set to nothing
set docroot "."
# read the entire source file into memory
if [catch {open $filename r} src] {
print_status " Unable to open source file -- skipping."
return
}
set srcbuf [read $src]
close $src
# start writing HTML version
if [catch {open [file join $::dest_dir $htmlname] w} dest] {
print_status " Unable to create destination file -- skipping."
return
}
write_header $dest $basename $basename
puts $dest "$basename
\(annotations | original source\)
"
# start writing the annotated file
if [catch {open [file join $::dest_dir $annothtmlname] w} annot] {
print_status " Unable to create annotation file -- skipping."
close $dest
return
}
write_header $annot $basename "$basename annotations"
puts $annot "$basename Annotations
"
if {!$::hide_paths} {
puts $annot "Created from [sanitize [file nativename $filename]]"
}
puts $annot "
"
new_annotation $annot $basename $annothtmlname $docroot
set ::current_file $filename
set ::line_number 1
scan_recursively $dest $srcbuf $basename $annothtmlname
# add this file to the summary table
if $::hide_paths {
set sourceloc ""
} else {
set sourceloc "[file nativename [file dirname $filename]]"
}
add_summary $basename \
$annothtmlname "" $sourceloc $::annotfile(file_summary) file
puts $dest ""
write_footer $dest
close $dest
write_annotation
write_footer $annot
close $annot
}
# Given a buffer of Tcl code recursively examine each command within.
# Commands follow normal Tcl syntax -- they are either terminated by
# newlines or semicolons. If a single command has multiple parts
# (such as an if statement) recursively examine each
# subpart. In this way discover comment blocks, procedure
# declarations, and procedure calls.
#
# There are limits to this scanner because it only does static
# analysis. Mainly, things that make Tcl such a dynamic language
# (such as eval and subst commands) may
# potentially confuse this scanner.
#
# @param buffer buffer of Tcl code to examine
# @param basename source file from which this Tcl code originated
# @param dest I/O channel to write HTML-ized version of the buffer
proc scan_recursively {dest buffer basename annotname} {
set comment_block ""
while {$buffer != ""} {
set output ""
set line_complete 0
set line ""
# consume whitespace
if [regexp -- {\A(\s+)(.*)} $buffer foo match buffer] {
append output $match
# file and procedure annoations must be contiguous; if
# there are any newlines between then stop the block
if {[string first "\n" $match] >= 0} {
set comment_block ""
}
}
# grab the next "command" from the src buffer
while {!$line_complete && $buffer != ""} {
if [regexp -- {\A([^;\n]+)(.*)} $buffer foo l buffer] {
append line $l
}
# there are two special cases: the original line began
# with a hash, in which I should consume the rest of the
# line, or if $l ended with a backslash
if {[string index $line 0] == "\#"} {
# note how this will consume semicolons within the
# comment
regexp -- {\A([^\n]*)(.*)} $buffer foo l buffer
append line $l
set line_complete 1
} elseif {![info complete $line] || [string index $line end] == "\\"} {
append line [string index $buffer 0]
set buffer [string range $buffer 1 end]
} else {
set line_complete 1
}
}
# apparantly Tcl allows trailing bare backslashes, so make a
# special check here
if {[string index [string trimright $line] end] == "\\" && \
[string length $buffer] == 0} {
set line_complete 1
}
if {!$line_complete && $output == ""} {
tcldoc_file_warning "Source does not appear to be valid Tcl code, skipping"
write_and_update $dest $line
continue
}
# analyze this "line" for comments, procedure declarations,
# and procedure calls
if {[string index $line 0] == "\#"} {
append output "[sanitize $line]"
append comment_block [string range $line 1 end]
# check to see if this is a file-level comment
if [regexp -- {\A\/\/\#.*\/\/\#\Z} [string trim $comment_block]] {
add_file_annotation \
[string range [string trim $comment_block] 3 end-3]
set comment_block ""
} else {
append comment_block "\n"
}
set line ""
} elseif {[regexp -- {\A(proc\s+)(\S+)(.*)} $line foo decl procname line]} {
# using $::line_number below may lead to incorrect numbers
# because $output may have newlines buffered within. thus
# first flush $output (and hence increment ::line_number).
write_and_update $dest $output
set output "$decl$procname"
# additionally, if this is the /last/ declaration for the
# function add a normal anchor
set procrecord [lookup_procrecord $procname $basename]
if {[lindex $procrecord 1] == $::line_number} {
append output ""
}
if [catch {set proc_args [flatten_args [lindex $line 0]]}] {
tcldoc_file_warning "Malformed syntax for procedure arguments, skipping"
} else {
add_proc_annotation [string trim $comment_block] $procname \
$proc_args $::line_number
}
set comment_block ""
} elseif {[regexp -- {\A([:A-Za-z_]\S*)(.*)} $line foo decl line]} {
# check to see if line is a call to a previously declared
# procedure
set procrecord [lookup_procrecord $decl $basename]
if {$procrecord != {}} {
foreach {procdest procline} $procrecord {}
set procdest \
"[file join [path_lookup $procdest] $procdest].html"
set procid ${decl}_${procline}
# add to the procedure call table this call
set callcount 1
if [info exists ::call_table($decl)] {
foreach call $::call_table($decl) {
if {[string match "$basename*" $call]} {
incr callcount
}
}
}
lappend ::call_table($decl) "${basename}($callcount)"
append output "$decl"
} else {
# not a known command
append output $decl
}
set comment_block ""
} else {
set comment_block ""
}
write_and_update $dest $output
# the rest of the line may have more info, so recurse upon any
# part which appears to be a sublist or a subcommand. for
# everything else write it to the destination
while {$line != ""} {
set c [string index $line 0]
if {$c == "\{" || $c == "\["} {
# find the matching brace/bracket
set found_matching 0
set subgroup "$c"
set line [string range $line 1 end]
while {!$found_matching && $line != ""} {
if [regexp -- {\A([^\}\]]*[\}\]])(.*)} $line foo s line] {
append subgroup $s
} else {
break
}
set found_matching [info complete $subgroup]
}
if $found_matching {
puts -nonewline $dest [string index $subgroup 0]
scan_recursively $dest [string range $subgroup 1 end-1] $basename $annotname
puts -nonewline $dest [string index $subgroup end]
} else {
tcldoc_file_error "Unmatched $c"
}
} elseif [regexp -- {\A((\\.|[^\[\{])+)(.*)} $line foo match foo2 line] {
write_and_update $dest [sanitize $match]
}
}
# consume the next character from the buffer
write_and_update $dest [string index $buffer 0]
set buffer [string range $buffer 1 end]
}
}
# Writes to channel $dest the contents of
# $output. Updates the global ::line_number
# to keep track of how many lines have been written; hopefully this
# number is the same as the lines read from the source file.
#
# @param dest channel to write $output
# @param output data to write
proc write_and_update {dest output} {
# write to the destination file and update the line counter
if {$output != ""} {
puts -nonewline $dest $output
incr ::line_number -1
foreach x [split $output "\n"] {
incr ::line_number
}
}
}
# Given a procedure name, look up within the procedure table for its
# declaration. In case of ambiguity as to which function declaration
# to use prefer to use the last one declared within $basename.
# Otherwise just use the first one listed (and hope for the best!).
# Returns a two element list containing the Tcl source filename and
# line number where procedure was declared. If the procedure is not
# declared at all return an empty list.
#
# @param procname procedure name to look up
# @param basename preferred file to use
# @return if entry found a 2-ple procedure record, else an empty list
proc lookup_procrecord {procname basename} {
set procrecord ""
if [info exists ::proc_table($procname)] {
foreach pr $::proc_table($procname) {
if {[lindex $pr 0] == $basename} {
set procrecord $pr
}
}
if {$procrecord == ""} {
set procrecord [lindex $::proc_table($procname) 0]
}
}
return $procrecord
}
# Given some text, replaces potentially dangerous characters with
# their HTML character code. Returns the new string afterwards.
#
# @param s string to sanitize
# @return an HTML-friendly version of $s
proc sanitize {s} {
regsub -all {\&} $s {\&} s
regsub -all {\<} $s {\<} s
regsub -all {\>} $s {\>} s
regsub -all {\"} $s {\"} s
return $s
}
# Outputs a common header for HTML-ized Tcl files.
#
# @param dest I/O channel to write HTML header
# @param basename Tcl source filename, sans any directory paths
# @param title HTML title to use for generated file
proc write_header {dest basename title} {
puts $dest "
$title
"
if {$::header != ""} {
puts $dest "$::header\n
"
}
if {!$::hide_navbar} {
puts $dest ""
if {$::overview_file != ""} {
puts -nonewline $dest "Overview | "
}
puts $dest "Index by: file name |
procedure name |
procedure call |
annotation
"
}
}
# Output a common header for HTML-ized Tcl files. This same footer is
# also used for index_main.html.
#
# @param dest I/O channel to write HTML footer
proc write_footer {dest} {
if {!$::hide_navbar} {
puts $dest "
\n"
if {$::overview_file != ""} {
puts -nonewline $dest "Overview | "
}
puts $dest "Index by: file name |
procedure name |
procedure call |
annotation
File generated $::date.
"
}
if {$::footer != ""} {
puts $dest "
\n$::footer"
}
puts $dest "\n"
}
######################################################################
# functions used when writing the index files
# Write the index of filenames. Alphabetically list all source files
# along with procedures declared within. Add hyperlinks from those
# procedure names to the line where they are declared. Also write to
# the main index a similar list.
#
# @param mainindex I/O channel of index_main.html
proc write_index_byfile {mainindex} {
print_status " building index by file name"
set fileindexname [file join $::dest_dir "index_file.html"]
if [catch {open $fileindexname w} fileindex] {
tcldoc_error " Unable to create index_file.html" $::IO_ERROR
}
write_index_header $fileindex $::dest_dir \
"file name |
procedure name |
procedure call |
annotation" "file name"
# iterate through all files. add an entry along with all
# functions declared within that file.
foreach filename $::all_files {
set basename [file tail $filename]
set dir [path_lookup $basename]
set htmlname "[file join $dir $basename].html"
set txtname "[file join $dir $basename].txt"
set annothtmlname "[file join $dir $basename]-annot.html"
puts $mainindex "
$source"
}
} else {
puts $annotfullindex "$source"
}
puts $annotfullindex "--overview) then have
# the index load the overview; otherwise just load index_main.html.
proc write_index_master {} {
print_status "Building index.html..."
set indexname [file join $::dest_dir "index.html"]
if [catch {open $indexname w} index] {
tcldoc_error " Unable to create index.html." $::IO_ERROR
}
puts $index "
Index by: line
# @param page_header an optional title to put at the top of the page
proc write_index_header {dest page_title index_line {page_header ""}} {
puts $dest "
*.tcl) to search
# @return list of matching files
proc glob_all {dir exts} {
set all_files [glob -nocomplain -directory $dir *]
set retval ""
foreach ext $exts {
set foundfiles [glob -nocomplain -directory $dir $ext]
foreach file $foundfiles {
if {[file isfile $file] && [file readable $file]} {
lappend retval $file
}
}
}
foreach file $all_files {
if [file isdirectory $file] {
set retval [concat $retval [glob_all [file join $dir $file] $exts]]
}
}
return $retval
}
# Compares the last part of a filename (i.e., sans directory paths).
# Returns-1, 0, 1 if respectively $a occurs lexically
# before, with, or after $b.
#
# @param a first file to compare
# @param b second file to compare
# @return -1, 0, or 1
proc filecomp {a b} {
return [string compare -nocase [file tail $a] [file tail $b]]
}
# Given a filename returns the location of where its TclDoc'ed files
# are located. The path may not necessarily be the same as
# $::dest_dir, especially if the file is being imported
# from elsewhere by way of --import.
#
# @param orig_file filename to find
# @return path to where TclDoc wrote its file
proc path_lookup {orig_file} {
if [info exists ::path_table($orig_file)] {
return $::path_table($orig_file);
} else {
return "."
}
}
######################################################################
# miscellaneous TclDoc utilities
# If running in verbose mode print to standard output its arguments.
# Otherwise do nothing.
#
# @param args any valid string suitable to be passed to puts
proc print_status {args} {
if $::verbose {
eval puts $args
}
}
# Given an arbitrary length list (such as the one supplying arguments
# to a procedure declaration) remove excess spaces between arguments.
# This is very similar to Lisp's flatten function.
#
# @param x list to flatten
# @return a flattend list
proc flatten_args {x} {
if {![info complete $x]} {
tcldoc_error "ERROR: Attempting to flatten $x"
}
set new_list ""
foreach elem $x {
if {[llength $elem] > 1} {
lappend new_list [flatten_args $elem]
} else {
lappend new_list $elem
}
}
return $new_list
}
# Adds an entry to the global summary table. The entry will
# eventually be written to the global summary indices.
#
# @param entry brief entry name
# @param target for file entries the HTML version of the file; for
# procedures the file containing its declaration
# @param arguments for procedures a list or arguments to it; ignored
# for files
# @param source source Tcl file for the entry
# @param description a one line summary describing the entry
# @param type type of entry; currently just file and
# proc are understood.
# @see write_index_annotations
proc add_summary {entry target arguments source description type} {
lappend ::summary_table($entry) \
[list $target $arguments $source $description $type]
set firstchar [string toupper [string index $entry 0]]
if {$firstchar == ":"} {
incr ::toc_table(:)
} elseif {[string compare $firstchar "A"] < 0} {
incr ::toc_table(1)
} elseif {[string compare $firstchar "Z"] > 0} {
incr ::toc_table(Z)
} else {
incr ::toc_table($firstchar)
}
}
# Called whenever TclDoc found a problem with a file, particularly
# something that it could not parse. Print to standard error the
# message along with the source file and line number if verbose
# reporting was enabled.
#
# @param message message to display
proc tcldoc_file_warning {message} {
if $::verbose {
puts stderr "$message (file $::current_file, line $::line_number)"
}
}
# Called to abort whenever TclDoc discovers a problem with a
# particular input file. Print to standard error the message along
# with the source file and line number where that error occured.
# Finally abort program.
#
# @param message message to display
proc tcldoc_file_error {message} {
puts stderr "$message (file $::current_file, line $::line_number)"
exit $::SYNTAX_ERROR
}
# Called to abort TclDoc upon all other errors. Print to standard
# error the error message then abort TclDoc.
#
# @param message message to display
# @param returnvalue exit code
proc tcldoc_error {message {returnvalue -1}} {
puts stderr $message
exit $returnvalue
}
# Retrives a parameter from the options list. If no parameter exists
# then abort with an error very reminisicent of C's
# getopt function; otherwise increment
# param_num by one.
#
# @param param_list list of parameters from the command line
# @param param_num index into param_list to retrieve
# @param param_name name of the parameter, used when reporting an error
# @return the $param_num'th element into $param_list
proc get_param {param_list param_num param_name} {
upvar $param_num pn
incr pn
if {$pn >= [llength $param_list]} {
tcldoc_error "TclDoc: option requires an argument -- $param_name" $::PARAM_ERROR
}
return [lindex $param_list $pn]
}
# Print TclDoc's usage to a channel.
#
# @param chan I/O channel to print usage documentation
proc print_tcldoc_help {chan} {
puts $chan "TclDoc: a Tcl API Documentation Generator
Usage: TclDoc \[options\] DESTDIR SRC \[SRC...\]
DESTDIR direction to which write generated files
SRC Tcl source code file to parse
General Options:
-h, --help print this help message and quit
-v, --verbose be verbose while generating files
-f, --force don't prompt before overwriting files in DESTDIR
--version show TclDoc version and quit
-- marks end of options
Overall File Generation Options:
--overview FILE use FILE as an overview page
--doc-files NAME copy NAME (file or directory) verbatim to DESTDIR\[*\]
--dont-copy don't copy original source files to DESTDIR
Individual File Generation Options:
--title TITLE use TITLE for the main index.html page
--header HTML use HTML text in the header
--footer HTML use HTML text in the footer
--hide-paths prevent showing path names on annotated pages
--no-navbar disable navigation bar at top and bottom of pages
--date FORMAT write time stamp using FORMAT \(see \[clock format\]\)
--comment COLOR hex COLOR for comments \(default \"208020\"\)
--page-bg COLOR hex COLOR for page backgrounds \(default \"ffffff\"\)
--table-bg COLOR hex COLOR for table annotations \(default \"ccccff\"\)
Import/Export Options: \(not implemented yet\)
--import FILE \[*\]
--include FILE \[*\]
--export FILE
--export-loc NEWDIR
\[*\] Multiple invocations of this option allowed."
}
######################################################################
# other TclDoc functions
# Parse the command line and set global options.
#
# @param argv list of options from the command line
proc tcldoc_args {argv} {
set argvp 0
set ::verbose 0
set ::force_overwrite 0
set ::overview_file ""
set ::dont_copy_files 0
set ::doc_dir ""
set ::title "TclDoc Documentation"
set ::header ""
set ::footer ""
set ::hide_paths 0
set ::hide_navbar 0
set ::import_file ""
set ::export_file ""
set ::export_dir ""
set date_format "%Y-%m-%d at %H:%M"
set ::comment_color "\#208020"; # a pale green color
set ::page_bg_color "\#ffffff"; # pearly white
set ::table_bg_color "\#ccccff"; # pale blue
while {$argvp < [llength $argv]} {
set arg [lindex $argv $argvp]
switch -- $arg {
"-h" - "--help" { print_tcldoc_help stdout; exit }
"-v" - "--verbose" { set ::verbose 1}
"-f" - "--force" { set ::force_overwrite 1 }
"--version" { puts "TclDoc version $::TCLDOC_VERSION"; exit }
"--overview" {
set ::overview_file [get_param $argv argvp "overview"]
}
"--doc-files" { lappend ::doc_dir [get_param $argv argvp "doc-files"] }
"--dont-copy" { set ::dont_copy_files 1 }
"--title" { set ::title [get_param $argv argvp "title"] }
"--header" { set ::header [get_param $argv argvp "header"] }
"--footer" { set ::footer [get_param $argv argvp "footer"] }
"--hide-paths" { set ::hide_paths 1 }
"--no-navbar" { set ::hide_navbar 1 }
"--date" { set date_format [get_param $argv argvp "date"] }
"--comment" {
set ::comment_color "\#[get_param $argv argvp "comment"]"
}
"--page-bg" {
set ::page_bg_color "\#[get_param $argv argvp "page-bg"]"
}
"--table-bg" {
set ::table_bg_color "\#[get_param $argv argvp "table-bg"]"
}
"--import" { set ::import_file [get_param $argv argvp "import"] }
"--export" { set ::export_file [get_param $argv argvp "export"] }
"--export-loc" {
set ::export_dir [get_param $argv argvp "export-loc"]
}
"--" { incr argvp; break }
default {
if {[string index $arg 0] != "-"} {
break
} else {
puts stderr "TclDoc: unknown option $arg"
print_tcldoc_help stderr
exit $::PARAM_ERROR
}
}
}
incr argvp
}
if {$argvp + 2 > [llength $argv]} {
puts stderr "Must specify a destination directory and at least one source file."
print_tcldoc_help stderr
exit $::PARAM_ERROR
}
set ::date [clock format [clock seconds] -format $date_format]
set ::dest_dir [lindex $argv $argvp]
set ::srcs [lrange $argv [expr {$argvp + 1}] end]
if {$::export_dir != ""} {
set ::export_dir [file join [pwd] $::dest_dir]
}
}
# Actually run TclDoc across requested files and directories. Scan
# them and generate HTML markup versions. Scan file and procedure
# comments to build the annotated files. Cross-reference procedure
# calls with the declarations. Finally write indices to everything.
proc tcldoc_main {} {
# first build a list of all tcl scripts which are defined as
# those with filenames *.tcl or *.tsh
set ::todo_files ""
foreach src $::srcs {
if [file isfile $src] {
lappend ::todo_files $src
} else {
foreach srcf [glob_all $src {*.tcl *.tsh}] {
lappend ::todo_files $srcf
}
}
}
set ::todo_files [lsort -ascii -command filecomp $::todo_files]
set ::all_files [lsort -ascii -command filecomp [concat $::all_files $::todo_files]]
# open each file and scan for procedure declarations
foreach filename $::todo_files {
declaration_scan $filename
}
# rescan each file, this time identifying procedure calls and
# other markups. write both its HTML version and its annotated
# version.
foreach filename $::todo_files {
deep_scan $filename
set basename [file tail $filename]
set newtxtname "[file join [path_lookup $basename] $basename].txt"
if {!$::dont_copy_files} {
file copy -force $filename [file join $::dest_dir $newtxtname]
}
}
# begin constructing the main index page, which is the combination
# of all three major indices (by file name, by procedure name, by
# procedure call) group onto a single page.
print_status "Building index_main.html..."
set mainindexname [file join $::dest_dir "index_main.html"]
if [catch {open $mainindexname w} mainindex] {
tcldoc_error " Unable to create index_main.html." $::IO_ERROR
}
write_index_header $mainindex $::dest_dir \
"file name |
procedure name |
procedure call |
annotation"
puts $mainindex "