<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/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 auszuf�hrende 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, '&gt;', \$_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
&amp;_ws_load_history($HISTORY_FILE);



##########################################################
#
# BEGIN UI CODE


# Main window
my $mw = MainWindow-&gt;new;
# Menu
my $_ws_menubar = $mw-&gt;Frame(	-relief			=&gt; "raised",
                        		-borderwidth	=&gt; 2)
                		-&gt;pack (-anchor			=&gt; "nw",
                        		-fill			=&gt; "x");
$_ws_file_menu = $_ws_menubar-&gt;Menubutton(	-text		=&gt; "File",
											-underline	=&gt; 1,
											-menuitems	=&gt; [
						[ Button =&gt; "Execute (Do It)", -command =&gt; \&amp;_ws_do_execute ],
						[ Button =&gt; "Toggle Edit/Output", -command =&gt; \&amp;_ws_switch_mode ],
						[Separator =&gt; ''],
						[ Button =&gt; "Quit", -command =&gt; sub { exit } ]
											])-&gt;pack (-side =&gt; "left");
$_ws_file_menu = $_ws_menubar-&gt;Menubutton(	-text		=&gt; "Help",
											-underline	=&gt; 1,
											-menuitems	=&gt; [
						[ Button =&gt; "Show Modules", -command =&gt; \&amp;_ws_show_modules ],
						[ Button =&gt; "Help", -command =&gt; \&amp;_ws_display_help ]
											])-&gt;pack (-side =&gt; "left");
# some Frames
my $but_frame = $mw-&gt;Frame()-&gt;pack();
# status line at the bottom
my $status_frame = $mw-&gt;Frame()-&gt;pack();
my $_ws_status_line = $status_frame-&gt;Label(-foreground=&gt;'red')-&gt;pack(-fill =&gt; 'x', -side =&gt; 'bottom');
# frame for text area
my $text_frame = $mw-&gt;Frame();
$text_frame-&gt;pack(-expand =&gt; 'yes', -fill =&gt; 'both');
# text input area with scrollbars
my $text_area = $text_frame-&gt;Scrolled(	"CodeText",
										-scrollbars =&gt; 'ose',
										-wrap =&gt; 'none',
										-tabs =&gt; ['0.75c'],
										-syntax =&gt; 'Perl',
										-autoindent =&gt; 1 )-&gt;pack;
$text_area-&gt;pack(-expand =&gt; 'yes', -fill =&gt; 'both', -side =&gt; 'left');
#
# Execute Button
# 	dient dem Ausf�hren des Codes im Workspace
my $but_exec = $but_frame-&gt;Button(-text =&gt; 'Do It', -command =&gt; \&amp;_ws_do_execute );
$but_exec-&gt;pack(-side =&gt; 'left', -padx =&gt; 6);
$mw-&gt;bind('&lt;Alt-d&gt;', \&amp;_ws_do_execute);
#
# EditOutput Button
#	schaltet zwischen Eingabe- und Ausgabemodus hin und her
my $but_edit = $but_frame-&gt;Button(-text =&gt; $_MODE_BUT[$_ws_mode], -command =&gt; \&amp;_ws_switch_mode );
$but_edit-&gt;pack(-side =&gt; 'left', -padx =&gt; 6);
$mw-&gt;bind('&lt;Alt-e&gt;', \&amp;_ws_switch_mode);
#
# History Buttons
#	zum Durchschalten der History
my $hist_back = $but_frame-&gt;Button(-text =&gt; '^', -command =&gt; \&amp;_ws_history_back );
$hist_back-&gt;pack(-side =&gt; 'left', -padx =&gt; 6);
$mw-&gt;bind('&lt;Alt-Up&gt;', \&amp;_ws_history_back);
my $hist_fwd = $but_frame-&gt;Button(-text =&gt; 'v', -command =&gt; \&amp;_ws_history_fwd );
$hist_fwd-&gt;pack(-side =&gt; 'left', -padx =&gt; 6);
$mw-&gt;bind('&lt;Alt-Down&gt;', \&amp;_ws_history_fwd);

#
# sonstige Key-Bindings
#
# CTRL-a: select all
$mw-&gt;bind('&lt;Control-a&gt;', sub { $text_area-&gt;selectAll; } );
#
# ALT-c: clear the entire edit window
$mw-&gt;bind('&lt;Alt-c&gt;', sub { _ws_show_cmd(''); } );
#
# ALT-m: show a list with all loaded files
$mw-&gt;bind('&lt;Alt-m&gt;', sub { &amp;_ws_show_modules; } );
#
# ALT-h: show a list with all loaded files
$mw-&gt;bind('&lt;Alt-h&gt;', sub { &amp;_ws_display_help; } );
#
# Any-KeyPress: clears the status line
#$mw-&gt;bind('&lt;Any-KeyPress&gt;', sub { _ws_display_status(''); } );


# Fokus auf Editorfeld setzen
$text_area-&gt;focus;

# a handler for a graceful shutdown
$mw-&gt;OnDestroy( \&amp;_ws_exit );

# XXX Test
#$mw-&gt;repeat(2000, sub { _ws_display_status(localtime); } );

# start a watcher thread that's used to communicate with external editors
$mw-&gt;repeat(500, sub { &amp;_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-&gt;get('1.0','end');
	$_ws_code =~ s/\n+$/\n/gs;


	# Code im Workspace ausf�hren
	close STDOUT;
	$_ws_output = '';
	open STDOUT, '&gt;', \$_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-&gt;after(2000, sub { _ws_display_status(''); } );
	} else {
		# Workspace durch Ausgabe des Code ersetzen und als nicht-editierbar markieren
		&amp;_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=&lt;&lt;'_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-&gt;SelectionGet( -selection =&gt; 'CLIPBOARD' ) };
	if( ! $@ ) {
		if( $cmd =~ m/$_WS_MAGIC_LINE/ ) {
			$cmd =~ s/$_WS_MAGIC_LINE\n//s;
			$_ws_code = $cmd;
			_ws_show_mode( 1 );
			$mw-&gt;clipboardClear;
			$text_area-&gt;focusForce;
			&amp;_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-&gt;Delete( $cmd );
	$_ws_history-&gt;Push( $cmd =&gt; 1 );
	$_ws_history-&gt;Shift if $_ws_history-&gt;Length &gt; $_WS_MAX_HISTORY;
		
	$_ws_history_ptr = $_ws_history-&gt;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-&gt;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-&gt;configure(-text =&gt; $_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-&gt;delete('1.0','end');
		$text_area-&gt;insert('1.0', $_ws_output);
		$text_area-&gt;configure(-background=&gt;'#eee', -state=&gt;'disabled');
	}
	if( $_ws_mode == 1 ) {
		$text_area-&gt;configure(-background=&gt;'white', -state=&gt;'normal');
		$text_area-&gt;delete('1.0','end');
		$text_area-&gt;insert('1.0', $_ws_code);
	}
	$but_edit-&gt;configure(-text =&gt; $_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 &gt; 0 ) {
		$_ws_history_ptr--;
		_ws_show_cmd( $_ws_history-&gt;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 &lt;  $_ws_history-&gt;Length ) {
		$_ws_history_ptr++;
		_ws_show_cmd( $_ws_history-&gt;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-&gt;delete('1.0','end');
	$text_area-&gt;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-&gt;configure(-text =&gt; $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&lt;Tk&gt;, C&lt;Tk::CodeText&gt;, C&lt;Storable&gt;, C&lt;Tie::IxHash&gt;, C&lt;Data::Dumper&gt;



=head1 AUTHOR

Stefan Fischerlaender stefanATfischerlaenderDOTde

=for html Homepage: &lt;a href="http://www.fischerlaender.de"&gt;www.fischerlaender.de&lt;/a&gt;

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
</pre></body></html>