Devel-tkdb
view release on metacpan or search on metacpan
=over 4
=item Line Numbers
Line numbers are presented on the left side of the window. Lines that
have lines through them are not breakable. Lines that are plain text
are breakable. Clicking on these line numbers will insert a
breakpoint on that line and change the line number color to red.
Clicking on the number again will remove the breakpoint. If you
disable the breakpoint with
the controls on the BrkPt notebook page the color will change to green.
=item Cursor Motion
If you place the cursor over a variable (i.e. $myVar, @myVar, or
%myVar) and pause for a second the debugger will evaluate the current
value of the variable and pop a balloon up with the evaluated
result.
If there is an active selection, the text of that selection will be evaluated.
=back
=head1 Notebook Pane
=over 2
=item Exprs
This is a list of expressions that are evaluated each time the
debugger stops. The results of the expresssion are presented
heirarchically for expression that result in hashes or lists. Double
clicking on such an expression will cause it to collapse; double
clicking again will cause the expression to expand. Expressions are
entered through B<Enter Expr> entry, or by Alt-E when text is
selected in the code pane.
The B<Quick Expr> entry, will take an expression, evaluate it, and
replace the entries contents with the result. The result is also
transfered to the 'clipboard' for pasting.
=item Subs
Displays a list of all the packages invoked with the script
heirarchially. At the bottom of the heirarchy are the subroutines
within the packages. Double click on a package to expand
it. Subroutines are listed by their full package names.
=item BrkPts
Presents a list of the breakpoints current in use. The pushbutton
allows a breakpoint to be 'disabled' without removing it. Expressions
can be applied to the breakpoint. If the expression evaluates to be
'true' (results in a defined value that is not 0) the debugger will
stop the script. Pressing the 'Goto' button will set the text pane
to that file and line where the breakpoint is set. Pressing the
'Delete' button will delete the breakpoint.
=back
=head1 Menus
=head2 File Menu
=over
=item About...
Presents a dialog box telling you about the version of tkdb. It
recovers your OS name, version of perl, version of Tcl/Tk, and some other
information
=item Open
Presents a list of files that are part of the invoked perl
script. Selecting a file from this list will present this file in the
text window.
=item Save Config...
Prompts for a filename to save the
configuration to. Saves the breakpoints, expressions, eval text and
window geometry. If the name given as the default is used and the
script is reinvoked, this configuration will be reloaded automatically.
=item Restore Config...
Prompts for a filename to restore a configuration saved with
the "Save Config..." menu item.
=item Goto Line...
Prompts for a line number. Pressing the "Okay" button sends the window
to the line number entered.
=item Find Text...
Prompts for text to search for. Options include forward search,
backwards search, and regular expression searching.
=item Quit
Causes the debugger and the target script to exit.
=back
=head2 Control Menu
=over
=item Run
The debugger allows the script to run to the next breakpoint or until
the script exits.
=item Run To Here
Runs the debugger until it comes to wherever the insertion cursor
in text window is placed.
=item Set Breakpoint
Sets a breakpoint on the line at the insertion cursor.
=item Clear Breakpoint
Remove a breakpoint on the at the insertion cursor.
=item Clear All Breakpoints
Removes all current breakpoints
=item Step Over
Causes the debugger to step over the next line. If the line is a
subroutine call it steps over the call, stopping when the subroutine
returns.
=item Step In
Causes the debugger to step into the next line. If the line is a
subroutine call it steps into the subroutine, stopping at the first
executable line within the subroutine.
=item Return
Runs the script until it returns from the currently executing subroutine.
=item Restart
Saves the breakpoints and expressions in a temporary file and restarts
the script from the beginning. CAUTION: This feature will not work
properly with debugging of CGI Scripts.
=item Stop On Warning
When C<-w> is enabled the debugger will stop when warnings such as, "Use
of uninitialized value at undef_warn.pl line N" are encountered. The debugger
will stop on the NEXT line of execution since the error can't be detected
until the current line has executed.
This feature can be turned on at startup by adding:
$DB::tkdb::stop_on_warning = 1 ;
to a .ptkdbrc file
=back
=head2 Data Menu
=over
=item Enter Expression
When an expression is entered in the "Enter Expression:" text box,
selecting this item will enter the expression into the expression
list. Each time the debugger stops this expression will be evaluated
and its result updated in the list window.
=item Delete Expression
Deletes the highlighted expression in the expression window.
=item Delete All Expressions
Delete all expressions in the expression window.
=item Expression Eval Window
Pops up a two pane window. Expressions of virtually unlimitted length
can be entered in the top pane. Pressing the 'Eval' button will cause
the expression to be evaluated and its placed in the lower pane.
Undo is enabled for the text in the upper pane.
HINT: You can enter multiple expressions by separating them with commas.
=back
=head2 Stack Menu
Maintains a list of the current subroutine stack each time the
debugger stops. Selecting an item from this menu will set the text in
the code window to that particular subourtine entry point.
=head2 Bookmarks Menu
Maintains a list of bookmarks. The booksmarks are saved in ~/.ptkdb_bookmarks
=over
=item Add Bookmark
Adds a bookmark to the bookmark list.
=back
=head1 Options
Here is a list of the current active XResources options. Several of
these can be overridden with environmental variables. Resources can be
added to .Xresources or .Xdefaults depending on your X configuration.
To enable these resources you must either restart your X server or use
the xrdb -override resFile command. xfontsel can be used to select
fonts.
/*
* Perl Tk Debugger XResources.
* Note... These resources are subject to change.
*
* Use 'xfontsel' to select different fonts.
*
* Append these resource to ~/.Xdefaults | ~/.Xresources
* and use xrdb -override ~/.Xdefaults | ~/.Xresources
* to activate them.
*/
ptkdb.frame*font: fixed /* Menu Bar */
ptkdb.frame2.frame1.rotext.font: fixed /* Code Pane */
ptkdb.toplevel.frame.textundo.font: fixed /* Eval Expression Entry Window */
ptkdb.toplevel.frame1.text.font: fixed /* Eval Expression Results Window */
ptkdb.toplevel.button.font: fixed /* "Eval..." Button */
ptkdb.toplevel.button1.font: fixed /* "Clear Eval" Button */
ptkdb.toplevel.button2.font: fixed /* "Clear Results" Button */
ptkdb.toplevel.button3.font: fixed /* "Clear Dismiss" Button */
=head1 Environmental Variables
=over 4
=item PTKDB_CODE_FONT
Sets the font of the Text in the code pane.
=item PTKDB_EXPRESSION_FONT
Sets the font used in the expression notebook page.
=item PTKDB_EVAL_FONT
Sets the font used in the Expression Eval Window
=item PTKDB_DISPLAY
Sets the X display that the ptkdb window will appear on when invoked.
Useful for debugging CGI scripts on remote systems.
=item PTKDB_BOOKMARKS_PATH
Sets the path of the bookmarks file. Default is $ENV{'HOME'}/.ptkdb_bookmarks
=back
=head1 FILES
=head2 .ptkdbrc
If this file is present in ~/ or in the directory where perl is
invoked the file will be read and executed as a perl script before the
debugger makes its initial stop at startup. There are several 'api'
calls that can be used with such scripts. There is an internal
variable $DB::no_stop_at_start that may be set to non-zero to prevent
the debugger from stopping at the first line of the script. This is
useful for debugging CGI scripts.
=over 4
=item brkpt($fname, @lines)
Sets breakspoints on the list of lines in $fname. A warning message
is generated if a line is not breakable.
=item condbrkpt($fname, @($line, $expr) )
Sets conditional breakpoints in $fname on pairs of $line and $expr. A
warning message is generated if a line is not breakable. NOTE: the
validity of the expression will not be determined until execution of
&set_stop_on_warning();
}
#
# Constructor for our Devel::tkdb
#
sub new {
my($type) = @_;
my $self = {
# Current position of the executing program
current_file => "",
current_line => -1, # initial value indicating we haven't set our line/tag
window_pos_offset => 10, # when we enter how far from the top of the text are we positioned down
search_start => "1.0",
fwdOrBack => 1,
BookMarksPath => ($ENV{'PTKDB_BOOKMARKS_PATH'} || "$ENV{'HOME'}/.ptkdb_bookmarks" || '.ptkdb_bookmarks'),
# list of expressions to eval in our window fields: {'expr'} The expr itself {'depth'} expansion depth
expr_list => [],
brkPtCnt => 0,
main_window => undef,
subs_list_cnt => 0,
};
bless $self, $type;
$self->setup_main_window();
return $self;
} # end of new
sub setup_main_window {
my($self) = @_ ;
# Main Window
my $int = new Tcl::Tk;
$self->{int} = $int;
$int->_packageRequire('treectrl');
$self->{main_window} = $self->{int}->mainwindow();
$self->{main_window}->geometry($ENV{'PTKDB_GEOMETRY'} || "800x600");
$self->{main_window}->bind('<Control-c>', \&DB::dbint_handler) ;
#
# Bind our 'quit' routine to a close command from the window manager (Alt-F4)
#
$self->{main_window}->protocol('WM_DELETE_WINDOW', sub { $self->close_ptkdb_window(); } );
#
# setup Frames
# Setup our Code, Data, and breakpoints
$self->setup_frames();
# Menu bar
$self->setup_menu_bar();
}
#
# Check for changes to the bookmarks and quit
#
sub DoQuit {
print STDERR "DoQuit\n";
my($self) = @_;
$self->save_bookmarks($self->{BookMarksPath}) if $self->{'bookmarks_changed'};
$self->{main_window}->destroy if $self->{main_window} ;
$self->{main_window} = undef;
}
#
# This supports the File -> Open menu item
# We create a new window and list all of the files
# that are contained in the program. We also
# pick up all of the perlTk files that are supporting
# the debugger.
#
sub DoOpen {
my $self = shift ;
my ($topLevel, $listBox, $selectedFile, @fList) ;
#
# subroutine we call when we've selected a file
#
my $chooseSub = sub { $selectedFile = $listBox->get('active') ;
print "attempting to open $selectedFile\n" ;
$DB::window->set_file($selectedFile, 0) ;
$topLevel->destroy;
} ;
#
# Take the list the files and resort it.
# we put all of the local files first, and
# then list all of the system libraries.
#
@fList = sort {
# sort comparison function block
my $fa = substr($a, 0, 1);
my $fb = substr($b, 0, 1);
return $a cmp $b if ($fa eq '/') && ($fb eq '/');
return -1 if ($fb eq '/');
return 1 if ($fa eq '/' );
return $a cmp $b ;
} grep s/^_<//, keys %main:: ;
#
# Create a list box with all of our files to select from
#
$topLevel = $self->{main_window}->Toplevel(-title => "File Select", -overanchor => 'cursor') ;
$self->{current_file} = ""; # force a file reset
$self->{'main_window'}->destroy;
$self->{'main_window'} = undef;
$self->{int}->SetVar('event','run');
}
sub setup_menu_bar {
my ($self) = @_;
my $mw = $self->{main_window} ;
my $int = $self->{int};
# file menu in menu bar
my $items1 = [ [ command => 'About...', -command => sub { $self->DoAbout() ; } ],
[ command => 'Bug Report...', -command => 'puts "bugreport TBD"' ],
"-",
[ command => 'Open', -accelerator => 'Alt+O',
-underline => 0,
-command => sub { $self->DoOpen() ; } ],
[ command => 'Save Config...',
-underline => 0,
-command => \&DB::SaveState ],
[ command => 'Restore Config...',
-underline => 0,
-command => \&DB::RestoreState],
[ command => 'Goto Line...',
-underline => 0,
-accelerator => 'Alt-g',
-command => sub { $self->GotoLine() ; } ],
[ command => 'Find Text...',
-accelerator => 'Ctrl-f',
-underline => 0,
-command => sub { $self->FindText() ; } ],
[ command => "Tabs...", -command => \&do_tabs ],
"-",
[ command => 'Close Window and Run', -accelerator => 'Alt+W',
-underline => 6, -command => sub { $self->close_ptkdb_window ; } ],
[ command => 'Quit...', -accelerator => 'Alt+Q',
-underline => 0,
-command => sub { $self->DoQuit } ]
];
$mw->bind('<Alt-g>' => sub { $self->GotoLine() ; }) ;
$mw->bind('<Control-f>' => sub { $self->FindText() ; }) ;
$mw->bind('<Control-r>' => \&Devel::tkdb::DoRestart) ;
$mw->bind('<Alt-q>' => 'set event quit' );
$mw->bind('<Alt-w>' => sub { $self->close_ptkdb_window ; });
# Control Menu
my $runSub = sub { $DB::step_over_depth = -1 ; $int->SetVar('event','run') };
my $runToSub = sub { $int->SetVar('event','run') if $DB::window->SetBreakPoint(1) ; } ;
my $stepOverSub = sub { &DB::SetStepOverBreakPoint(0) ;
$DB::single = 1 ;
$int->SetVar('event','step');
} ;
my $stepInSub = sub {
$DB::step_over_depth = -1 ;
$DB::single = 1 ;
$int->SetVar('event','step');
};
my $returnSub = sub {
&DB::SetStepOverBreakPoint(-1) ;
$int->SetVar('event','run');
};
my $items2 = [ [ command => 'Run', -accelerator => 'Alt+r', -underline => 0, -command => $runSub ],
[ command => 'Run To Here', -accelerator => 'Alt+t', -underline => 5, -command => $runToSub ],
'-',
[ command => 'Set Breakpoint', -underline => 4, -command => sub { $self->SetBreakPoint ; }, -accelerator => 'Ctrl-b' ],
[ command => 'Clear Breakpoint', -command => sub { $self->UnsetBreakPoint } ],
[ command => 'Clear All Breakpoints', -underline => 6, -command => sub {
$DB::window->removeAllBreakpoints($DB::window->{current_file});
&DB::clearalldblines();
} ],
'-',
[ command => 'Step Over', -accelerator => 'Alt+N', -underline => 0, -command => $stepOverSub ],
[ command => 'Step In', -accelerator => 'Alt+S', -underline => 5, -command => $stepInSub ],
[ command => 'Return', -accelerator => 'Alt+U', -underline => 3, -command => $returnSub ],
'-',
[ command => 'Restart...', -accelerator => 'Ctrl-r', -underline => 0, -command => \&Devel::tkdb::DoRestart ],
'-',
[ checkbutton => 'Stop On Warning', -variable => \$DB::tkdb::stop_on_warning, -command => \&set_stop_on_warning ]
]; # end of control menu items
$mw->bind('<Alt-r>' => $runSub) ;
$mw->bind('<Alt-t>', $runToSub) ;
$mw->bind('<Control-b>', sub { $self->SetBreakPoint ; });
# step over a subroutine
for ('<F9>', '<Alt-n>') {
$mw->bind($_ => $stepOverSub);
}
# keys for step into a subroutine
for ('<Shift-F9>', '<Alt-s>') {
$mw->bind($_ => $stepInSub );
}
# return from a subroutine
$mw->bind('<Alt-u>' => $returnSub );
# Data Menu
my $items3 = [ [ command => 'Enter Expression', -accelerator => 'Alt+E', -command => sub { $self->EnterExpr() } ],
[ command => 'Delete Expression', -accelerator => 'Ctrl+D', -command => sub { $self->deleteExpr() } ],
[ command => 'Delete All Expressions', -command => sub {
$self->deleteAllExprs() ;
$self->{'expr_list'} = [];
} ],
'-',
[ command => 'Expression Eval Window...', -accelerator => 'F8', -command => sub { $self->setupEvalWindow() ; } ],
];
$mw->bind('<Alt-e>' => sub { $self->EnterExpr() } ) ;
$mw->bind('<Control-d>' => sub { $self->deleteExpr() } );
$mw->bind('<F8>', sub { $self->setupEvalWindow() ; }) ;
#
# Windows Menu
#
my $bsub = "focus $self->{text}";
my $csub = "focus $self->{quick_entry}";
my $dsub = "focus $self->{entry}";
my $items4 = [ [ command => 'Code Pane', -accelerator => 'Alt+0', -command => $bsub ],
[ command => 'Quick Entry', -accelerator => 'F9', -command => $csub ],
[ command => 'Expr Entry', -accelerator => 'F11', -command => $dsub ]
];
$mw->bind('<Alt-0>', $bsub);
$mw->bind('<F9>', $csub);
$mw->bind('<F11>', $dsub);
my $menu = $mw->Menu(-menuitems => [
[Cascade=>'File', -tearoff => 0, -underline=>0, -menuitems=>$items1],
[Cascade=>'Control', -tearoff=>0, -underline=>0, -menuitems => $items2],
[Cascade=>'Data', -tearoff=>0, -menuitems => $items3, -underline => 0],
[Cascade=>'Stack', -tearoff=>0, -underline => 2],
[Cascade=>'Bookmarks', -tearoff=>0, -underline=>0],
[Cascade=>'Windows', -tearoff=>0, -menuitems => $items4]
]);
#
# Stack menu
$self->{stack_menu} = $int->widget($menu->entrycget(4,'-menu'),'Menubutton');
#
# Bookmarks menu
$self->{bookmarks_menu} = $int->widget($menu->entrycget(5,'-menu'),'Menubutton');
$self->setup_bookmarks_menu();
$mw->config(-menu=>$menu);
#
# Bar for some popular controls
my $bb = $mw->Frame()->pack(-side => 'top');
$bb->Button(-text => "Step In", -command => $stepInSub) ->pack(-side => 'left');
$bb->Button(-text => "Step Over", -command => $stepOverSub) ->pack(-side => 'left');
$bb->Button(-text => "Return", -command => $returnSub) ->pack(-side => 'left');
$bb->Button(-text => "Run", -background => 'green', -command => $runSub) ->pack(-side => 'left');
$bb->Button(-text => "Run To", -command => $runToSub) ->pack(-side => 'left');
$bb->Button(-text => "Break", -command => sub { $self->SetBreakPoint ; } ) ->pack(-side => 'left');
$bb->Button(-text => "eval selection <F6>", -command => 'set event vexpr') ->pack(-side => 'left');
$mw->bind('<F6>', 'set event vexpr');
} # end of setup_menu_bar
sub edit_bookmarks {
my ($self) = @_ ;
my $top = $self->{main_window}->Toplevel(-title => "Edit Bookmarks");
my $list = $top->Scrolled('Listbox', -selectmode => 'multiple')->pack(qw/-side top -fill both -expand 1/);
my $deleteSub = sub {
my $cnt = 0 ;
for( $list->curselection ) {
$list->delete($_ - $cnt++) ;
}
};
my $okaySub = sub {
$self->{'bookmarks'} = [ $list->get(0, 'end') ] ; # replace the bookmarks
};
my $frm = $top->Frame()->pack(-side => 'top', -fill => 'x', -expand => 1 ) ;
$frm->Button(-text => 'Delete', -command => $deleteSub)->pack(-side => 'left', -fill => 'x', -expand => 1 );
$frm->Button(-text => 'Cancel', -command => "destroy $top")->pack(-side =>'left', -fill => 'x', -expand => 1 );
$frm->Button(-text => 'Okay', -command => $okaySub)->pack(-side => 'left', -fill => 'x', -expand => 1 );
$list->insert('end', @{$self->{'bookmarks'}}) ;
} # end of edit_bookmarks
sub setup_bookmarks_menu {
my ($self) = @_ ;
#
# "Add bookmark" item
#
my $bkMarkSub = sub { $self->add_bookmark() ; } ;
$self->{'bookmarks_menu'}->command(-label => "Add Bookmark",
-accelerator => 'Alt+k',
-command => $bkMarkSub);
$self->{'main_window'}->bind('<Alt-k>', $bkMarkSub) ;
# Subroutine called when the 'okay' button is pressed
#
sub FindSearch {
my ($self, $entry, $btn, $regExp) = @_ ;
my (@switches, $result) ;
my $txt = $entry->get() ;
return if $txt eq "" ;
push @switches, "-forward" if $self->{fwdOrBack} eq "forward" ;
push @switches, "-backward" if $self->{fwdOrBack} eq "backward" ;
if( $regExp ) {
push @switches, "-regexp" ;
}
else {
push @switches, "-nocase" ; # if we're not doing regex we may as well do caseless search
}
$result = $self->{'text'}->search(@switches, $txt, $self->{search_start}) ;
# untag the previously found text
$self->{'text'}->tagRemove('search_tag', @{$self->{search_tag}}) if defined $self->{search_tag} ;
if( !$result || $result eq "" ) {
# No Text was found
$btn->flash() ;
$btn->bell() ;
delete $self->{search_tag} ;
$self->{'search_start'} = "1.0" ;
}
else { # text found
$self->{'text'}->see($result) ;
# set the insertion of the text as well
$self->{'text'}->markSet(insert => $result) ;
my $len = length $txt;
if( $self->{fwdOrBack} ) {
$self->{search_start} = "$result +$len chars" ;
$self->{search_tag} = [ $result, $self->{search_start} ] ;
}
else {
# backwards search
$self->{search_start} = "$result -$len chars" ;
$self->{search_tag} = [ $result, "$result +$len chars" ] ;
}
# tag the newly found text
$self->{'text'}->tagAdd('search_tag', @{$self->{search_tag}}) ;
} # end of text found
$entry->_selectionRange(0, 'end');
} # end of FindSearch
#
# Support for the Find Text... Menu command
#
sub FindText {
my ($self) = @_ ;
my ($okayBtn);
#
# if we already have the Find Text Window open don't bother openning
# another, bring the existing one to the front.
if( $self->{find_window} ) {
$self->{find_window}->raise();
return;
}
$self->{search_start} = $self->{'text'}->index('insert') if( $self->{search_start} eq "" ) ;
#
# Subroutine called when the 'Dismiss' button is pushed.
my $dismissSub = sub {
$self->{'text'}->tagRemove('search_tag', @{$self->{search_tag}}) if defined $self->{search_tag} ;
$self->{search_start} = "" ;
$self->{find_window}->destroy;
delete $self->{search_tag} ;
delete $self->{find_window} ;
};
#
# Construct a dialog that has an entry field, forward, backward, regex option, okay and cancel buttons
#
my $top = $self->{main_window}->Toplevel(-title => "Find Text?");
my $we = $top->Entry()->pack(qw/-side top -fill both -expand 1/);
my $frm = $top->Frame()->pack(qw/-side top -fill both -expand 1/);
$self->{fwdOrBack} = 'forward';
$frm->Radiobutton(-text => "Forward", -value => 1, -variable => \$self->{fwdOrBack})
->pack(-side => 'left', -fill => 'both', -expand => 1);
$frm->Radiobutton(-text => "Backward", -value => 0, -variable => \$self->{fwdOrBack})
->pack(-side => 'left', -fill => 'both', -expand => 1);
my $regExp = 0 ;
$frm->Checkbutton(-text => "RegExp", -variable => \$regExp)
->pack(-side => 'left', -fill => 'both', -expand => 1);
# Okay and dismiss buttons
$okayBtn = $top->Button( -text => "Okay", -command => sub { $self->FindSearch($we, $okayBtn, $regExp) ; },
)->pack(-side => 'left', -fill => 'both', -expand => 1) ;
$we->bind('<Return>', sub { $self->FindSearch($we, $okayBtn, $regExp) ; }) ;
$top->Button( -text => "Dismiss",
-command => $dismissSub)->pack(-side => 'left', -fill => 'both', -expand => 1) ;
$top->protocol('WM_DELETE_WINDOW', $dismissSub) ;
$we->focus();
$self->{find_window} = $top;
} # end of FindText
sub main_loop {
( run in 1.923 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )