#----------------------------->  Perl - 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>  <-------------#

# Common functions used by gen_html and shortflat

set infoFile "gen_bs_info_raw_dump.tcl"
if { ${loadInfo} } {
# Source the file generated by the browser, which sets up various variables.
    if [file exists ${infoFile}] {
	puts "Sourcing ${infoFile}"
	source ${infoFile}
	puts "Done sourcing."
    } else {
	puts "ERROR: You must first run the browser (bs)"
	puts "and select the File menu option Dump State"
	puts "This will generate a file called gen_bs_info_raw_dump.tcl"
	puts "which ${programName} requires"
	exit -1
    }
}

set gSeenFileNames {}

proc getAllFileLines { fname } {
    # Memoize the lines of the file
    global gSeenFileText
    global gSeenFileNames
    
    if { [lsearch ${gSeenFileNames} ${fname} ] >= 0 } {
	return $gSeenFileText($fname)
    } else {
	set fileText [getAllFile ${fname} ]
	set fileLines [split ${fileText} "\n"]
	set gSeenFileText(${fname}) ${fileLines}
	lappend gSeenFileNames ${fname}
	return ${fileLines}
    }
}


proc getAllFile { fname } {
    set ret ""
    if { [file exists ${fname}] } {
	set f [open ${fname} r]
	set ret [read $f]
	close $f
    } else {
	puts "No File found: $fname"
	set ret "No File Found:${fname}"
    }
    return $ret
}

proc debugPuts { msg } {
    global programName
    puts "*${programName}: ${msg}"
}
	
proc getFileName { fullName } {
	# Return the last trailing part of a file name
	# Take care of the case where there is a bare file
    set match [ regexp {[-A-Za-z _/.0-9]*/([-A-Za-z_0-9]*.sa)$} $fullName full modname ]
    if { $match == 1 } {
	return $modname
    }
    #  No directory part
    set match [ regexp {([-A-Za-z_0-9]*.(sa|module))$} $fullName full modname ]
    if { $match == 1 } {
	return $modname
    }

    set match [regexp {([-A-Za-z_0-9]*).module$} $fullName full modname ]
    if { $match == 1} {
	return $modname	
    } else {
	errmsg "getFileName: Could not handle ${fullName}"
	return ""
    }

}

proc errmsg { msg } {
    puts "************************************************"
    puts ${msg}
    puts "************************************************"
}

proc getModuleName { fullName } {
    #  puts "Getting module name:$fullName"
    set match [regexp {[-A-Za-a_./0-9]*/([-A-Za-z_0-9]*).(module|com)} $fullName full modname ]
    if { $match == 1 } {
	return $modname
    } else {
	set match [regexp {([-A-Z.a-z_0-9]*).(module|com)} $fullName full modname ]
	if { $match == 1} {
	    return $modname
	} else {
	    errmsg "getModuleName: Could not handle ${fullName}"
	    return ""
	}
    }
}


debugPuts "sourcing makeModToClassesTable"
proc makeModToClassesTable { classModuleList } {
    global gModToClasses
    global gContainedModules
    
    set commandLineModuleName "CommandLine.module"
    set commandLineModuleNamePrefix "CommandLine"
    foreach class ${classModuleList} {
	set mod [lindex $class 3]
	if { ${mod} == "" } {
	    set gModToClasses($commandLineModuleName) {}
	    set gContainedModules($commandLineModuleName) {}
	    set gContainedModules($commandLineModuleNamePrefix) {}
	} else {
	    set textModName [getModuleName ${mod}]
	    set gModToClasses($mod) {}
	    set gContainedModules($textModName) {}
	    set gContainedModules($mod) {}
	}
    }
    debugPuts "Going through modules again"
    # Put each class under its appropriate module in gModToClasses 
    # (should really be module table)
    foreach class $classModuleList {
	set cnm [lindex $class 0]
	set mod [lindex $class 3]
	if { $mod == "" } {   set mod $commandLineModuleName }
	set clist $gModToClasses($mod)
	# puts "$cnm $fileloc $mod Classes:$clist"
	if { $clist == {} } {
	    set gModToClasses($mod) [list $cnm ]
	} else {
	    set clist2 [concat $clist [list $cnm]]
	    set gModToClasses($mod) $clist2
	}
    }
}


proc isAbstract { nodeName } {
    set abs [string first "\$" ${nodeName}]
    # possible to return abs != -1 itself?
    if { $abs != -1 } {
	return true
    } else {
	return false
    }
    
}



proc satherCleanName { nodeName } {
    # Replace all the dangerous characters that sather uses
    # in class names
    regsub {\$} ${nodeName} {dol} newName
    regsub {\{} ${newName} {LB} newName2
    regsub {\}} ${newName2} {RB} newName3
    regsub {\}} ${newName2} {RB} newName3
    regsub {\\} ${newName3}  slash newName4
    regsub {\.} ${newName4} dot newName5
    return ${newName5}
}