#!/bin/sh
# the next line restarts using tclsh \
  exec tclsh "$0" "$@"

proc Usage {} {
	global argv0
	puts "Usage: $argv0 \[-r <prompt>\] \[-g\] \[-s\] \[-p\] -o <out-file>"
}

proc Help {} {
	puts "\nfixSwigWrapper : Applies extended behaviour to a swig_wrap.c\n"
	Usage
	puts "\nArguments:"
	puts "-o out-file : The name of the out file\n"
	puts "\nOptions:"
	puts "-r prompt : add readline support using the given prompt"
	puts "-g : Cleanup SWIG_GetPointerObj"
	puts "-s : Cleanup SWIG_SetPointerObj"
	puts "-p : Cleanup SWIG_MakePtr\n\n"
	exit 1
}

# basically this code filters out the two swig functions:
# SWIG_GetPointerObj
# SWIG_SetPointerObj
# from the given file and also adds one line just before the last
# return statement

proc LoadFile {fn} {
	# open the file
	if {[catch {set f [open $fn "r"]} e]} {
		error "-E- LoadFile: $e"
	}

	while {[gets $f sLine] >= 0} {
	        lappend linesList "$sLine"
	}
	close $f
	set res "[join $linesList \n]"
	puts stderr "-I- Loaded file: $fn with:[string length $res] chars"

	return $res
}

proc remTrailingBlanks {code} {
	regsub -line -all {[ 	]+$} $code {} code
	return $code
}


# remove the given proc from the file
proc remProc {code procName procRetType} {

	# find the idx of the start of the procedure
	if {! [regexp -indices -line "SWIGSTATIC\[\\s\n\]*$procRetType\[\\s\n\]*$procName" \
				 $code sidx]} {
		error "-E- Fail to find proc:$procName"
	}

	# assume the end of the procedure has a nice indented \}
	if {! [regexp -start [lindex $sidx 0] -indices "\n\}" $code eidx]} {
		error "-E- Fail to find proc:$procName end"
	}

	return [string replace $code [lindex $sidx 0] [lindex $eidx 1]]
}

proc addAtLastReturn {code text} {
	# find the last "return TCL_OK"
	set idx [string last {return TCL_OK} $code]
	if {$idx <= 0} {
		error "-E- Fail to find last return"
	}

	return [string replace $code $idx $idx $text]
}

proc addVoidParam {code procName procRetType} {
 	# find the idx of the start of the procedure
	if {! [regexp -indices "SWIGSTATIC\[\\s\n\]*$procRetType\[\\s\n\]*${procName}\\(\\)" \
				 $code sidx]} {
		error "-E- Fail to find proc:$procName"
	}
	return [string replace $code [lindex $sidx 1] [lindex $sidx 1] " void )"]
}

# MAIN

set removeGetObj 0
set removeSetObj 0
set removeMakePtr 0
set userPrompt 0
set removeTrailingBlanks 1
set outFileName ""

# parse command line args
while {[llength $argv]} {
	set sw [lindex $argv 0]
	set argv [lrange $argv 1 end]

	switch -- $sw {
		-r {
			if {![llength $argv]} {
				puts "-E- Expected prompt value after -r"
				Usage
				exit 1
			}
			set userPrompt [lindex $argv 0]
			set argv [lrange $argv 1 end]
		}
		-o {
			if {![llength $argv]} {
				puts "-E- Expected file name value after -o"
				Usage
				exit 1
			}
			set outFileName [lindex $argv 0]
			set argv [lrange $argv 1 end]
		}
		-g { set removeGetObj 1}
		-s { set removeSetObj 1}
		-p { set removeMakePtr 1}
		-h {
			Help
		}
		default {
			puts "-E- Unexpected argument: $sw"
			Usage
			exit 1
		}
	}
}

set readlineCode "
   if (Tcl_PkgRequire(interp,\"tclreadline\",0,0) != NULL) \{
     Tcl_Eval(interp,
				  \"if \{\$tcl_interactive\} \{namespace eval tclreadline \{proc prompt1 \{\} \{return \\\"$userPrompt >\\\"\} \}; ::tclreadline::Loop $userPrompt.log \}\"
     );
   \}
"

if {[catch {set swigCode [LoadFile swig_wrap.c]} e]} {
	puts "$e"
	exit 3
}

if {$removeGetObj} {
	if {[catch {set swigCode [remProc $swigCode SWIG_GetPointerObj "char \\*"]} e]} {
		puts "-E- $e"
		exit 1
	}
}

if {$removeTrailingBlanks} {
	if {[catch {set swigCode [remTrailingBlanks $swigCode]} e]} {
		puts "-E- $e"
		exit 1
	}
}

if {$removeSetObj} {
	if {[catch {set swigCode [remProc $swigCode SWIG_SetPointerObj "void"]} e]} {
		puts "-E- $e"
		exit 1
	}
}

if {$removeMakePtr} {
	if {[catch {set swigCode [remProc $swigCode SWIG_MakePtr "int"]} e]} {
		puts "-E- $e"
		exit 1
	}
}

if {$userPrompt != 0} {
	if {[catch {set swigCode [addAtLastReturn $swigCode "${readlineCode}r"]} e]} {
		puts "-E- $e"
		exit 1
	}
}

if {[catch {set swigCode [addVoidParam $swigCode SWIG_RegisterType "void"]} e]} {
   puts "-E- $e"
   exit 1
}

if {$outFileName != 0} {
	if {[catch {set f [open $outFileName w]} e]} {
		puts "-E- $e"
		exit 1
	}
	puts $f $swigCode
	close $f
} else {
	puts $swigCode
}
