Netbeans Support for Tcl

/*
 * Created during Google Summer Of Code 2011.
 * For Tcl/Tk Community by student Michał Poczwardowski
 * License: BSD
 */
package org.netbeans.modules.languages.tcl.debugger;

import java.io.File;
import java.io.FileOutputStream;
import java.io.IOException;
import java.io.InputStream;
import java.io.OutputStream;
import java.util.HashMap;
import java.util.Map;
import java.util.NoSuchElementException;
import org.netbeans.api.debugger.Breakpoint;
import org.netbeans.api.debugger.DebuggerManager;
import org.netbeans.api.debugger.Session;
import org.netbeans.modules.languages.tcl.project.TclProject;
import org.netbeans.modules.languages.tcl.run.RunTclsh;
import org.netbeans.spi.viewmodel.ModelListener;
import org.openide.util.Exceptions;

	private int tclPartPortNumber=31337;
	private String variablesStringLocals="";
	private String variablesStringGlobals="";
	private ModelListener modelListener=null;

	public void addModelListener( ModelListener ml ) {
		//System.out.println("addModelListner inside TclDebuggerJavaPart : "+ml);
		this.modelListener=ml;
	}


	public TclDebuggerJavaPart( TclDebuggerEngineProvider engineProvider ) {

		bindProject();

		this.engineProvider=engineProvider;

			}

		}
	}

	private void runTclPart() {

		String fileToRunPath=project.getFileToRun().getAbsolutePath();
		new RunTclsh( tclPartFileName, this.tclPartFile.getAbsolutePath(), fileToRunPath, TclProject.getDirectoryFromPath( fileToRunPath ), this.tclPartPortNumber + "" );
	}

	/*
	 * Returns true if connection is created
	 */
	private boolean createConnectionToTclPart() {

		if( tclPart == null ) {
			tclPart=new ClientToTclPart( this.tclPartPortNumber );
			sendBreakpoints();
			getExecutionStatus();
			return true;
		}
		return false;
	}

	private void sendBreakpoints() {


		Breakpoint[] breakpoints=DebuggerManager.getDebuggerManager().getBreakpoints();
		int iter;
		int breakpointsCount=breakpoints.length;

		if( breakpointsCount != 0 ) {

			tclPart.printlnToSocket( "breakpoints" );

			// foreach breakpoint
			String filePath, lineNumber, lines;
			HashMap<String, String> bpoints=new HashMap<String, String>();
			for( iter=0; iter < breakpointsCount; iter++ ) {
				if( breakpoints[iter] instanceof TclBreakpoint && ( ( ( TclBreakpoint )breakpoints[iter] ).getLine() != null ) ) {
					TclBreakpoint bp=( TclBreakpoint )breakpoints[iter];

					filePath=bp.getFile().getPath();
					lineNumber=Integer.toString( bp.getLine().getLineNumber() + 1 );

					if( bpoints.containsKey( filePath ) ) {
						lines=bpoints.get( filePath );
						lines+=" " + lineNumber;
						bpoints.put( filePath, lines );
					} else {
						bpoints.put( filePath, lineNumber );
					}
				}
			}

			// send to server:
			// // number of files
			tclPart.printlnToSocket( Integer.toString( bpoints.size() ) );
			// // foreach file line numbers
			for( Map.Entry<String, String> point:bpoints.entrySet() ) {
				tclPart.printlnToSocket( point.getKey() );
				tclPart.printlnToSocket( point.getValue() );
			}
		}
	}

	private void getExecutionStatus() {

		tclPart.printlnToSocket( "status" );
		try {
			// get first line → file localization
			String fileName=tclPart.nextLineFromFromSocket();
			currentFile=new File( fileName );

			// get second line → line in file
			currentLineNumber=Integer.parseInt( tclPart.nextLineFromFromSocket() );
			programCounter.modify();

			// get third line → number of variablesStringLocals
			int numberOfVariables=Integer.parseInt( tclPart.nextLineFromFromSocket() );
			variablesStringLocals="";

			// every following numberOfVariables line contains name nad value of variable
			for( int i=1; i <= numberOfVariables; i++ ) {
				variablesStringLocals+=tclPart.nextLineFromFromSocket() + "\n";
			}

			// get next line → number of variablesStringGlobals
			numberOfVariables=Integer.parseInt( tclPart.nextLineFromFromSocket() );
			variablesStringGlobals="";
			// every following numberOfVariables line contains name nad value of variable
			for( int i=1; i <= numberOfVariables; i++ ) {
				variablesStringGlobals+=tclPart.nextLineFromFromSocket() + "\n";
			}

			updateTclVariablesModel();

		} catch( NoSuchElementException e ) {
			System.out.println( ">>> End of debugging…" );
			actionKill();
		}

	}

	// Action handlers below:
	//
	public void actionStepOver() {
		createConnectionToTclPart();
		tclPart.printlnToSocket( "stepover" );

	}

	void actionPause() {
		createConnectionToTclPart();
	}

	void actionContinue() {
		if( !createConnectionToTclPart() ) { // for next runs (not first one)
			sendBreakpoints();
			tclPart.printlnToSocket( "continue" );
			getExecutionStatus();
		}

	}

	void actionRunToCursor() {
		createConnectionToTclPart();
	}

	void actionKill() {
		createConnectionToTclPart();
		tclPart.printlnToSocket( "exit" );
		tclPart.close();
		programCounter.detach();
		engineProvider.getDestructor().killEngine();
	}

	private void updateTclVariablesModel() {
		if( modelListener != null ) {
			modelListener.modelChanged( null );
		}
	}

	// Getters below:
	//
	public File getCurrentFile() {
		return currentFile;
	}

	public int getCurrentLineNumber() {
		return currentLineNumber;
	}

	public String getVariablesStringLocals() {
		return variablesStringLocals;
	}

	public String getVariablesStringGlobals() {
		return variablesStringGlobals;
	}

}

  set breakpointsStatus 0
  variable breakpoint

# execution args:
  variable portNumber
  variable tclScript
  variable currentDirectory
  variable isVerbose

# setData variables
  variable fileName
  variable lineNumber
  variable infoFrame 

# other globals

proc setData args {
	set debug::infoFrame [info frame]
	set infoDict [info frame [expr $debug::infoFrame - $debug::startLevel]]

	if { [dict exists $infoDict line] } {
		set debug::lineNumber [dict get $infoDict line]
	} else {
		puts "NOLINE"
	}

	if { [dict exists $infoDict file] } {
		set debug::fileName [dict get $infoDict file]
	} else {
		puts "NOFILE"
	}
}

proc sendData args {
 	puts $debug::socketFd $debug::fileName
	puts $debug::socketFd $debug::lineNumber

 	putsv ">>> sent ($debug::fileName:$debug::lineNumber)"

	set flist [listVars locals [expr [info level] - 1]]
	puts -nonewline $debug::socketFd $flist

	set flist [listVars globals #0]
	puts -nonewline $debug::socketFd $flist

	flush $debug::socketFd
}

proc serverProc {channel clientaddr clientport} {
	set debug::socketFd $channel
	puts ">>> connection from $clientaddr:$clientport"

	set debug::serverProcStarted 1
	set debug::doNotWait 1
}

proc step {cmdStr op} {

	if { $debug::doNotWait == 0 } {
		puts ">>> debugServer.tcl is waiting for connection..."
		set debug::startLevel [expr [info level]]
		vwait debug::serverProcStarted
		# return beacuse first step is located inside debugServer.tcl = ommited
		return 
	}

	setData
   	putsv ">>> \[ $cmdStr \]"


	if { $debug::breakpointsStatus != 0 } {
		set breakpointReached 0
		
		# Step everything, till next breakpoint
		if { [info exists debug::breakpoints($debug::fileName)] } {
			#puts "breakpoint In THIS LAP"
			set lines $debug::breakpoints($debug::fileName)
			foreach line $lines {
				if { $line == $debug::lineNumber } {
					set breakpointReached 1
					putsv ">>> reached breakpoint in file $debug::fileName line $line" 
				}
			}
		}
		if { $breakpointReached == 0 } {
			#puts "BOX NOT this lap"
			return
		}
	} 


	# Perform single stepping…
	if { $debug::stepOverLevel != -1 } {
		# Now step everything, till next equal or lower stepOverLevel
		if { $debug::stepOverLevel < $debug::infoFrame } {
			return
		} else {
			# Make stepover inactive
			set debug::stepOverLevel -1
		}
	}	

	while { true } {
	


		































		set operation [gets $debug::socketFd]
   		putsv ">>> operation: $operation"

		switch $operation {
		   status {
			sendData
		   }
		   step {
			# Activate single stepping mode.

			# If there is no stepover active:
			if { $debug::stepOverLevel == -1} {
				set debug::stepOverLevel $debug::infoFrame
				break;
			}
		   }
		   breakpoints {
			set debug::breakpointsStatus [gets $debug::socketFd]
			unset -nocomplain ::debug::breakpoints

			#puts "Breakpoints: $number"
			set count 1
			while { $count <= $debug::breakpointsStatus } {
			#	puts ">>> $count"
				set breakpointFileName [gets $debug::socketFd]
				set breakpointFileLines [gets $debug::socketFd]
				set ::debug::breakpoints($breakpointFileName) [lsort -integer $breakpointFileLines]
			#	puts ">>> set $breakpointFileName:($breakpointFileLines)"
				incr count
			}

		   }
		   continue {
			# Run till next breakpoint
			set debug::breakpointsStatus 1
			# Do next step
			break
		   }
		   exit {
			close $debug::socketFd
			exit
		   }
		   default {
			puts $debug::socketFd "Invalid command."
			flush $debug::socketFd
		   }
   		}
	}
  }

  proc putsv args {
	if { $debug::isVerbose } {
   		puts stdout [lindex $args 0]
	}
  }

  proc main {script} {
	  source $script
  }


if { $argc <= 2 } {
	puts ">>> Please use following syntax:"
	puts ">>> ./debugServer.tcl tclFile currentDirectory portNumber optionalVerbose(0or1)"
	exit
}

set tclScript [lindex $::argv 0]
set currentDirectory [lindex $::argv 1]
set portNumber [lindex $::argv 2]

if { $argc == 4 } {
	set isVerbose [lindex $::argv 3]
} else {
	set isVerbose 0
}

cd $currentDirectory
socket -server serverProc $portNumber
trace add execution ::debug::main [list enterstep] ::debug::step

::debug::main $tclScript

}