#!perl -w # sigeval.pl # This application demonstrates how to put a basic Perl/Tk application # together. use strict; use Tk 800.000; # These are all the modules that we are using in this script. use Tk::Frame; use Tk::TextUndo; use Tk::Text; use Tk::Scrollbar; use Tk::Menu; use Tk::Menubutton; use Tk::Adjuster; use Tk::DialogBox; # Main Window my $mw = new MainWindow; $mw->geometry('400x300'); # We need to split our application into three frames: # 1. A widget to contain a list of files from the current directory # 2. A widget that we can load a text file into, or copy/paste text into # 3. A widget to display the output of our Perl code created by # 'eval'ing the Perl code in the top text widget. # Frames # The Adjuster provides a splitter between the frames on the left and # the right so we can resize the frames vertically my $lf = $mw->Frame; # Left Frame; my $aj = $mw->Adjuster(-widget => $lf, -side => 'left'); my $rf = $mw->Frame; # Right Frame; # Menu Bar # This is the Tk 800.00 way to create a menu bar. The # menubar_menuitems() method returns an anonymous array containing all # the information that is needed to create a menu. my $mb = $mw->Menu(-menuitems => &menubar_menuitems() ); # The configure command tells the main window to use this menubar; # several menubars could be created and swapped in and out, if you # wanted to. $mw->configure(-menu => $mb); # Use the "Scrolled" Method to create widgets with scrollbars. # The listbox is our filename container. my($ListBox) = $lf->Scrolled('Listbox', -height => '0', -width => '0', -scrollbars => 'e', ); # The default key-bindings for the Text widgets and its derivatives # TextUndo, and ROText are emacs-ish, e.g. ctrl-a cursor to beginning # of line, ctrl-e, cursor to end of line, etc. # The 'o' in 'osoe' means optionally, so when the widget fills up, the # scrollbar will appear, otherwise we are binding the scrollbars to # the 'south' side and to the 'east' side of the frame. my($InputText) = $rf->Scrolled('TextUndo', -height => '1', -width => '1', -scrollbars => 'osoe', ); # We use the 'Text' widget here because we do not need to edit # anything in the widget. We could have used 'ROText' here as well # (Read Only Text Widget). my($OutputText) = $rf->Scrolled('Text', -height => '1', -width => '1', -scrollbars => 'osoe', ); # Load filenames into the listbox. opendir DIR, "."; $ListBox->insert('end', grep { -f $_ } readdir DIR); close DIR; # Binding subs to events # Every widget that is created in the Perl/Tk application either # creates events or reacts to events. # Callbacks are subs that are used to react to events. A callback is # nothing more than a sub that is bound to a widget. # The most common ways to bind a sub to an event are by using an # anonymous sub with a call to your method inside it, such as in the # following 'Key' bindings, or with a reference to the callback sub, # as in the 'ButtonRelease' binding. # Left mouse button loads file and eval's if .pl suffix. See the # OnLoad sub for more details. $ListBox->bind('', [\&OnLoad] ); # CTRL-L, eval text widget contents $mw->bind('Tk::TextUndo', '', sub { OnEval(); } ); # CTRL-O, load a text file into the text widget $mw->bind('Tk::TextUndo', '', sub { OnFileOpen(); } ); # CTRL-S, save text as with file dialog $mw->bind('Tk::TextUndo', '', sub { OnFileSave(); } ); # CTRL-Q, quit this application $mw->bind('Tk::TextUndo', '', sub { OnExit(); } ); # Pack everything # IMPORTANT: if you don't pack it, it probably won't show the way you # want it to, or even not show up at all! # some things to try: # 1. change the order of $lf, $aj, and $rf # 2. add -expand 1 to ListBox # 3. comment out this section so widgets are not packed $lf->pack(qw/-side left -fill y/); $aj->pack(qw/-side left -fill y/); $rf->pack(qw/-side right -fill both -expand 1/); $ListBox ->pack(qw/-side left -fill both -expand 1/); $InputText ->pack(qw/-side top -fill both -expand 1/); $OutputText->pack(qw/-side bottom -fill both -expand 1/); # Start the main event loop MainLoop; exit 0; # return an anonymous list of lists describing the menubar menu items sub menubar_menuitems { return [ map ['cascade', $_->[0], -tearoff=> 0, -menuitems => $_->[1]], # make sure you put the parens here because we want to # evaluate and not just store a reference ['~File', &file_menuitems()], ['~Help', &help_menuitems()], ]; } sub file_menuitems { # 'command', tells the menubar that this is not a label for a sub # menu, but a binding to a callback; the alternate here is 'cascade' # Try uncommenting the following code to create an 'Operations' sub # menu in the main 'File' menu. return [ # [qw/cascade Operations -tearoff 0 -menuitems/ => # [ # [qw/command ~Open -accelerator Ctrl-o/, # -command=>[\&OnFileOpen]], # [qw/command ~Save -accelerator Ctrl-s/, # -command=>[\&OnFileSave]], # ] # ], [qw/command ~Open -accelerator Ctrl-o/, -command=>[\&OnFileOpen]], [qw/command ~Save -accelerator Ctrl-s/, -command=>[\&OnFileSave]], '', [qw/command E~xit -accelerator Ctrl-q/, -command=>[\&OnExit]], ]; } sub help_menuitems { return [ ['command', 'About', -command => [\&OnAbout]] ]; } # Here is our "Exit The Application" callback method. :-) sub OnExit { exit 0; } # The TextUndo widget has a file load dialog box method built-in! sub OnFileOpen { $InputText->FileLoadPopup(); } # The TextUndo widget has a file save dialog box method built-in! sub OnFileSave { $InputText->FileSaveAsPopup(); # refresh the list box &LoadListBox(); } sub LoadListBox { # Remove current contents otherwise we would just append the # filenames to the end, and this is not what we want. $ListBox->delete('0.1', 'end'); # Just use a plain old grep readdir pipeline to create a list of # filenames for our listbox. opendir DIR, "."; $ListBox->insert('end', grep { -f $_ && -r $_ } readdir DIR); close DIR; } # Show the Help->About Dialog Box sub OnAbout { # Construct the DialogBox my $about = $mw->DialogBox( -title=>"About Jack", -buttons=>["OK"] ); # Now we need to add a Label widget so we can show some text. The # DialogBox is essentially an empty frame with no widgets in it. # You can images, buttons, text widgets, listboxes, etc. $about->add('Label', -anchor => 'w', -justify => 'left', -text => qq( Perl Eval-uator v1.0 by David Hisel -Click on a filename to view it, and if it has a ".pl" suffix, it will be evaluated automatically, or -Copy and paste Perl code to the top window, then -Hit CTRL-L to evaluate the code and display the output in the bottom text widget. ) )->pack; $about->Show(); } # Load a file into the $InputText widget sub OnLoad { # Getting the text of the selected item in a listbox is a two step # process, first you get the index and then, using the index, my ($index) = $ListBox->curselection(); # fetch the contents from the listbox. my $filename = $ListBox->get($index); # TextUndo widget has a built-in Load sub! $InputText->Load( $filename ); # we need to make sure we don't eval ourself otherwise we crash (my $script = $0) =~ s,.*(\/|\\),,; # If it ends in ".pl" automatically eval the code &OnEval() if $filename =~ /\.pl$/ && $filename !~ /$script/; } #evaluates code in the entry text pane sub OnEval{ # The Text widget has a TIEHANDLE module implemented so that you # can tie the text widget to STDOUT for print and printf; note, if # you used the "Scrolled" method to create your text widget, you # will have to get a reference to it and pass that to "tie", # otherwise it won't work. my $widget = $OutputText->Subwidget("text"); tie *STDOUT, ref $widget, $widget; # need "no strict;" otherwise we can't run obfu nor other japh's eval ("no strict;".$InputText->get(0.1, 'end')); # be polite and output an error if something goes wrong. print "ERROR:$@" if $@; print "\n"; }