#!/usr/bin/env perl #use strict; # with 'strict', using this tool would be less comfortable use warnings; no warnings 'redefine'; # use Tk; use Tk::CodeText; use Data::Dumper; use Storable; use Tie::IxHash; my $VERSION = "0.40"; =head1 NAME workspace.pl - A graphical multi-line shell for Perl using Tk. =head1 SYNOPSIS This is a window-based multi-line shell for Perl using Tk. It intends to mimic the Smalltalk Workspace as well as the Lisp SMILE system. =head1 DESCRIPTION =head2 Multiline Shell Type one or more lines of Perl code into the main window and click "Do it" to execute that code. If the code produces some output, this output is shown. The grey background color indicates output mode where no commands can be entered. Clicking on the "Edit" / "Output" button switches between edit and output mode. =head2 Run Perl Code from an external editor =head2 Key Bindings =over 4 =item Alt-d Executes the "Do It" command if in edit mode. =item Alt-e Switches between "Edit" and "Output" mode. =item Alt-[Cursor up] One step back in the command history. =item Alt-[Cursor down] One step forward in the command history. =item Alt-m Show a list with all loaded files (modules). =item Alt-c Clears the edit window if in edit mode. =item Control-a Selects the entire text. =item Control-z Undo =item Control-y Redo =item Alt-h Displays this help message. =back =cut # saves loaded files - useful for _ws_show_modules() my %_ws_startINC; BEGIN { %_ws_startINC = %INC } my $_ws_code; # der aktuell auszufhrende Code my $_ws_output; # Ausgabe des zuletzt ausgeführten Codes my $_ws_old_stdout; # "Pointer" to the actual STDOUT my $_ws_mode=1; # 1: Edit, 0:Output my %_ws_hist_hash; # Befehlsspeicher: Hashzugriff my $_ws_history = tie %_ws_hist_hash, 'Tie::IxHash'; # Befehlsspeicher: Objektzugriff my $_ws_history_ptr; # History-Zeiger # capture STDOUT in a variable and hide console window on Win32 BEGIN { close STDOUT; open STDOUT, '>', \$_ws_output; if ($^O eq 'MSWin32') { require Win32::Console; Win32::Console::Free(); } } my $_WS_MAX_HISTORY = 50; # maximale Anzahl zu speichernder Befehle my @_MODE_BUT = ('Edit','Output'); # Beschriftung fuer Switchbutton my $HISTORY_FILE = '_ws_history.db'; # Dateiname der History my $_WS_MAGIC_LINE = '# pws-magic-line'; # a magical line for accepting external commands # Load history from file &_ws_load_history($HISTORY_FILE); ########################################################## # # BEGIN UI CODE # Main window my $mw = MainWindow->new; # Menu my $_ws_menubar = $mw->Frame( -relief => "raised", -borderwidth => 2) ->pack (-anchor => "nw", -fill => "x"); $_ws_file_menu = $_ws_menubar->Menubutton( -text => "File", -underline => 1, -menuitems => [ [ Button => "Execute (Do It)", -command => \&_ws_do_execute ], [ Button => "Toggle Edit/Output", -command => \&_ws_switch_mode ], [Separator => ''], [ Button => "Quit", -command => sub { exit } ] ])->pack (-side => "left"); $_ws_file_menu = $_ws_menubar->Menubutton( -text => "Help", -underline => 1, -menuitems => [ [ Button => "Show Modules", -command => \&_ws_show_modules ], [ Button => "Help", -command => \&_ws_display_help ] ])->pack (-side => "left"); # some Frames my $but_frame = $mw->Frame()->pack(); # status line at the bottom my $status_frame = $mw->Frame()->pack(); my $_ws_status_line = $status_frame->Label(-foreground=>'red')->pack(-fill => 'x', -side => 'bottom'); # frame for text area my $text_frame = $mw->Frame(); $text_frame->pack(-expand => 'yes', -fill => 'both'); # text input area with scrollbars my $text_area = $text_frame->Scrolled( "CodeText", -scrollbars => 'ose', -wrap => 'none', -tabs => ['0.75c'], -syntax => 'Perl', -autoindent => 1 )->pack; $text_area->pack(-expand => 'yes', -fill => 'both', -side => 'left'); # # Execute Button # dient dem Ausführen des Codes im Workspace my $but_exec = $but_frame->Button(-text => 'Do It', -command => \&_ws_do_execute ); $but_exec->pack(-side => 'left', -padx => 6); $mw->bind('', \&_ws_do_execute); # # EditOutput Button # schaltet zwischen Eingabe- und Ausgabemodus hin und her my $but_edit = $but_frame->Button(-text => $_MODE_BUT[$_ws_mode], -command => \&_ws_switch_mode ); $but_edit->pack(-side => 'left', -padx => 6); $mw->bind('', \&_ws_switch_mode); # # History Buttons # zum Durchschalten der History my $hist_back = $but_frame->Button(-text => '^', -command => \&_ws_history_back ); $hist_back->pack(-side => 'left', -padx => 6); $mw->bind('', \&_ws_history_back); my $hist_fwd = $but_frame->Button(-text => 'v', -command => \&_ws_history_fwd ); $hist_fwd->pack(-side => 'left', -padx => 6); $mw->bind('', \&_ws_history_fwd); # # sonstige Key-Bindings # # CTRL-a: select all $mw->bind('', sub { $text_area->selectAll; } ); # # ALT-c: clear the entire edit window $mw->bind('', sub { _ws_show_cmd(''); } ); # # ALT-m: show a list with all loaded files $mw->bind('', sub { &_ws_show_modules; } ); # # ALT-h: show a list with all loaded files $mw->bind('', sub { &_ws_display_help; } ); # # Any-KeyPress: clears the status line #$mw->bind('', sub { _ws_display_status(''); } ); # Fokus auf Editorfeld setzen $text_area->focus; # a handler for a graceful shutdown $mw->OnDestroy( \&_ws_exit ); # XXX Test #$mw->repeat(2000, sub { _ws_display_status(localtime); } ); # start a watcher thread that's used to communicate with external editors $mw->repeat(500, sub { &_ws_watch_clipboard; } ); _ws_init(); MainLoop; # ENDE UI-CODE # ########################################################## exit; ########################################################## # # R O U T I N E S # =head1 SUBROUTINES =head2 _ws_do_execute Executes the Perl code displayed in the edit window. If this code produces some output, the display switches to output mode and shows the output. If an error occurs the error messages gets displayed in the status line at the bottom of the window. If the code was successfully executed but no output has been generated, the status line displays the hint 'Command executed'. =cut sub _ws_do_execute { return 0 if $_ws_mode==0; # Statuszeile leeren _ws_display_status(''); # Code im Workspace zwischenspeichern $_ws_code = $text_area->get('1.0','end'); $_ws_code =~ s/\n+$/\n/gs; # Code im Workspace ausführen close STDOUT; $_ws_output = ''; open STDOUT, '>', \$_ws_output; eval $_ws_code; if( $@ ) { # Fehler? Fehlermeldung in Statuszeile schreiben $_ws_output = $@; _ws_display_status("Error: $_ws_output"); } elsif( $_ws_output eq '' ) { # Falls keine Ausgabe erfolgte: Meldung in Statuszeile schreiben. _ws_display_status('Command executed.'); # .. and clear after two seconds $mw->after(2000, sub { _ws_display_status(''); } ); } else { # Workspace durch Ausgabe des Code ersetzen und als nicht-editierbar markieren &_ws_switch_mode; } # Befehl in Speicher ablegen _ws_save_history( $_ws_code ); } =head2 _ws_init Presents some welcome message. =cut sub _ws_init { $_ws_code=<<'_WS_INIT'; # Welcome to the Perl Workspace! # c 2006 Stefan Fischerländer # www.fischerlaender.de # # ALT-h Display help text. # ALT-e Toogle between edit (white background) and output (grey background) view. # ALT-d Execute Perl code currently in the edit window. # ALT-c Clears the edit window. # ALT-[up/down] Navigate within the command history. # _WS_INIT _ws_show_mode(1); } =head2 _ws_watch_clipboard Watches the system clipboard for a magic command. If this magic command is present in the system clipboard, the content of the clipboard gets executed. Useful for seamless communication with text editors. =cut sub _ws_watch_clipboard { my $cmd; Tk::catch { $cmd = $text_area->SelectionGet( -selection => 'CLIPBOARD' ) }; if( ! $@ ) { if( $cmd =~ m/$_WS_MAGIC_LINE/ ) { $cmd =~ s/$_WS_MAGIC_LINE\n//s; $_ws_code = $cmd; _ws_show_mode( 1 ); $mw->clipboardClear; $text_area->focusForce; &_ws_do_execute; } } } =head2 _ws_save_history CMD Appends the command CMD to the history array. A maximum of MAX_HISTORY entries are saved. =cut sub _ws_save_history { my $cmd = shift; chomp $cmd; $_ws_history->Delete( $cmd ); $_ws_history->Push( $cmd => 1 ); $_ws_history->Shift if $_ws_history->Length > $_WS_MAX_HISTORY; $_ws_history_ptr = $_ws_history->Length; } =head2 _ws_load_history FILE Loads the history from FILE. =cut sub _ws_load_history { my $file = shift; if( -e $file ) { %_ws_hist_hash = %{ retrieve($file) }; $_ws_history_ptr = $_ws_history->Length; } } =head2 _ws_switch_mode Toggles between edit and output mode. =cut sub _ws_switch_mode { $_ws_mode ? ($_ws_mode=0) : ($_ws_mode=1); _ws_show_mode( $_ws_mode ); $but_edit->configure(-text => $_MODE_BUT[$_ws_mode]); } =head2 _ws_show_mode MODE Displays the window in the indicated mode. mode == 0 Output View mode == 1 Command View =cut sub _ws_show_mode { $_ws_mode = shift; if( $_ws_mode == 0 ) { $text_area->delete('1.0','end'); $text_area->insert('1.0', $_ws_output); $text_area->configure(-background=>'#eee', -state=>'disabled'); } if( $_ws_mode == 1 ) { $text_area->configure(-background=>'white', -state=>'normal'); $text_area->delete('1.0','end'); $text_area->insert('1.0', $_ws_code); } $but_edit->configure(-text => $_MODE_BUT[$_ws_mode]); } =head2 _ws_history_back One step back in the command history. =cut sub _ws_history_back { return 0 if $_ws_mode==0; if( $_ws_history_ptr > 0 ) { $_ws_history_ptr--; _ws_show_cmd( $_ws_history->Keys( $_ws_history_ptr ) ); } } =head2 _ws_history_fwd One step forward in the command history. =cut sub _ws_history_fwd { return 0 if $_ws_mode==0; if( $_ws_history_ptr < $_ws_history->Length ) { $_ws_history_ptr++; _ws_show_cmd( $_ws_history->Keys( $_ws_history_ptr ) ); } } =head2 _ws_show_cmd CMD Displays the command CMD in the edit window and set $_ws_code to CMD. (only in edit mode) =cut sub _ws_show_cmd { my $cmd = shift; return 0 if $_ws_mode==0; $_ws_code = $cmd; $text_area->delete('1.0','end'); $text_area->insert('1.0', $cmd ); } =head2 _ws_exit Does some cleaning work just before the application is terminated. =cut sub _ws_exit { # saves the history to file store( \%_ws_hist_hash, $HISTORY_FILE); } =head2 _ws_show_modules Show what files where loaded. (inspired by Devel::Loaded) =cut sub _ws_show_modules { my $output = "Loaded files / modules:\n"; for my $path ( values %INC) { $output .= $path."\n" unless $_ws_startINC{$path}; } $_ws_output = $output; _ws_show_mode( 0 ); } =head2 _ws_display_status TEXT Displays TEXT in the status line. =cut sub _ws_display_status { my $text = shift; $_ws_status_line->configure(-text => $text); } =head1 _ws_display_help Displays a help text. =cut sub _ws_display_help { my $filename = __FILE__; my $output = `pod2text "$filename"`; $_ws_output = $output; _ws_show_mode( 0 ); } __END__ =head1 TODO =over 4 =item rename variables to reduce the chance of conflicts =item communication with text editors exchanging code snippets (like Lisp / SLIME) idea 1: via a special file for which workspace.pl is loooking every 200ms idea 2: using the system clipboard and a helper program, that siganls the presence of a command to execute in the clipboard =item graphical browser for the command history =item Smalltalk-like source image A 'sub' can be checked into an image via Alt-i. An image is basically a Hash-of-Arrays, where the keys are the name of the subs. The array holds several versions of a sub. =item intelligent history logging e.g. for a redefined sub just save the last definition =back =head1 PREREQUISITES This script requires several modules: C, C, C, C, C =head1 AUTHOR Stefan Fischerlaender stefanATfischerlaenderDOTde =for html Homepage: www.fischerlaender.de Copyright (c) 2006 Stefan Fischerländer. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Modified versions must be clearly indicated. =head1 VERSION Version 0.40 - 11 Jul 2006 =head1 CHANGES =over =item workspace-0.40.pl - 11 Jul 2006 first public release =back =pod SCRIPT CATEGORIES UNIX/System_administration =cut