#!/usr/local/bin/wish
#!/usr/local/bin/tclsh
# -*- tcl -*-
#		Pool @mFullVersion@, as of @mDate@
#
# a 4.2 application as it may crash on ceertain inputs under 8.0a1/2.
#
# CVS : $Id: gen_cls,v 1.8 1999/02/14 20:29:16 aku Exp $

#lappend auto_path [pwd] [pwd]/.. [pwd]/../base
package require Pool_Base

# force oo support into memory
::pool::oo::support::ResetCompiler

set classIndex ""
set targetFile ""


# Redefine the oo entry point so that class definitions are *not* evaluated
# on-the-fly, but dumped into a file.

proc ::pool::oo::support::class {name args} {
    global targetFile classIndex

    set code [eval Compile $name $args]

    set     f [open $targetFile w]
    puts   $f $code
    close  $f

    lappend classIndex $name
    return
}



proc compileFiles {} {
    #    puts "CompileFiles: $dir $args"

    global errorCode errorInfo targetFile argv

    global object_priv
    trace variable object_priv(objects) w classIdx

    set flist {}

    if {"[lindex $argv 0]" == "-R"} {
	set oldDir [pwd]

	::pool::file::descendFiles f [pwd] {
	    if {[file extension $f] == ".cls"} {
		lappend flist [file join [pwd] $f]
	    }
	}

	cd $oldDir
    } else {
	set flist [eval glob -nocomplain *.cls]
    }

    if {{} == $flist} {
	puts "no files found"
	return
    }

    foreach file $flist {
	#		puts -nonewline "compiling $file..."
	#	flush stdout
	#	update

	set targetFile [file rootname $file].tcl
	set fail [catch {source $file} msg]
	if {$fail} {
	    ::puts stdout "$msg $errorInfo"
	}
    }

    #    puts "generating index"

    global classIndex
    set    classIndex [::pool::list::uniq [lsort $classIndex]]

    append index "# Tcl class index file, version 0.1\n"
    append index "# This file is generated by the \"gen_cls\" program.\n"
    append index "# and sourced by \"gen_idx\"to set up additional\n"
    append index "# indexing patterns.\n\n"

    foreach c $classIndex {
	#	puts -nonewline "class $c..."
	#	flush stdout
	#	update

	append index "class [list $c]\n"
    }

    #    puts " ok"

    set    f [open clsIndex w]
    puts  -nonewline  $f $index
    close $f

    #    puts "all done"
}


#----------------------------
#
#after 18000 exit
compileFiles
exit

