#!/usr/local/bin/tclsh8.3
#------------------------------>  Tcl - script  <-----------------------------#
#- Copyright (C) 199x by International Computer Science Institute            -#
#- This file is part of the GNU Sather package. It is free software; you may -#
#- redistribute  and/or modify it under the terms of the  GNU General Public -#
#- License (GPL)  as  published  by the  Free  Software  Foundation;  either -#
#- version 2 of the license, or (at your option) any later version.          -#
#- This  program  is distributed  in the  hope that it will  be  useful, but -#
#- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY -#
#- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/GPL for more details.        -#
#- The license text is also available from:  Free Software Foundation, Inc., -#
#- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA                     -#
#------------->  Please email comments to <bug-sather@gnu.org>  <-------------#

# Called by gen_html. Generates the short flat version of all available
# classes into shortflat-<classname>.html

set loadInfo true
set programName "gen_html_shortflat"
source "$env(SATHER_HOME)/Browser/Web/common_funcs"

set gMaxFirstCol 10
set gAncDesColor "Green"
set gCommentColor "Maroon"
set gMainHeadColor "Purple"
set gMinorHeadingColor "Red"

debugPuts "sourcing run"
set gFileList ""
# a list of all files encountered that is dumped at the end and then
# used by gen_html_sa_files.

proc run { } {
    # A module name to regenerate can be specified as an optional second
    # argument.
    global infoFile gAllClasses argv
    global gFileList
    debugPuts "Starging gen_html_shortflat"
    # Create gModToClasses
    makeModToClassesTable ${gAllClasses} 
    debugPuts "Staring to generate"
    # Genrate short form

    puts ${argv}
    if { [llength ${argv}] == 1 } {
	set moduleToGenerate [lindex ${argv} 0]
	genShortForm  $moduleToGenerate 
    } else {
	genShortForm  "all" 
    }
    
    set fileListFile [open "gen_files_from_shortflat" w]
    puts ${fileListFile} "set short_flat_files \{ ${gFileList} \}"
    close ${fileListFile}
}



debugPuts "sourcing getShortForm"
proc genShortForm { moduleToGenerate } {
    # Write the short flat form of all classes in the current 
    # gen_bs_info_raw_dump.tcl to "toFile"
    global gClassDef gModToClasses
    global gAncs gDescs

    set modules [array names gModToClasses]
    puts "modules: ${modules}"
    # set moduleToGenerate "/u/gomes/Sather/Sather/Library/pSather/pSather.module"
    if { ${moduleToGenerate} == "all" } {
	puts "Generating all modules"
	set unsortedModules [array names gModToClasses]
    } else {
	puts "Only generating ${moduleToGenerate}"
	set unsortedModules "{${moduleToGenerate}}"
    }
    set sortedModules [lsort -increasing -ascii $unsortedModules ]
    foreach module ${sortedModules} {
	debugPuts "Generating shortflat for: ${module}"
	genShortForModule ${module} false
	genShortForModule ${module} true
   }
}

debugPuts "Sourcing gen per module"
proc genShortForModule { moduleName isFlat } {
    # Generate the short flat listing for a given module.
    # Loop through all the classes in the module
    #     For each class, 
    #        generate the class comment
    #        generate the ancestor and descendant list
    #        generate the public features
    #        generate the private features
    global gModToClasses gClassDef
    global gAncs gDescs
    global gCommentColor
    global gAncDesColor 
    global gMainHeadColor


    set classes  $gModToClasses($moduleName)
    set moduleFileName [getFileName ${moduleName}]
    set moduleFileText [getAllFile ${moduleName}]
    set mf [open "module-${moduleFileName}.html" w]
    puts ${mf} "<body bgcolor=#e8e8e8>\n"
    puts ${mf} "<h1><center><font color=purple>${moduleFileName}</font></h1></center><hr>"
    puts ${mf} "<pre><font color=maroon>"
    puts ${mf} ${moduleFileText}
    puts ${mf} "</font></pre>"
    close ${mf}
    set moduleName [getFileName ${moduleName}]

    set sortedClasses [lsort -increasing -ascii ${classes} ]
    set ancs [array names gAncs]
    set descs [array names gDescs]
    set num_classes [llength ${sortedClasses}]
    puts "\n***Generating shortflat:${moduleName} with ${num_classes} classes"
    foreach class ${sortedClasses} {
	#  Dump the class and all the routine signatures in it
	if { [isAbstract ${class}]} {
	    set plainClass [string range ${class} 1 end]
	    set plainClass "dol${plainClass}"
	} else {
	    set plainClass ${class}
	}

	if { ${isFlat} } {
	    set toFile [open "shortflat-${plainClass}.html" w]
	} else {
	    set toFile [open "short-${plainClass}.html" w]
	}
	puts stdout "${plainClass} " nonewline
	puts ${toFile} "<title>${plainClass}</title>"
	puts ${toFile} "<body bgcolor=#ffffff>"

	set classDef $gClassDef(${class})
	debugPuts " Processing ${class} ..."
	set classFileName [lindex ${classDef} 0]
	set classFileOnly [getFileName ${classFileName}]
	set classLineOffset [lindex ${classDef} 1] 
	set classLine [expr ${classLineOffset} - 1]
	set classEndLine [findClassEnd ${class} ${classFileName} ${classLineOffset} ]
	
	set reference "\"lined-${classFileOnly}.gen.html#Line${classLineOffset}\" "
	debugPuts "Getting class definition for ${class}"
	set classTxt [getDefinition ${classFileName} ${classLine} ${reference}  true ${class} "" false ]
	debugPuts "Got class definition"

	puts ${toFile} ${classTxt}
	if { [isAbstract ${class} ] } {
	    set matchClass "\\${class}"
	} else {
	    if { $isFlat != "true" } {
		puts ${toFile} "<br><hr><font color=red> Flattened version is <a href=\"shortflat-${plainClass}.html\">here</a>"
	    }
	    set matchClass "${class}"
	}
	set ancs $gAncs(${class})
	set descs $gDescs(${class})

	puts ${toFile} "<hr><br>"
	set r "<tr>"
	set count 0
	debugPuts "Getting ancestors"
	foreach anc ${ancs} {
	    if { [ isModule ${anc} ] } {
	    } else {
		if { [isAbstract ${anc} ] } {
		    set plainanc [string range ${anc} 1 end]
		    set plainanc "dol${plainanc}"
		} else {
		    set plainanc ${anc}
		}
		set r "${r}<td><a href=\"shortflat-${plainanc}.html\"><font size=-1>${anc}</font></a></td> "
		incr count
		if { [expr ${count} > 3] } {
		    set count 0
		    set r "${r}</tr>\n\t"
		}

	    }
	}
	if { [string length ${r}] > 5 } {
	    puts ${toFile} "<b><font color=${gAncDesColor}>Ancestors</font></b><em> <table>${r} </table></em><br>"	  
	} 
	set r "<tr>"
	debugPuts "Getting descendants"
	set count 0
	foreach des ${descs} {
	    if { [isModule ${des} ] } {
	    } else {
		if { [isAbstract ${des} ] } {
		    set plaindes [string range ${des} 1 end]
		    set plaindes "dol${plaindes}"
		} else {
		    set plaindes ${des}
		}
		set r "${r}<td><a href=\"shortflat-${plaindes}.html\"><font size=-1>${des}</font></a></td> "
		incr count
		if { [expr ${count} > 3] } {
		    set count 0
		    set r "${r}</tr>\n\t"
		}
	    }
	}
	if { [string length ${r}] > 5 } {
	    puts ${toFile} "<font color=${gAncDesColor}><b>Descendants</font></b><em><table>${r}</table></em><br>"
	} 
	puts ${toFile} "<hr>"
	set features [lindex ${classDef} 2] 
	set sortedFeatures [lsort -increasing -ascii ${features}]
	set publicWritableAttrs ""
	set publicReadonlyAttrs ""
	set publicWritableShareds ""
	set publicReadonlyShareds ""
	set publicRoutines ""
	set publicIters ""
	set privateFeatures ""
	set publicConsts ""
	foreach feature ${sortedFeatures} {
	    set featureSig [lindex ${feature} 0]
	    # puts "Getting feature ${featureSig}"
	    set featureFile [lindex ${feature} 1]
	    set featureFileOnly [getFileName ${featureFile}]
	    set featureLine [lindex ${feature} 2]
	    # Determine if this is an included feature
	    set isIncluded 1
	    if { ${featureFile} == ${classFileName} } {
		if { [expr ${featureLine} >= ${classLineOffset} ] } {
		    if { [expr ${featureLine} <= ${classEndLine} ] } {
			set isIncluded 0
		    }
		}
	    }
	    # puts "${isIncluded}: $featureSig"
	    # puts "Inclusion:${classLineOffset} <= ${featureLine} <= ${classEndLine}"
	    # puts "Determined inclusion: ${featureLine}"
	    set featurePermissions [lindex ${feature} 3]
	    set isIter [string index ${featurePermissions} 0]
	    set isPriv [string index ${featurePermissions} 1]
	    set isAttrWriter [string index ${featurePermissions} 2]
	    set isAttrReader [string index ${featurePermissions} 3]
	    set isSharedWriter [string index ${featurePermissions} 4]
	    set isSharedReader [string index ${featurePermissions} 5]
	    set isConst [string index ${featurePermissions} 6]
	    set featureLine [expr ${featureLine} - 1]
	    set reference  "\"lined-${featureFileOnly}.gen.html#Line${featureLine}\" "
	    if { $isFlat } {

		if { $isIncluded } {
		    set routineDef [getDefinition ${featureFile} ${featureLine} ${reference} false ${class} ${featureSig} ${isIncluded} ]
		    
		} else {
		    set routineDef [getDefinition ${featureFile} ${featureLine} ${reference} false ${class} ${featureSig} ${isIncluded} ]
		}

	    } else {
		if { $isIncluded } {
		    set routineDef ""
		} else {
		    set routineDef [getDefinition ${featureFile} ${featureLine} ${reference} false ${class} ${featureSig} ${isIncluded} ]
		}
	    }
	    if { ${isPriv} == "p"} {
		set privateFeatures "${privateFeatures}\n${routineDef}"
	    } else {
		if { ${isAttrWriter} != "n"} {
		    set publicWritableAttrs "${publicWritableAttrs}\n${routineDef}"
		} elseif { ${isSharedWriter} != "n"} {
		    set publicWritableShareds "${publicWritableShareds}\n${routineDef}"
		} elseif { ${isAttrReader} != "n" } {
		    set publicReadonlyAttrs "${publicReadonlyAttrs}\n${routineDef}"
		} elseif { ${isSharedReader} != "n" } {
		    set publicReadonlyShareds "${publicReadonlyShareds}\n${routineDef}"
		} elseif { ${isIter} != "n" } {
		    set publicIters "${publicIters}\n${routineDef}"
		} elseif { ${isConst} != "n" } {
		    set publicConsts "${publicConsts}\n${routineDef}"
		} else {
		    set publicRoutines "${publicRoutines}\n${routineDef}"
		}
	    }
	}
	puts ${toFile} "<br>\n<b><center><font size=+2 color=${gMainHeadColor}>Public</font></b></center><br>"
	puts ${toFile} "<table width=100%>"
	writeFeats ${toFile} "Readable Attributes" ${publicReadonlyAttrs}
	writeFeats ${toFile} "Writable Attributes" ${publicWritableAttrs}
	writeFeats ${toFile} "Readonly Shareds" ${publicReadonlyShareds}
	writeFeats ${toFile} "Writable Shareds" ${publicWritableShareds}
	writeFeats ${toFile} "Constants" ${publicConsts}
	writeFeats ${toFile} "Features" ${publicRoutines}
	writeFeats ${toFile} "Iters" ${publicIters}
	puts ${toFile} "</table>\n"
	if { [string length ${privateFeatures}] > 3 } {
	    puts ${toFile} "<hr><br>\n<b><center><font size=+2 color=${gMainHeadColor}>Private</font></b></center><br>"
	    puts ${toFile} "<table>"
	    puts ${toFile} ${privateFeatures}
	    puts ${toFile} "</table>"
	}
	puts ${toFile} "<hr>"
	puts ${toFile} "<font face=\"helvetica\"><a href=\"http://www.icsi.berkeley.edu/~sather/\" target=\"_top\">The Sather Home Page</a> <font>"
	puts ${toFile} "<hr>"
	set cleanName [satherCleanName ${class}]
	puts stdout "(dotty)" nonewline
	if { [isAbstract ${class} ] } {
	    # gifs are only generated for abstract classes
	    puts $toFile "<img src=dotty-${cleanName}.gr.gif>"
	}
	#if { [file exists "dotty-${cleanName}.gr" ] } {
	    # puts stdout "(dotty)" nonewline
	    #puts $toFile "<img src=dotty-${cleanName}.gr.gif>"
	# }

	close ${toFile}
    }
}

debugPuts "Sourcing writeFeats"
proc writeFeats { file title str } {
    # Write a block of features
    global gMinorHeadingColor

    if { [string length ${str} ] > 3 } {
	puts ${file} "<br><b><font size =+1 color=${gMinorHeadingColor}>${title}</font></b><br>"
	puts ${file} "${str}"
    }
}
proc htmlCleanLine { line } {
    # Substitute for signs that are illegal in html
    regsub -all ">" ${line} "\\&gt;" line
    regsub -all "<" ${line} "\\&lt;" line

    return ${line}
}

proc htmlMakeLinks { line } {
    set matchMail [regexp {mailto:} ${line}]
    if { ${matchMail} } {
	regsub {(mailto:)([-a-z@_./~A-Z0-9]+)([ \t])} ${line} \
		"<a href=\"mailto:\\2\">\\2</a>\\3" line
    }

    set matchHttp [regexp {http://} ${line}]
    if { ${matchHttp} } {
	puts "Found http address"
	regsub {(http://[-a-z_./~A-Z0-9]+)([ \n\t]|$)} ${line} "<a href=\"\\1\">\\1</a>" line
	puts ${line}
    }
    return ${line}
}

proc spaceOut { line } {
    regsub -all " " ${line} "##" line
    # puts "pre Spaced out: ${line}"
    regsub -all "############" ${line} "<font color=#ffffff>______</font>" line
    regsub -all "######" ${line} "<font color=#ffffff>___</font>" line
    regsub -all "####" ${line} "<font color=#ffffff>__</font>" line
    regsub -all "##" ${line} "<font color=#ffffff>_</font>" line
    
    return "${line}"

}
proc trimCode { line } {
    set isUndPt [string first " is_" ${line}]
    set isPt [string first " is" ${line}]
    if {$isUndPt != -1} {
	
    } elseif {$isPt != -1} {
	set line [string range ${line} 0 [expr ${isPt} - 1]]
    }
    set prePt [string first " pre" ${line}]
    if {$prePt != -1} {
	set line [string range ${line} 0 [expr ${prePt} - 1]]
    }
    set postPt [string first " post" ${line}]
    if {$postPt != -1} {
	set line [string range ${line} 0 [expr ${postPt} - 1]]
    }
    return ${line}
}

proc isPreFormatLine { line } {
    # Return true if this line should be laid out as is
    set comPt [string first "--  " ${line}]
    if { ${comPt} != -1 } {
	return true
    } else {
	set match [regexp -- {--[ \t]*$} $line ]
	return ${match}
    }
}

proc isHTMLline { line } {
    # Return true if this line should be laid out as is
    set htmlPt [string first "---HTML " ${line}]
    if { ${htmlPt} != -1 } {
	return true
    } else {
	return false
    }
}

proc stripComment { line } {
    # Return the line with the comment stripped out
    set comPt [string first "--" ${line}]
    if {$comPt != -1 } {
	set uncomment [string range ${line} [expr ${comPt} + 2] end]
	return ${uncomment}
    }
}


proc stripPreComment { line } {
    # Return the line with the -- comment stripped out
    set comPt [string first "--" ${line}]
    if {$comPt != -1 } {
	set uncomment [string range ${line} [expr ${comPt} + 3] end]
	return ${uncomment}
    }
}

proc stripHTMLComment { line } {
    # Return the line with the --- comment stripped out
    set comPt [string first "---HTML" ${line}]
    if {$comPt != -1 } {
	set uncomment [string range ${line} [expr ${comPt} + 7] end]
	return ${uncomment}
    }
}

debugPuts "sourcing getDefinition"
proc getDefinition { fileName routineLoc reference isClass cl featureSig isIncluded } {
    # routineLoc is the line number index of the start of the definition
    #  it is incremented as we go through the lines of the definition
    # fileName is the name of the file where this routine/class occurs
    # reference is the html link to the actual source
    # cl is the name of the class
    # featureSig is the signature of the feature in the compiler 
    #   which is preferrable for features without type parameters
    # isIncluded indicates whether this feature was included from another class
    global gCommentColor
    global gFileList
    global gMaxFirstCol

    if { [lsearch ${gFileList} ${fileName} ] == -1 } {
	# If the file is not found in the list of files, append it to
	# the list of files that will be searched when generating 
	# the lined- .sa files
	lappend gFileList ${fileName}
	puts "|${fileName}|"
    }

    # Split the file into lines
    # set fileText [getAllFile $fileName]
    # set lines [split ${fileText} "\n"]
    set lines [getAllFileLines ${fileName}]
    set firstLine [lindex $lines $routineLoc]


    # Eliminate the table altogether if there is no following comment.
    set hasComment 0
    set isCom [string first "--" ${firstLine}]
    if { ${isCom} >= 0 } {
	set hasComment  1
    }
    set curLineNum [expr $routineLoc + 1]
    set curLine  [lindex ${lines} ${curLineNum}]
    if  { [shouldCommentContinue ${curLine} ] == 1 } {
	set isCom [string first "--" $curLine]
	if { $isCom >= 0 } {
	    set hasComment 1
	}
	incr curLineNum
	set curLine  [lindex ${lines} ${curLineNum}]
    }
    # debugPuts "Determined comment $curLine"
    # Get rid of private and public declarations (they may be
    # incorrect after inclusion
    regsub -all "private" ${firstLine} "" firstLine
    regsub -all "readonly" ${firstLine} "" firstLine
    set firstLine [htmlCleanLine ${firstLine}]
    set firstLine [htmlMakeLinks ${firstLine}]
    set firstLine [string trimleft ${firstLine}]
    set comPt [string first "--" ${firstLine}]
    set preCondPt [string first "pre " ${firstLine}]
    set postCondPt [string first "pre " ${firstLine}]
    # IF there is junk on the first line, separate it out into
    # firstComment and save it for later
    if {$preCondPt != -1 } {
	set firstComment [string range ${firstLine} [expr ${preCondPt} + 2] end]
	set firstLine  [string range ${firstLine} 0 [expr $preCondPt -1]]
    } elseif {$postCondPt != -1 } {
	set firstComment [string range ${firstLine} [expr ${postCondPt} + 2] end]
	set firstLine  [string range ${firstLine} 0 [expr $postCondPt -1]]
    } elseif {$comPt != -1 } {
	set firstComment [string range ${firstLine} [expr ${comPt} + 2] end]
	set firstLine  [string range ${firstLine} 0 [expr $comPt -1]]
    }
    set firstLine [trimCode ${firstLine}]

    # If this is a parametrized class, use text, otherwise use featureSig
    set isParamClass [string first  "\{"  ${cl} ]  
    if { ${isClass} } {
	set bgcolor "white"
    } else {
	# if { $isParamClass < 0 } { if { [isAbstract ${cl}] == "false" } { set firstLine ${featureSig}  } }
	if { ${isIncluded} } {
	    set bgcolor "lavender"
	} else {
	    set bgcolor "white"
	}
    }
    # puts "First line:${firstLine}"
    set sl [string length ${firstLine}]
    set firstLine "<a href=${reference} target\"source\">${firstLine}</a>"
    if { ${isIncluded} } {
	set featName [featureName ${featureSig}]
	set firstLine "<a href=${reference} target\"source\">${firstLine} .. Included as ${featName} </a>"
    } else  {
	set firstLine "<a href=${reference} target\"source\">${firstLine}</a>"
    }
    if { ${isClass} } {
	set firstLine "<b><font color=${gCommentColor}>${firstLine}</font></b>"
    }


    # puts "Determined use of sig: ${firstLine}"
    # Use a table for each comment
    if { ${hasComment} } {
	set retLines "\n<table width=100% border=0 bgcolor=${bgcolor} colspan=2 cellpadding=3 cellspacing=0>\n<th align=left colspan=2>${firstLine}</th></table>\n"
	set retLines "${retLines}\n<table border=0 bgcolor=white cellpadding=3 cellspacing=0>\n"
	set retLines "${retLines}<tr><td><font color=white>****</font>"
	#p set retLines "\n${firstLine}\n<table border=0 cellpadding=3 cellspacing=0>\n"
	#p set retLines "${retLines}<tr><td><font color=white>****</font>"
    } else {
	# If there is no comment, stop here.
	return "\n<table border=0 width=100% bgcolor=${bgcolor} cellpadding=3 cellspacing=0><th align=left colspan=2 bgcolor=${bgcolor}>${firstLine}</th></table>\n"
	#p return "\n${firstLine}\n<br>"
    }

    if { ${isClass} } {
	set retLines "${retLines}<br>"
    }
    # We have to do some special things for the first comment line, 
    # which is either the left over junk in firstComment or the
    # line below, which we handle in the loop
    set isFirst true
    if {$comPt != -1 } {
	set retLines "${retLines}<td align=left><font color=maroon><em>${firstComment}</em>\n"
	set isFirst "false"
    }
    incr routineLoc
    set nextLine [lindex $lines $routineLoc]
    set nextLine [htmlCleanLine ${nextLine}]
    set nextLine [htmlMakeLinks ${nextLine}]
    set nextLineTrim [string trimleft ${nextLine}]
    set isCom [string first "--" $nextLineTrim]
    #    puts "Next line: $nextLine $isCom $isInc"
    set isPreFormatMode "false"
    while { [shouldCommentContinue ${nextLineTrim}] } {
	incr routineLoc
	if { $isCom == 0 } {
	    # If the line has a comment somewhere on it
	    set uncomment [stripComment ${nextLineTrim}]
	    # uncomment contains the code part of the line
	    if { ${isFirst} } {
		set retLines "${retLines}\n<td align=left><font color=${gCommentColor}>"
		set isFirst "false"
	    }
	    if { [ isHTMLline ${nextLine} ] } {
		# Contains special html code
		set uncomment [stripHTMLComment ${nextLineTrim}]
		set retLines "$retLines<pre>${uncomment}</pre>"
	    } elseif { [ isPreFormatLine ${nextLine} ] } {
		# Line starts with --  and 3 spaces (in isPreFormatLine)
		if { $isPreFormatMode } {
		} else {
		    # If you have to do something for the first line
		    set isPreFormatMode "true"
		} 
		set uncomment [htmlCleanLine ${uncomment}]
		set uncomment [spaceOut ${uncomment}]
		set uncomment [htmlMakeLinks ${uncomment}]

		set retLines "$retLines\n<br><tt>${uncomment}</tt>"
	    } else { 
		# Just a standard comment line
		if { $isPreFormatMode } {
		    # If we are coming out of preformat mode, add a CR
		    set retLines "$retLines<br>"
		    set isPreFormatMode "false"
		}
		set uncomment [htmlCleanLine ${uncomment}]
		set uncomment [htmlMakeLinks ${uncomment}]
		set retLines "$retLines<em>${uncomment}</em>"
	    }
	}
	set nextLine [lindex ${lines} ${routineLoc}]
	set nextLineTrim [string trimleft [lindex $lines $routineLoc]]
	set isCom [string first "--" $nextLineTrim]
    }
    set retLines "$retLines\n</td></tr></font>\n</table>"

    return $retLines
}



proc shouldCommentContinue { line } {
    # Indicate whether "line" is a legitimate comment continuation
    # Continue if the next line is either a comment
    # or has an inclue clause
    # or has a precondition statement
    # or has a post condition statement
    set isCom [string first "--" $line ]
    set isInc [string first "include " $line ]
    set isPreCond [string first "pre " $line ]
    set isPostCond [string first "post " $line ]
    if { [expr (((($isCom >= 0) || ($isInc >= 0)) || ($isPreCond >= 0)) || ($isPostCond >= 0))] } {
	return 1
    } else {
	return 0
    }
}


proc findClassEnd { class classFile classLine } {
    # Find and return the end of the class. 
    # If the class end is not found, an internal error will occur
    puts "Finding class end. Error could occur if bad end"
    set fileTextLines [getAllFileLines ${classFile} ]
    set count ${classLine}
    set foundEnd 0
    set curLine [lindex ${fileTextLines} ${count} ]
    set endLoc [string first "end" ${curLine} ] 
    set classLoc [string first ${class} ${curLine} ] 
    # puts "Loc: ${classLoc} First line:${class} in ${curLine}"
    if { [expr ${classLoc} < 0 ] } {
	# puts "Going back one line..." 
	set count [expr ${count} - 1]
	set curLine [lindex ${fileTextLines} ${count} ]
	set endLoc [string first "end" ${curLine} ] 
	set classLoc [string first ${class} ${curLine} ]
	# puts "Loc: ${classLoc} First line:${class} in ${curLine}"
    } 
    set matchEnd [expr (${endLoc} >= 0 ) && (${classLoc} >= 0) ]
    set nlines [llength ${fileTextLines}]
    # An end anywhere on the first line
    while { ! ${matchEnd} } {
	incr count
	set curLine [lindex ${fileTextLines} ${count}]
	# An end at the beginning of some subsequent line
	set endLoc [string first "end" ${curLine} ] 
	set matchEnd [expr ${endLoc} == 0 ]
	if { [expr ${count} > (${nlines} + 2) ] } {
	    inform "Error: Could not find end of class. Assuming whole file.";
	    inform "Class: ${class} File:${classFile}"
	    set matchEnd 1
	}
	# puts "Next line:${endLoc} ${curLine}"
	# set matchEnd [regexp {^[ \t]*end} ${curLine}]
    }
    puts "Class end is: ${curLine} ${count}"
    return ${count}
}

 # Return true if the name ends with a .module
proc isModule { nodeName } {
    set match [regexp {[A-Za-z_0-9]*.(module|com)} $nodeName ]
    return ${match}
}

proc featureName { featureSig } {
    # Return the name of the routine from the whole signature
    puts ${featureSig}
    set res ""
    puts ${res}
    if [regexp {([-a-z@_./~A-Z0-9!]+)([(:])} ${featureSig} ] {
	regsub {([-a-z@_./~A-Z0-9!]+)([(:].*$)} ${featureSig} "\\1" res
    } else {
	set res ${featureSig}
    }
    # puts "Feature name:${res}"
    return ${res}
}

run
