# Commenter - a utility to parse tcl source files and associate out-line
    # comments with procs.
    #
    
    package require fileutil
    package provide Commenter 1.0
    
    namespace eval Commenter {
    
        # gather leading comment block
        proc leadin {text} {
    	set leadin {}
    	set lnum 0
    	foreach line $text {
    	    set line [string trim $line " \t"]
    	    incr lnum
    	    if {[string match \#* $line]} {
    		lappend leadin $line
    	    } else {
    		return [list $leadin [lrange $text $lnum end]]
    	    }
    	}
    	return [list $leadin {}]
        }
    
        # parse a tcl source into a dict containing:
        # provides - the package provided by this source
        # requires - the packages required by this source
        # contexts - the contexts provided by this source (namespace, global, snit)
        # entities - the procs, vars, options and methods provided by this source
    
        proc parse {text} {
    	set text [split $text \n]
    
    	# leadin is a comment block terminated by a non-comment
    	lassign [leadin $text] leadin text
    	set lnum [llength $leadin]
    	#puts stderr "$lnum line leadin"
    
    	set comment {}	;# free-standing comment block
    	set current ""	;# current context
    	array set context [list "" [list name "" type global comment $leadin]]	;# context of declaration
    
    	set requires {} ;# packages required
    	set provides ""	;# package provided
    	set accum ""	;# we're not in proc scope
    
    	foreach line $text {
    	    set line [string trim $line " \t"]
    	    incr lnum
    
    	    if {$accum ne ""} {
    		# we're in proc context
    		append accum \n $line
    		#puts stderr $accum
    		if {![info complete $accum]} {
    		    continue
    		} else {
    		    set accum ""	;# we're out of proc context
    		}
    	    }
    
    	    switch -glob -- $line {
    		\#* {
    		    # accumulate comments en bloc
    		    lappend comment $line
    		}
    
    		package* {
    		    # provide
    		    # require
    		    regsub {[ \t]+} $line " " line
    		    set line [split $line]
    		    switch -- [lindex $line 1] {
    			provide {
    			    set provides [lindex $line 2]
    			    #puts stderr "provides $provides"
    			}
    			require {
    			    if {[string match -* [lindex $line 2]]} {
    				lappend requires [lindex $line 3]
    			    } else {
    				lappend requires [lindex $line 2]
    			    }
    			    #puts stderr "requires $requires"
    			}
    		    }
    		    set comment {}
    		}
    
    		namespace* {
    		    # eval
    		    regsub {[ \t]+} $line " " line
    		    set line [split $line]
    		    if {[lindex $line 1] eq "eval"} {
    			set name [lindex $line 2]
    			set context($name) [list name $name comment $comment type namespace]
    			set current $name
    			set comment {}
    		    }
    		    #puts stderr "namespace $name"
    		}
    
    		snit::type* {
    		    regsub {[ \t]+} $line " " line
    		    set line [split $line]
    		    set name [lindex $line 1]
    		    set context($name) [list name $name comment $comment type snit]
    		    #puts stderr "snit $name"
    		}
    
    		variable* -
    		option* -
    		method* -
    		proc* {
    		    regsub {[ \t]+} $line " " line
    		    set accum $line	;# enter proc context
    
    		    set line [split $line]
    		    set name [lindex $line 1]
    		    if {[lindex $line 0] in {variable option}} {
    			set trailing [lindex [split [join $line] \#] 1]
    			lappend comment $trailing
    		    }
    		    set entities($name) [list name $name comment $comment line $lnum context $current type [lindex $line 0]]
    		    set comment {}
    		    #puts stderr "[lindex $line 0] $name"
    		}
    	    }
    	}
    	return [list contexts [array get context] entities [array get entities] provides $provides requires $requires]
        }
    
        # same as parse, but operates on the contents of a file
        proc parseF {path} {
    	return [parse [::fileutil::cat $path]]
        }
    
        namespace export -clear *
        namespace ensemble create -subcommands {}
    }
    
    if {[info exists argv0] && ($argv0 eq [info script])} {
        set path [info script]
        puts stderr [Commenter parseF $path]
    }

----
!!!!!!
%| enter categories here |%
!!!!!!