#!/usr/bin/tclsh
#------------------------------>  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_mml. Generates the short flat version of all available
# classes into shortflat-<classname>.html

source "$env(SATHER_HOME)/Browser/Web/common_funcs"
set programName "gen_mml_shortflat"

debugPuts "sourcing run"
proc run { } {
    global infoFile gAllClasses argv

    debugPuts "Starging gen_mml_shortflat"
    # Create gModToClasses
    makeModToClassesTable ${gAllClasses} 
    debugPuts "Staring to generate"
    # Genrate short form
    genShortFlatForm  "Shortflat.mml"

}

debugPuts "sourcing getShortFlatForm"
proc genShortFlatForm { toFileName  } {
    # 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 unsortedModules [array names gModToClasses]
    set sortedModules [lsort -increasing -ascii $unsortedModules ]
    foreach module ${sortedModules} {
	debugPuts "Generating shortflat for: ${module}"
	genShortFlatForModule ${module}
    }
}

debugPuts "Sourcing gen per module"
proc genShortFlatForModule { moduleName} {
    global gModToClasses gClassDef
    global gAncs gDescs

    set classes  $gModToClasses($moduleName)
    set sortedClasses [lsort -increasing -ascii ${classes} ]
    set ancs [array names gAncs]
    set descs [array names gDescs]
    foreach class ${sortedClasses} {
	#  Dump the class and all the routine signatures in it
	# puts ${toFile} "class ${class} is"
	if { [isAbstract ${class}]} {
	    set plainClass [string range ${class} 1 end]
	    set plainClass "dol${plainClass}"
	} else {
	    set plainClass ${class}
	}
	set toFile [open "mml-${plainClass}.mml" w]
	puts ${toFile} "<MML>\n<!DefineTag classdef> \n<!DefineTag comment> \n<!DefineTag signature>\n"
	puts "Writing ${plainClass}..."
	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 reference "\"lined-${classFileOnly}.gen.html#Line${classLineOffset}\" "
# 	puts ${toFile} " <a href=\"lined-${classFileOnly}.gen.html#Line${classLineOffset}\" target=\"source\"> ${class} source</a>"

	set classTxt [getDefinition ${classFileName} ${classLine}  ]
	if { [isAbstract ${class} ] } {
	    set matchClass "\\${class}"
	} else {
	    set matchClass "${class}"
	}
	puts ${toFile} ${classTxt}

	set features [lindex ${classDef} 2] 
	set sortedFeatures [lsort -increasing -ascii ${features}]
	foreach feature ${sortedFeatures} {
	    set featureSig [lindex ${feature} 0]
	    set featureFile [lindex ${feature} 1]
	    set featureFileOnly [getFileName ${featureFile}]
	    set featureLine [lindex ${feature} 2]
	    set featurePermissions [lindex ${feature} 3]
	    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]
	    if { ${isPriv} == "p"} {
		# Do nothing for now
	    } else {
		if { ${isAttrWriter} != "n"} {
		    # Do nothing - reader must be public too
		} elseif { ${isSharedWriter} != "n"} {
		    # Do nothing - reader must be public too
		} else {
		    # Print out routine defintion
		    set featureLine [expr ${featureLine} - 1]
		    set reference  \
			    "\"lined-${featureFileOnly}.gen.html#Line${featureLine}\" "
		    set routineDef \
			    [getDefinition ${featureFile} ${featureLine}  ]
		    # puts ${toFile} "\t${featureSig}"
		    puts ${toFile} "${routineDef}"
		}
	    }
	}
	close ${toFile}
    }
}



debugPuts "sourcing getDefinition"
proc getDefinition { fileName routineLoc  } {
    set fileText [getAllFile $fileName]
    set lines [split $fileText "\n"]
    set firstLine [lindex $lines $routineLoc]
    regsub "<" ${firstLine} "\<" firstLine
    regsub ">" ${firstLine} "\>" firstLine
    set retLines "\n<signature2>\n${firstLine}\n"
    incr routineLoc
    set nextLine [lindex $lines $routineLoc]
    set nextLineTrim [string trimleft ${nextLine}]
    set isCom [string first "--" $nextLineTrim]
    set isInc [string first "include" $nextLineTrim]
    #    puts "Next line: $nextLine $isCom $isInc"
    set retLines "${retLines} \n <comment>\n"
    while { [expr (($isCom == 0) || ($isInc >= 0))] } {
	incr routineLoc
	if { $isCom == 0 } {
	    set retLines "$retLines\n<comment>\n$nextLine"
	}
	set nextLine [lindex ${lines} ${routineLoc}]
	set nextLineTrim [string trimleft [lindex $lines $routineLoc]]
	set isCom [string first "--" $nextLineTrim]
	set isInc [string first "include" $nextLineTrim]
    }
    return $retLines

}


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

run