#!/bin/sh
# the exec restarts using smash which in turn ignores
# the command because of this backslash: \
exec tclsh "$0" "$@"

set outputChannel stdout
set nlines 0

proc emit s {
	global outputChannel linecache
	if [info exists linecache($s)] {
		return
	}
	set linecache($s) 1
	puts $outputChannel $s
}

#
# do not emit if there is a '$' starting any word in the string
#
proc conditional_emit s {
	foreach word [split $s] {
		if { [string range $word 0 0] == $ } {
		    return
		}
	}

	emit $s
}

#if { $tcl_platform(platform) == "windows" } {
	proc read_file_into_array { file } {
		set f [open $file "r"]
		set lines {}
		while 1 {
			set line [gets $f]
			if [eof $f] {
				close $f
				break
			}
			lappend lines "$line"
		}
		return $lines
	}
#}


#
# Read the important lines from input file into the "lines" array.
# Object and method names may not begin with "$".
# Also looks for objects made with  "image create photo" and
# tags of the form "#Class", used when the class def is in C++.
# Also, look for "package provide"
#
proc process_file fname {
	global line nlines outputDir file files defer modified repository

	if { $repository != {} } {
		set rep_fname [file join $repository ${fname},v]
		if [catch {set modified($fname) [file mtime $rep_fname]}] {
			set modified($fname) {}
		}
	} else {
		if [catch {set modified($fname) [file mtime $fname]}] {
			set modified($fname) {}
		}
	}

	set lines [read_file_into_array $fname]
	foreach s $lines {
		set words [split [string trim $s]]
		set key [lindex $words 0]
		# "Class instproc" is now added as "Class <filename>" rather than "instproc <filename>"
		if { [expr {[lsearch -exact {"Class" "\#Class" "WidgetClass"} $key] >= 0
		      && [lsearch -exact {instproc private public proc} [lindex $words 1]] < 0 }] ||
		     $key == "\#provide" } {
			conditional_emit "[lindex $words 1] [list $fname]\
					$modified($fname)"
# considered indexing procs (those not defined on any class in particular) in importTable
#		} elseif { [lindex $words 0] == "proc" } {
#			conditional_emit "[lindex $words 1] [list $fname] $modified($fname)"
		} elseif { [lindex $words 0] == "image" &&
			[lindex $words 1] == "create" &&
			[lindex $words 2] == "photo" } {
			set id [lindex $words 3]
			set k [string first \( $id]
			if { $k > 0 } {
				set id [string range $id 0 [expr $k - 1]]
			}
			conditional_emit "$id [list $fname] $modified($fname)"
		} elseif { [lindex $words 0] == "package" &&
			[lindex $words 1] == "provide" } {
			conditional_emit "[lindex $words 2] [list $fname]\
					$modified($fname)"
		} elseif { [lsearch -exact {instproc private public proc} [lindex $words 1]] >= 0 } {
			# defer methods until end to ensure that
			# class defs come first
			set line "[lindex $words 0] [list $fname]\
					$modified($fname)"
			set defer($line) 1
	        }
	}
}

proc usage {} {
	puts stderr "invalid arguments"
	puts stderr "should be either [lindex $argv 0] <files> or"
	puts stderr "                 [lindex $argv 0] --repository <cvs repository> <files> or"
	puts stderr "                 [lindex $argv 0] --fromfile <input file>"
	puts stderr "                where <cvs repository> is the local path for the CVS"
	puts stderr "                repository for <files>, and <input file> contains a"
	puts stderr "                list of file names, one on each line"
}

# reads files from argv unless --fromfile <file to read from> is specified
if {[lindex $argv 0]!="--fromfile"} {
	if { [lindex $argv 0]=="--repository" } {
		if {[llength $argv] < 2} {
			usage
			return
		}

		set repository [lindex $argv 1]
		set argv [lrange $argv 2 end]
	} else { set repository "" }

	foreach f $argv {
		process_file $f
	}
} else {
	set repository ""
	if {[llength $argv] < 2} {
		usage
		return
	}
	set inputfile [open [lindex $argv 1] "r"]
	while 1 {
		set files [gets $inputfile]
		if [eof $inputfile] {
			break
		}
		foreach f $files {
			process_file $f
		}
	}
	close $inputfile
}
if [info exists defer] {
	foreach line [array names defer] {
		conditional_emit $line
	}
}
