#
# vcdb.pl - a command-line debugger that talks to the
#           ms visual c++ debugger.
#
# Author: Nick Thompson (nix at nixfiles.com)
#
# Copyright (C) 2001 Nicholas Thompson.  All Rights Reserved. 

# This software  is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this software; see the file COPYING.txt.  If not, write to
# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.

######################################################################
#
#  this is a simple command-line debugger that implements a
#   gdb-like interface to a visual c++ debugger in another
#   window.  it is intended to be used with vcdb.el, an
#   emacs submode of gud.el.
#

use strict;
use Win32::OLE qw(in with);

# turn on autoflush - run interactively no matter what
$| = 1;

# carp on errors
$Win32::OLE::Warn = 2;

my $appname = 'MSDev.Application';

my $app;
my $dbg;

$app = Win32::OLE->GetActiveObject($appname)
    or Win32::OLE->new($appname)
    or die "unable to initialize $appname";

# note use Win32::OLE->LastError() to get error messages

if ($app) {
    $dbg = $app->{Debugger};
}

sub get_state {
    return "disconnected" if !$app;
    # print "dbg = $dbg\n";
    return "nodebugger" if !$dbg;
    # XXX can't get at $dbg->{'State'} for some reason?
    return "?";
}

# Debugger.BreakPointHit(BreakPoint)
# Debugger methods:
# Evaluate  ShowCurrentStatement   Go  StepInto   Restart  StepOut   RunToCursor  StepOver   SetNextStatement  Stop  

sub eval_and_print {
    my ($expr) = @_;

    # XXX fails for unknown reason
    my $ret = $dbg->Evaluate($expr);
    print " => $ret\n";
}

sub bpt {
    my ($loc) = @_;
    if ($loc eq "") {
	print "breakpoints:\n";
	my $bpts = $dbg->{Breakpoints};
	foreach my $bpt (in $bpts) {
	    print " $bpt->{File} $bpt->{Location}\n";
	}
	return;
    }

    # XXX untested bpt setting

    if ($loc !~ /^(.+):([0-9]+)$/) {
	print "bad breakpoint location '$loc'\n";
	return;
    }

    my $file = $1;
    my $lineno = $2;

    $dbg->{Breakpoints}->addBreakpointAtLine($lineno);
}

sub msdev_view {
    $app->{Visible} = 1;
    $app->{Active} = 1;
}

sub showline {
#	$dbg->ShowCurrentStatement();
    my $doc = $app->{ActiveDocument};
    if ($doc->{Type} ne 'Text') {
#	print "not text!\n";
	return;
    }

    my $fullname = $doc->{FullName};
    my $sel = $doc->{Selection};
    my $lineno = $sel->{CurrentLine};
    print "[${fullname}:$lineno]\n";
}

my $lastcmd = "";
my $done = 0;

sub prompt {
    my $state = get_state;
    # print "state = $state\n";
#    showline if $state eq 'stop';
    showline;
    print "(vcdb) ";
}

sub opendoc {
    my ($doc) = @_;
    print "opening '$doc'\n";
    my $docs = $app->{Documents};
    $docs->Open($doc);
}

#  my $cmds = { 'break' => sub { bpt($_); },
#  	     'print' => sub { eval_and_print($_); },
#  	     'restart' => sub { $dbg->Restart(); },
#  	     'go' => sub { $dbg->Go(); },
#  	     'step' => sub { $dbg->StepInto(); },
#  	     'next' => sub { $dbg->StepOver(); },
#  	     'finish' => sub { $dbg->StepOut(); },
#  	     'stop' => sub { $dbg->Stop(); },
#  	     'quit' => sub { $done = 1; },
#  	     'view' => sub { msdev_view(); },
#  	     'help' => sub { print_help(); },
#  	     '?' => sub { print_help(); },
#  	     'state' => sub { print get_state() . "\n"; },
#  	     'open' => sub { opendoc($_); },
#  	     };

my $cmds = {};
my $cmdhelp = {};

sub dbcmd {
    my ($cmd, $desc, $proc) = @_;
    $cmds->{$cmd} = $proc;
    $cmdhelp->{$cmd} = $desc;
}

sub usage {
    foreach my $k (sort keys %$cmds) {
	my $helpstr = sprintf("  %8s  %s\n", $k, $cmdhelp->{$k});
	print $helpstr;
    }
}


dbcmd('break',    "show or add breakpoints",
      sub {bpt $_});
dbcmd('print',    "evaluate an expression",
      sub {eval_and_print $_});
dbcmd('rerun',    "restart the program",
      sub { $dbg->Restart(); });
dbcmd('continue', "resume or start the program",
    sub { $dbg->Go(); });
dbcmd('step',     "step one line",
    sub { $dbg->StepInto(); });
dbcmd('next',     "step one line in current function",
    sub { $dbg->StepOver(); });
dbcmd('finish',   "continue to end of current function",
    sub { $dbg->StepOut(); });
dbcmd('kill',     "stop the program",
    sub { $dbg->Stop(); });
dbcmd('quit',     "exit vcdb",
    sub { $done = 1; });
dbcmd('view',     "pop the msdev window to the front",
    sub {msdev_view $_});
dbcmd('help',     "show help",
    sub {usage $_});
dbcmd('?',        "show help",
    sub {usage $_});
dbcmd('state',    "show current state",
    sub { print get_state() . "\n"; });
dbcmd('open',     "open a project, .exe. or file",
    sub {opendoc $_});

prompt;
while (<>) {
    chomp;

    if (/^$/) {
	# repeat last command
	$_ = $lastcmd;
    }

    if (!/^(\w+)\s*(.*)$/) {
	print "bad command '$_'\n";
	next;
    }

    $lastcmd = $_;
    my $c = $1;
    my $args = $2;

    my $cmd = $cmds->{$c};
    if (!$cmd) {
	foreach my $k (keys %$cmds) {
	    next if substr($k,0,length($c)) ne $c;
	    $cmd = $cmds->{$k};
	}
    }

    if ($cmd) {
	# print "running command '$c' args '$args'\n";
	&$cmd($args);
    } else {
	print "unknown command '$c'\n";
    }

    last if $done;

    prompt;
}


# Debugger props:
#print "state " . $dbg->{cstate} . "\n";

print "done\n";

#sub msdev_event {
#    my ($obj,$event,@args) = @_;
#    print "Event triggered: '$event'\n";
#}
#Win32::OLE->WithEvents($dbg, \&msdev_event, 'IDebuggerEvents');
#Win32::OLE->WithEvents($dbg, \&msdev_event, );

#Win32::OLE->MessageLoop();