Overview | Index by: file name | procedure name | procedure call | annotation
tcldoc_scanner.tcl (annotations | original source)

# $Id: tcldoc_scanner.fcl,v 1.2 2004/11/05 17:36:48 tang Exp $

#//#
# Handles scanning of file-level and procedure-level comments.
# Identifies the various tags (<code>@author</code>,
# <code>@return</code>, etc) and formats them suitably for the file's
# annotation page.  Also identifies one-line summary for the item and
# adds it to the global summary table.  This file is parsed by {@link
# http://mini.net/tcl/fickle fickle} to create the actual scanner.
#
# @author Jason Tang (tang@jtang.org)
# @version 1.0
#//#

######
# Begin autogenerated fickle (version 2.01) routines.
# Although fickle itself is protected by the GNU Public License (GPL)
# all user-supplied functions are protected by their respective
# author's license.  See http://mini.net/tcl/fickle for other details.
######

# If yywrap() returns false (zero), then it is assumed that the
# function has gone ahead and set up yyin to point to another input
# file, and scanning continues.  If it returns true (non-zero), then
# the scanner terminates, returning 0 to its caller.  Note that in
# either case, the start condition remains unchanged; it does not
# revert to INITIAL.
#   -- from the flex(1) man page
proc yywrap {} {
    return 1
}

# ECHO copies yytext to the scanner's output if no arguments are
# given.  The scanner writes its ECHO output to the yyout global
# (default, stdout), which may be redefined by the user simply by
# assigning it to some other channel.
#   -- from the flex(1) man page
proc ECHO {{s ""}} {
    if {$s == ""} {
        puts -nonewline $::yyout $::yytext
    } else {
        puts -nonewline $::yyout $s
    }
}

# YY_FLUSH_BUFFER flushes the scanner's internal buffer so that the
# next time the scanner attempts to match a token, it will first
# refill the buffer using YY_INPUT.
#   -- from the flex(1) man page
proc YY_FLUSH_BUFFER {} {
    set ::yy_buffer ""
    set ::yy_index 0
    set ::yy_done 0
}

# yyrestart(new_file) may be called to point yyin at the new input
# file.  The switch-over to the new file is immediate (any previously
# buffered-up input is lost).  Note that calling yyrestart with yyin
# as an argument thus throws away the current input buffer and
# continues scanning the same input file.
#   -- from the flex(1) man page
proc yyrestart {new_file} {
    set yyin $new_file
    YY_FLUSH_BUFFER
}

# The nature of how it gets its input can be controlled by defining
# the YY_INPUT macro.  YY_INPUT's calling sequence is
# "YY_INPUT(buf,result,max_size)".  Its action is to place up to
# max_size characters in the character array buf and return in the
# integer variable result either the number of characters read or the
# constant YY_NULL (0 on Unix systems) to indicate EOF.  The default
# YY_INPUT reads from the global file-pointer "yyin".
#   -- from the flex(1) man page
proc YY_INPUT {buf result max_size} {
    upvar $result ret_val
    upvar $buf new_data
    if {$::yyin != ""} {
        set new_data [read $::yyin $max_size]
        set ret_val [string length $new_data]
    } else {
        set new_data ""
        set ret_val 0
    }
}

# yy_scan_string sets up input buffers for scanning in-memory
# strings instead of files.  Note that switching input sources does
# not change the start condition.
#   -- from the flex(1) man page
proc yy_scan_string {str} {
    append ::yy_buffer $str
    set ::yyin ""
}

# unput(c) puts the character c back onto the input stream.  It will
# be the next character scanned.  The following action will take the
# current token and cause it to be rescanned enclosed in parentheses.
#   -- from the flex(1) man page
proc unput {c} {
    set s [string range $::yy_buffer 0 [expr {$::yy_index - 1}]]
    append s $c
    set ::yy_buffer [append s [string range $::yy_buffer $::yy_index end]]
}

# Returns all but the first n characters of the current token back to
# the input stream, where they will be rescanned when the scanner
# looks for the next match.  yytext and yyleng are adjusted
# appropriately.
#   -- from the flex(1) man page
proc yyless {n} {
    set s [string range $::yy_buffer 0 [expr {$::yy_index - 1}]]
    append s [string range $::yytext $n end]
    set ::yy_buffer [append s [string range $::yy_buffer $::yy_index end]]
    set ::yytext [string range 0 [expr {$n - 1}]]
    set ::yyleng [string length $::yytext]
}

# input() reads the next character from the input stream.
#   -- from the flex(1) man page
proc input {} {
    if {[string length $::yy_buffer] - $::yy_index < 1024} {
       set new_buffer_size 0
       if {$::yy_done == 0} {
           YY_INPUT new_buffer new_buffer_size 1024
           append ::yy_buffer $new_buffer
           if {$new_buffer_size == 0} {
               set ::yy_done 1
           }
       }
       if $::yy_done {
           if {[yywrap] == 0} {
               return [input]
           } elseif {[string length $::yy_buffer] - $::yy_index == 0} {
               return {}
           }
        }
    }
    set c [string index $::yy_buffer $::yy_index]
    incr ::yy_index
    return $c
}

# Pushes the current start condition onto the top of the start
# condition stack and switches to new_state as though you had used
# BEGIN new_state.
#   -- from the flex(1) man page
proc yy_push_state {new_state} {
    lappend ::yy_state_stack $new_state
}

# Pops off the top of the state stack; if the stack is now empty, then
# pushes the state "INITIAL".
#   -- from the flex(1) man page
proc yy_pop_state {} {
    set ::yy_state_stack [lrange $::yy_state_stack 0 end-1]
    if {$::yy_state_stack == ""} {
        yy_push_state INITIAL
    }
}

# Returns the top of the stack without altering the stack's contents.
#   -- from the flex(1) man page
proc yy_top_state {} {
    return [lindex $::yy_state_stack end]
}

# BEGIN followed by the name of a start condition places the scanner
# in the corresponding start condition. . . .Until the next BEGIN
# action is executed, rules with the given start condition will be
# active and rules with other start conditions will be inactive.  If
# the start condition is inclusive, then rules with no start
# conditions at all will also be active.  If it is exclusive, then
# only rules qualified with the start condition will be active.
#   -- from the flex(1) man page
proc BEGIN {new_state {prefix yy}} {
    eval set ::${prefix}_state_stack [lrange \$::${prefix}_state_stack 0 end-1]
    eval lappend ::${prefix}_state_stack $new_state
}

# initialize values used by the lexer
set ::yy_buffer {}
set ::yy_index 0
set ::yytext {}
set ::yyleng 0
set ::yy_done 0
set ::yy_state_stack {}
BEGIN INITIAL
array set ::yy_state_table {SEE_L 0 SEE_A 0 LINK 0 INITIAL 1 SEE_S 0}
if {![info exists ::yyin]} {
    set ::yyin "stdin"
}
if {![info exists ::yyout]} {
    set ::yyout "stdout"
}

######
# autogenerated yylex function created by fickle
######

# Whenever yylex() is called, it scans tokens from the global input
# file yyin (which defaults to stdin).  It continues until it either
# reaches an end-of-file (at which point it returns the value 0) or
# one of its actions executes a return statement.
#   -- from the flex(1) man page
proc yylex {} {
    upvar #0 ::yytext yytext
    upvar #0 ::yyleng yyleng
    while {1} {
        set yy_current_state [yy_top_state]
        if {[string length $::yy_buffer] - $::yy_index < 1024} {
            if {$::yy_done == 0} {
                set yynew_buffer ""
                YY_INPUT yynew_buffer yy_buffer_size 1024
                append ::yy_buffer $yynew_buffer
                if {$yy_buffer_size == 0 && \
                        [string length $::yy_buffer] - $::yy_index == 0} {
                    set ::yy_done 1
                }
            }
            if $::yy_done {
                if {[yywrap] == 0} {
                    set ::yy_done 0
                    continue
                } elseif {[string length $::yy_buffer] - $::yy_index == 0} {
                    break
                }
            }            
        }
        set ::yyleng 0
        set yy_matched_rule -1
        # rule 0: @author\s+
        if {$::yy_state_table($yy_current_state) && \
                [regexp -start $::yy_index -indices -line  -- {\A(@author\s+)} $::yy_buffer yy_match] > 0 && \
                [lindex $yy_match 1] - $::yy_index + 1 > $::yyleng} {
            set ::yytext [string range $::yy_buffer $::yy_index [lindex $yy_match 1]]
            set ::yyleng [string length $::yytext]
            set yy_matched_rule 0
        }
        # rule 1: @deprecated\s+
        if {$::yy_state_table($yy_current_state) && \
                [regexp -start $::yy_index -indices -line  -- {\A(@deprecated\s+)} $::yy_buffer yy_match] > 0 && \
                [lindex $yy_match 1] - $::yy_index + 1 > $::yyleng} {
            set ::yytext [string range $::yy_buffer $::yy_index [lindex $yy_match 1]]
            set ::yyleng [string length $::yytext]
            set yy_matched_rule 1
        }
        # rule 2: @param\s+\S+\s+
        if {$::yy_state_table($yy_current_state) && \
                [regexp -start $::yy_index -indices -line  -- {\A(@param\s+\S+\s+)} $::yy_buffer yy_match] > 0 && \
                [lindex $yy_match 1] - $::yy_index + 1 > $::yyleng} {
            set ::yytext [string range $::yy_buffer $::yy_index [lindex $yy_match 1]]
            set ::yyleng [string length $::yytext]
            set yy_matched_rule 2
        }
        # rule 3: @return\s+
        if {$::yy_state_table($yy_current_state) && \
                [regexp -start $::yy_index -indices -line  -- {\A(@return\s+)} $::yy_buffer yy_match] > 0 && \
                [lindex $yy_match 1] - $::yy_index + 1 > $::yyleng} {
            set ::yytext [string range $::yy_buffer $::yy_index [lindex $yy_match 1]]
            set ::yyleng [string length $::yytext]
            set yy_matched_rule 3
        }
        # rule 4: @see\s+\"
        if {$::yy_state_table($yy_current_state) && \
                [regexp -start $::yy_index -indices -line  -- {\A(@see\s+\")} $::yy_buffer yy_match] > 0 && \
                [lindex $yy_match 1] - $::yy_index + 1 > $::yyleng} {
            set ::yytext [string range $::yy_buffer $::yy_index [lindex $yy_match 1]]
            set ::yyleng [string length $::yytext]
            set yy_matched_rule 4
        }
        # rule 5: @see\s+\<
        if {$::yy_state_table($yy_current_state) && \
                [regexp -start $::yy_index -indices -line  -- {\A(@see\s+\<)} $::yy_buffer yy_match] > 0 && \
                [lindex $yy_match 1] - $::yy_index + 1 > $::yyleng} {
            set ::yytext [string range $::yy_buffer $::yy_index [lindex $yy_match 1]]
            set ::yyleng [string length $::yytext]
            set yy_matched_rule 5
        }
        # rule 6: @see\s+
        if {$::yy_state_table($yy_current_state) && \
                [regexp -start $::yy_index -indices -line  -- {\A(@see\s+)} $::yy_buffer yy_match] > 0 && \
                [lindex $yy_match 1] - $::yy_index + 1 > $::yyleng} {
            set ::yytext [string range $::yy_buffer $::yy_index [lindex $yy_match 1]]
            set ::yyleng [string length $::yytext]
            set yy_matched_rule 6
        }
        # rule 7: @since\s+
        if {$::yy_state_table($yy_current_state) && \
                [regexp -start $::yy_index -indices -line  -- {\A(@since\s+)} $::yy_buffer yy_match] > 0 && \
                [lindex $yy_match 1] - $::yy_index + 1 > $::yyleng} {
            set ::yytext [string range $::yy_buffer $::yy_index [lindex $yy_match 1]]
            set ::yyleng [string length $::yytext]
            set yy_matched_rule 7
        }
        # rule 8: @version\s+
        if {$::yy_state_table($yy_current_state) && \
                [regexp -start $::yy_index -indices -line  -- {\A(@version\s+)} $::yy_buffer yy_match] > 0 && \
                [lindex $yy_match 1] - $::yy_index + 1 > $::yyleng} {
            set ::yytext [string range $::yy_buffer $::yy_index [lindex $yy_match 1]]
            set ::yyleng [string length $::yytext]
            set yy_matched_rule 8
        }
        # rule 9: <*>\{@docroot\}
        if {[regexp -start $::yy_index -indices -line  -- {\A(\{@docroot\})} $::yy_buffer yy_match] > 0 && \
                [lindex $yy_match 1] - $::yy_index + 1 > $::yyleng} {
            set ::yytext [string range $::yy_buffer $::yy_index [lindex $yy_match 1]]
            set ::yyleng [string length $::yytext]
            set yy_matched_rule 9
        }
        # rule 10: <*>\{\s*@link\s+
        if {[regexp -start $::yy_index -indices -line  -- {\A(\{\s*@link\s+)} $::yy_buffer yy_match] > 0 && \
                [lindex $yy_match 1] - $::yy_index + 1 > $::yyleng} {
            set ::yytext [string range $::yy_buffer $::yy_index [lindex $yy_match 1]]
            set ::yyleng [string length $::yytext]
            set yy_matched_rule 10
        }
        # rule 11: <SEE_S>\"
        if {$yy_current_state == "SEE_S" && \
                [regexp -start $::yy_index -indices -line  -- {\A(\")} $::yy_buffer yy_match] > 0 && \
                [lindex $yy_match 1] - $::yy_index + 1 > $::yyleng} {
            set ::yytext [string range $::yy_buffer $::yy_index [lindex $yy_match 1]]
            set ::yyleng [string length $::yytext]
            set yy_matched_rule 11
        }
        # rule 12: <SEE_A></a>
        if {$yy_current_state == "SEE_A" && \
                [regexp -start $::yy_index -indices -line  -- {\A(</a>)} $::yy_buffer yy_match] > 0 && \
                [lindex $yy_match 1] - $::yy_index + 1 > $::yyleng} {
            set ::yytext [string range $::yy_buffer $::yy_index [lindex $yy_match 1]]
            set ::yyleng [string length $::yytext]
            set yy_matched_rule 12
        }
        # rule 13: <SEE_L>\S+(\s+\S+)?
        if {$yy_current_state == "SEE_L" && \
                [regexp -start $::yy_index -indices -line  -- {\A(\S+(\s+\S+)?)} $::yy_buffer yy_match] > 0 && \
                [lindex $yy_match 1] - $::yy_index + 1 > $::yyleng} {
            set ::yytext [string range $::yy_buffer $::yy_index [lindex $yy_match 1]]
            set ::yyleng [string length $::yytext]
            set yy_matched_rule 13
        }
        # rule 14: <LINK>[^\}]+\}
        if {$yy_current_state == "LINK" && \
                [regexp -start $::yy_index -indices -line  -- {\A([^\}]+\})} $::yy_buffer yy_match] > 0 && \
                [lindex $yy_match 1] - $::yy_index + 1 > $::yyleng} {
            set ::yytext [string range $::yy_buffer $::yy_index [lindex $yy_match 1]]
            set ::yyleng [string length $::yytext]
            set yy_matched_rule 14
        }
        # rule 15: [^@\{]*
        if {$::yy_state_table($yy_current_state) && \
                [regexp -start $::yy_index -indices -line  -- {\A([^@\{]*)} $::yy_buffer yy_match] > 0 && \
                [lindex $yy_match 1] - $::yy_index + 1 > $::yyleng} {
            set ::yytext [string range $::yy_buffer $::yy_index [lindex $yy_match 1]]
            set ::yyleng [string length $::yytext]
            set yy_matched_rule 15
        }
        # rule 16: <*>.|\n
        if {[regexp -start $::yy_index -indices -line  -- {\A(.|\n)} $::yy_buffer yy_match] > 0 && \
                [lindex $yy_match 1] - $::yy_index + 1 > $::yyleng} {
            set ::yytext [string range $::yy_buffer $::yy_index [lindex $yy_match 1]]
            set ::yyleng [string length $::yytext]
            set yy_matched_rule 16
        }
        if {$yy_matched_rule == -1} {
            set ::yytext [string index $::yy_buffer $::yy_index]
            set ::yyleng 1
        }
        incr ::yy_index $::yyleng
        # workaround for Tcl's circumflex behavior
        if {[string index $::yytext end] == "\n"} {
            set ::yy_buffer [string range $::yy_buffer $::yy_index end]
            set ::yy_index 0
        }
        switch -- $yy_matched_rule {
            0 {
append ::annotrec(author) "\n<dd>"; set ::tag author
            }
            1 {
set ::annotrec(deprecated) ""; set ::tag deprecated
            }
            2 {
regexp -- {\A@param\s+(\S+)\s+} $yytext foo param_name
                    append ::annotrec(param) "\n<dd><code>$param_name</code> - "
                    set ::tag param
            }
            3 {
set ::annotrec(return) ""; set ::tag return
            }
            4 {
append ::annotrec(see) "<dd>&quot;"; set ::tag see; yy_push_state SEE_S
            }
            5 {
append ::annotrec(see) "<dd><"; set ::tag see; yy_push_state SEE_A
            }
            6 {
append ::annotrec(see) "<dd>"; set ::tag see; yy_push_state SEE_L
            }
            7 {
append ::annotrec(since) "\n<dd>"; set ::tag since
            }
            8 {
append ::annotrec(version) "\n<dd>"; set ::tag version
            }
            9 {
append ::annotrec($::tag) $::annotrec(docroot)
            }
            10 {
yy_push_state LINK
            }
            11 {
append ::annotrec(see) "&quot;"; set ::tag text; yy_pop_state
            }
            12 {
append ::annotrec(see) "</a>"; set ::tag text; yy_pop_state
            }
            13 {
interp_link $yytext see; set ::tag text; yy_pop_state
            }
            14 {
interp_link [string range $yytext 0 end-1] link; yy_pop_state
            }
            15 -
            16 {
append ::annotrec($::tag) $yytext
            }
            default
                { puts stderr "unmatched token: $::yytext in state `$yy_current_state'"; exit -1 }
        }
    }
    return 0
}
######
# end autogenerated fickle functions
######


# Flushes internal tables in preparation for writing a new annotation
# file.  This function must be called before using any other procedure
# within this file.
#
# @param dest I/O channel to write annotations
# @param basename name of source Tcl file being annotate
# @param annothtmlname name of file to where annotations are being
# written
# @param docroot documents root directory
proc new_annotation {dest basename annothtmlname docroot} {
    array unset ::annotfile
    set ::annotfile(dest) $dest
    set ::annotfile(basename) $basename
    set ::annotfile(annothtmlname) $annothtmlname
    set ::annotfile(docroot) $docroot
    array set ::annotfile {file_overview {} file_summary {} procs {}}
}

# Given the file-level comment (with <code>//#</code> markings
# removed) scans it for tags.  Generates the HTML code suitable for
# writing to the file's annotation page.  Adds a one-line summary for
# the file to the global summary table.
#
# @param header a contiguous block of comments sans hash marks
proc add_file_annotation {header} {
    YY_FLUSH_BUFFER
    yy_scan_string $header
    array unset ::annotrec
    set ::annotrec(text) ""
    set ::annotrec(docroot) $::annotfile(docroot)
    set ::annotrec(basename) $::annotfile(basename)
    set ::tag text
    yylex
    if {[yy_top_state] != "INITIAL"} {
        tcldoc_file_error "Tag not closed in file header"
    }

    set ::annotrec(text) [string trim $::annotrec(text)]
    set file_overview "<dl>\n"
    
    # calculate the file summary
    if [info exists ::annotrec(deprecated)] {
        set summary "<strong>Deprecated.</strong> <em>$::annotrec(deprecated)</em>\n"
        append file_overview "<dt><strong>Deprecated.</strong> <em>[string trim $::annotrec(deprecated)</em>]\n<dl>\n"
    } else {
        set summary [get_summary $::annotrec(text)]
        append file_overview "<dd>$::annotrec(text)\n<dl>\n"
        if [info exists ::annotrec(since)] {
            append file_overview "<dt><strong>Since:</strong><dd> [string trim $::annotrec(since)]\n"
        }
        if [info exists ::annotrec(version)] {
            append file_overview "<dt><strong>Version:</strong> [string trim $::annotrec(version)]\n"
        }        
    }
    if [info exists ::annotrec(author)] {
        append file_overview "<dt><strong>Author:</strong> [string trim $::annotrec(author)]\n"
    }
    if [info exists ::annotrec(see)] {
        append file_overview "<dt><strong>See Also:</strong> [string trim $::annotrec(see)]\n"
    }
    
    append file_overview "</dl></dl>\n<hr>\n"
    
    set ::annotfile(file_overview) $file_overview
    set ::annotfile(file_summary) $summary
}

# Given a procedure-level comment scans it for tags.  Generates the
# HTML code suitable for writing to the file's annotation page.  Adds
# a one-line summary for the procedure to the global summary table.
#
# @param header a contiguous block of comments sans hash marks
# @param procname name of the procedure being scanned
# @param procargs a {@link #flatten_args flattened} list of arguments
# to the procedure
# @param procline line number for procedure declaration within its
# source file
proc add_proc_annotation {header procname procargs procline} {
    YY_FLUSH_BUFFER
    yy_scan_string $header
    array unset ::annotrec
    set ::annotrec(text) ""
    set ::annotrec(docroot) $::annotfile(docroot)
    set ::annotrec(basename) $::annotfile(basename)
    set ::tag text
    yylex
    if {[yy_top_state] != "INITIAL"} {
        tcldoc_file_error "Tag not closed in procedure header"
    }
    
    set ::annotrec(text) [string trim $::annotrec(text)]
    set proc_detail "<h3><a name=\"$procname\">$procname</a></h3>
<pre>proc $procname \{ $procargs \}</pre>
<dl>\n"

    # calculate the procedure summary
    if [info exists ::annotrec(deprecated)] {
        set summary "<strong>Deprecated.</strong> <em>[string trim $::annotrec(deprecated)]</em>\n"
        append proc_detail "<dt><strong>Deprecated.</strong> <em>[string trim $::annotrec(deprecated)]</em>\n"
    } else {
        set summary [get_summary $::annotrec(text)]
        append proc_detail "<dd>$::annotrec(text)<dl>\n"
        if [info exists ::annotrec(param)] {
            append proc_detail "<dt><strong>Parameters:</strong>\n[string trim $::annotrec(param)]\n"
        }
        if [info exists ::annotrec(return)] {
            append proc_detail "<dt><strong>Returns:</strong>\n<dd> [string trim $::annotrec(return)]\n"
        }
        if [info exists ::annotrec(since)] {
            append proc_detail "<dt><strong>Since:</strong>\n<dd> [string trim $::annotrec(since)]\n"
        }
        if [info exists ::annotrec(version)] {
            append proc_detail "<dt><strong>Version:</strong> [string trim $::annotrec(version)]\n"
        }
    }
 
    set proc_summary "<code><a href=\"#$procname\">$procname</a> \{ $procargs \}</code><br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$summary"

    if [info exists ::annotrec(author)] {
        append proc_detail "<dt><strong>Author:</strong>\n[strin trim $::annotrec(author)]\n"
    }
    if [info exists ::annotrec(see)] {
        append proc_detail "<dt><strong>See Also:</strong>\n[string trim $::annotrec(see)]\n"
    }

    set htmlname $::annotfile(basename).html
    set procid ${procname}_${procline}
    append proc_detail "<dt><strong>Defined in:</strong><dd><a href=\"$htmlname#$procid\">$::annotfile(basename), line $procline</a>
</dl></dl>\n"

    # summary entries are:  target, args, source, description, type
    add_summary $procname \
        "$::annotfile(annothtmlname)#$procname" "\{ $procargs \}" \
        "$::annotfile(basename)"                $summary \
        "proc"
    set ::annotfile($procname:s) $proc_summary
    set ::annotfile($procname:d) $proc_detail
    lappend ::annotfile(procs) $procname
}

# Helper function to the scanner that takes the arguments to a
# <code>@link</code> or the third form of <code>@see</code> and splits
# it into its component parts.  For the name portion attempts to
# resolve the procedure name as per the rules described in the {@link
# tcldoc.html Tcldoc manual}.  Checks if there is an optional label;
# if not then set the label equal to the name.  Finally adds the
# results of the interpretation to the current tag being scanned.
#
# @param text tag text to scan
# @param tag name of tag being scanned.
proc interp_link {text tag} {
    # first extract the name and optional label
    if {[regexp -- {\A(\S+)\s*(.*)} $text foo name label] == 0} {
        tcldoc_file_error "Malformed @${tag} tag"
    }
    if {$label == ""} {
        set label [sanitize $name]
    }
    set text "<a href=\""
    # try to split the name into a filename and procedure name
    set filename ""
    if {[string first "\#" $name] == -1} {
        set procname $name
    } else {
        foreach {filename procname} [split $name "\#"] {}
    }
    if {$filename == ""} {
        set filename $::annotrec(basename)
    }
    set procrecord [lookup_procrecord $procname $filename]
    if {$procrecord != {}} {
        foreach {procdest procline} $procrecord {}
        append text "${procdest}-annot.html\#$procname"
    } else {
        append text $name
    }
    append text "\">$label</a>"
    append ::annotrec($::tag) $text
}

# Actually writes the annotation file to disk at the location
# specified in a previous call to {@link new_annotation}.  If
# <code>new_annotation</code> has not been called yet then behavior is
# undetermined.
#
# @see new_annotation
proc write_annotation {} {
    # write the file overview
    puts $::annotfile(dest) "$::annotfile(file_overview)"
    
    # write the procedure summary
    set procnames [lsort -dictionary $::annotfile(procs)]
    puts $::annotfile(dest) "<table border=\"1\" cellpadding=\"3\" cellspacing=\"0\" width=\"100%\">
<tr bgcolor=\"$::table_bg_color\">
<!-- -------------------- PROCEDURE SUMMARY -------------------- -->
<td><font size=\"+2\"><strong><a name=\"proc_summary\">Procedure Summary</a></strong></font></td>
</tr>"
    foreach procname $procnames {
        puts $::annotfile(dest) "<tr><td>$::annotfile($procname:s)</td></tr>"
    }
    puts $::annotfile(dest) "</table>\n<p>"

    # write actual procedure details
    puts $::annotfile(dest) "<!-- -------------------- PROCEDURE DETAIL -------------------- -->
<table border=\"1\" cellpadding=\"3\" cellspacing=\"0\" width=\"100%\">
<tr bgcolor=\"$::table_bg_color\">
<td colspan=1><font size=\"+2\"><strong><a name=\"proc_detail\">Procedure Detail</a></strong></font></td>
</tr>
</table>"
    foreach procname [lrange $procnames 0 end-1] {
        puts $::annotfile(dest) "$::annotfile($procname:d)\n<hr>"
    }
    if [llength $procnames] {
        puts $::annotfile(dest) "$::annotfile([lindex $procnames end]:d)"
    }
}


# Determines the summary line given the file/procedure information.  A
# summary is the first sentence (text ending with a period and followed
# by whitespace), excluding all HTML tags.
#
# @param text Text from a comment block (either file or procedure
# level) from which to determine summary.
# @return Calculated summary.
proc get_summary {text} {
    regsub -all {<[^>]*>} $text {} text
    if {[regexp -- {\A([^\.]*.)(\s|\n)} $text foo summary] == 0} {
        set summary $text
    }
    return [string trim $summary]
}

Overview | Index by: file name | procedure name | procedure call | annotation
File generated 2019-02-05 at 11:19.