#!/bin/sh
# the next line restarts using tclsh \
  exec tclsh "$0" "$@"
#--
# Copyright (c) 2004 Mellanox Technologies LTD. All rights reserved.
#
# This software is available to you under a choice of one of two
# licenses.  You may choose to be licensed under the terms of the GNU
# General Public License (GPL) Version 2, available from the file
# COPYING in the main directory of this source tree, or the
# OpenIB.org BSD license below:
#
#     Redistribution and use in source and binary forms, with or
#     without modification, are permitted provided that the following
#     conditions are met:
#
#      - Redistributions of source code must retain the above
#        copyright notice, this list of conditions and the following
#        disclaimer.
#
#      - Redistributions in binary form must reproduce the above
#        copyright notice, this list of conditions and the following
#        disclaimer in the documentation and/or other materials
#        provided with the distribution.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
# BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
# ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
# CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
# SOFTWARE.
#
# $Id$
#--

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]
}


# 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 {$outFileName != 0} {
	if {[catch {set f [open $outFileName w]} e]} {
		puts "-E- $e"
		exit 1
	}
	puts $f $swigCode
	close $f
} else {
	puts $swigCode
}