App-Prima-REPL
2 results

 view release on metacpan or  search on metacpan

bin/prima-repl  view on Meta::CPAN 

	
	# Load PDL::Graphics::Prima if they have it
	$loaded_Prima_Graphics = 0;
	eval {
		require PDL::Graphics::Prima;
		PDL::Graphics::Prima->import;
		require PDL::Graphics::Prima::Simple;
		PDL::Graphics::Prima::Simple->import;
		$loaded_Prima_Graphics = 1;
	};
	print $@ if $@ and $@ !~ /^Can't locate/;
}

my $app_filename = File::Spec->catfile($FindBin::Bin, $FindBin::Script);
my $version = 0.3;

#########################
# Main Application Code #
#########################

package REPL;
my $history_output_handler = PrimaX::InputHistory::Output::REPL->new;

our @text_file_extension_list = (
		  ['Perl scripts'		=> '*.pl'	]
		, ['PDL modules'		=> '*.pdl'	]
		, ['Perl modules'		=> '*.pm'	]
		, ['POD documents'	=> '*.pod'		]
		, ['Test suite'		=> '*.t'		]
		, ['All'				=> '*'		]
);

# A dialog box that will be used for opening and saving files:
our $open_text_dialog = Prima::OpenDialog-> new(filter => \@text_file_extension_list);
our $open_dialog = Prima::OpenDialog->new(filter => [[All => '*']]);

# Very handy functions that I use throughout, but which I define later.
sub goto_page;
sub goto_output;
sub warn {
	chomp(my $text = join('', @_));
	warn $text . "\n";
	goto_output;
}

our $padding = 10;
our $window = Prima::MainWindow->new(
#	pack => { fill => 'both', expand => 1, padx => $padding, pady => $padding },
	text => 'Prima REPL',
	size => [600, 600], 
);
	# Add a notbook with output tab:
	our $notebook = $window->insert(TabbedScrollNotebook =>
		pack => { fill => 'both', expand => 1, padx => $padding, pady => $padding },
		tabs => ['Output'],
		style => tns::Simple,
	);
		our $output = $notebook->insert_to_page(0, Edit =>
			pack => { fill => 'both', expand => 1, padx => $padding, pady => $padding },
			text => '',
			cursorWrap => 1,
			wordWrap => 1,
			readOnly => 1,
			backColor => cl::LightGray,
			font => { name => 'courier new'},

		);
		# Over-ride the defaults for these:
		$output->accelTable->insert([
			  ['', '', km::Ctrl | kb::PageUp,	\&goto_prev_page	]	# previous
			, ['', '', km::Ctrl | kb::PageDown,	\&goto_next_page	]	# next
		], '', 0);

	# Add the eval line:
	our $inline = PrimaX::InputHistory->create(
		owner => $window,
		text => '',
		pack => {fill => 'both', after => $notebook, padx => $padding, pady => $padding},
		storeType => ih::NoRepeat,
		outputWidget => $history_output_handler,
		onCreate => sub {
			my $self = shift;
			
			# Open the file and set up the history:
			my @history;
			if (-f $fileName) {
				open my $fh, '<', $fileName;
				while (<$fh>) {
					chomp;
					push @history, $_;
				}
				close $fh;
			}
			
			# Store the history and revisions:
			$self->history(\@history);
		},
		onDestroy => sub {
			my $self = shift;
			
			# Save the last N lines in the history file:
			open my $fh, '>', $fileName;
			# I want to save the *last* 200 lines, so I don't necessarily start at
			# the first entry in the history:
			my $offset = 0;
			my @history = @{$self->history};
			$offset = @history - $historyLength if (@history > $historyLength);
			while ($offset < @history) {
				print $fh $history[$offset++], "\n";
			}
			close $fh;
		},
		onKeyUp => sub {
			main::my_keyup(@_);
		},
	);
# working here - a simple hack; override main::my_keyup to play with the
# keyup callback on the input line.
sub main::my_keyup {};
	# Add the special accelerators seperately:
	# Update the accelerators.

bin/prima-repl  view on Meta::CPAN 

	# Make the editor the default widget for this page.
	push @default_widget_for, $inline;
	
	# Return the page widget and page number if they expect multiple return
	# values; or just the page widget.
	return ($page_widget, $page_no) if wantarray;
	return $page_widget if defined wantarray;
}

################################################################################
# Usage      : REPL::change_default_widget($index, $widget)
# Purpose    : changes the default widget for the tab with the given index
# Returns    : nothing
# Parameters : the tab's index (returned in list context from create_new_tab)
#            : the widget to get attention when CTRL-i is pressed
# Throws     : never
# Comments   : none
################################################################################
sub change_default_widget {
	my ($index, $widget) = @_;
	$default_widget_for[$index] = $widget;
}

################################################################################
# Usage      : REPL::get_default_widget($index)
# Purpose    : retrieves the default widget for the tab with the given index
# Returns    : the default widget
# Parameters : the tab's index (returned in list context from create_new_tab)
# Throws     : never
# Comments   : use this to modify the default widget's properties, if needed
################################################################################
sub get_default_widget {
	my ($index) = @_;
	return $default_widget_for[$index];
}

################################################################################
# Usage      : REPL::endow_editor_widget($widget)
# Purpose    : Sets the properties of an edit widget so it behaves like a
#            : multiline buffer.
# Returns    : nothing
# Parameters : the widget to endow
# Throws     : when you supply an object not derived from Prima::Edit
# Comments   : none
################################################################################
sub endow_editor_widget {
	my $widget = shift;
	
	# Verify the object
	croak("endow_editor_widget expects a Prima::Edit widget")
		unless eval{$widget->isa("Prima::Edit")};
	
	# Allow for insertions, deletions, newlines, etc
	$widget->set(
		tabIndent => 4,
		syntaxHilite => 1,
		wantTabs => 1,
		wantReturns => 1,
		wordWrap => 0,
		autoIndent => 1,
		cursorWrap => 1,
		font => { pitch => fp::Fixed, style => fs::Bold, name => 'courier new'},
	);

	# Update the accelerators.
	my $accTable = $widget->accelTable;

	# Add some functions to the accelerator table
	$accTable->insert([
		# Ctrl-Enter runs the file
		  ['CtrlReturn', '', kb::Return 	| km::Ctrl,  sub{main::run_file()}				]
		, ['CtrlEnter', '', kb::Enter  	| km::Ctrl,  sub{main::run_file()}				]
		# Ctrl-Shift-Enter runs the file and selects the output window
		, ['CtrlShiftReturn', '', kb::Return 	| km::Ctrl | km::Shift,	\&main::run_file_with_output	]
		, ['CtrlShiftEnter', '', kb::Enter  	| km::Ctrl | km::Shift,	\&main::run_file_with_output	]
		# Ctrl-PageUp/PageDown don't work by default, so add them, too:
		, ['CtrlPageUp', '', kb::PageUp 	| km::Ctrl,  \&REPL::goto_prev_page				]
		, ['CtrlPageDown', '', kb::PageDown | km::Ctrl,  \&REPL::goto_next_page				]
		]
		, ''
		, 0
	);
}

# closes the tab number, or name if provided, or current if none is supplied
# ENCOUNTERIMG TROUBLE WITH THIS, working here
sub close_tab {
	# Get the desired tab; default to current tab:
	my $to_close = shift || $notebook->pageIndex + 1;	# user counts from 1
	my @tabs = @{$notebook->tabs};
	if ($to_close =~ /^\d+$/) {
		$to_close--;	# correct user's offset by 1
		$to_close += $notebook->pageCount if $to_close < 0;
		# Check that a valid value is used:
		return REPL::warn("You cannot remove the output tab")
			if $to_close == 0;
		
		# Close the tab
		CORE::warn "Internal: Not checking if the file needs to be saved."
			if eval{$default_widget_for[$to_close]->isa('Prima::Edit')};
		splice @tabs, $to_close, 1;
		splice @default_widget_for, $to_close, 1;
		$notebook->Notebook->delete_page($to_close);
	}
	else {
		# Provided a name. Close all the tags with the given name:
		my $i = 1;	# Start at tab #2, so they can't close the Output tab
		$to_close = qr/$to_close/ unless ref($to_close) eq 'Regex';
		while ($i < @tabs) {
			if ($tabs[$i] eq $to_close) {
				CORE::warn "Internal: Not checking if the file needs to be saved."
					if eval{$default_widget_for[$to_close]->isa('Prima::Edit')};
				$notebook->Notebook->delete_page($_);
				splice @default_widget_for, $i, 1;
				splice @tabs, $i, 1;
				redo;
			}
			$i++;
		}
	}

bin/prima-repl  view on Meta::CPAN 

	}
	print $fh $$textRef;
	close $fh;
}

# A function to run the contents of a multiline environment
sub run_file {
	my $page = shift || $notebook->pageIndex + 1;
	$page--;	# user starts counting at 1, not 0
	croak("Can't run output page!") if $page == 0;
	
	# Get the text from the multiline and run it:
	my $text = $default_widget_for[$page]->text;

	my_eval($text);

	# If error, switch to the console and print it to the output:
	if ($@) {
		my $message = $@;
		my $tabs = $notebook->tabs;
		my $header = "----- Error running ". $tabs->[$page]. " -----";
		$message = "$header\n$message\n" . ('-' x length $header);
		REPL::warn($message);
		$@ = '';
	}
}

# Change the name of a tab
sub name {
	my $name = shift;
	my $page = shift || $notebook->pageIndex + 1;
	my $tabs = $notebook->tabs;
	$tabs->[$page - 1] = "$name, #$page";
	$notebook->tabs($tabs);
}


# convenience function for clearing the output:
my $output_line_number = 0;
my $output_column = 0;
sub clear {
	$output->text('');
	$output_line_number = 0;
	$output_column = 0;
}

# Convenience function for PDL folks.
sub p {	print @_ }

################################
# Output handling and mangling #
################################

# Set autoflush on stdout:
$|++;

# Useful function to simulate user input. This is useful for initialization
# scripts when you want to run commands and put them into the command history
sub REPL::simulate_run {
    my $command = shift;
    # Get the current content of the inline and cursor position:
    my $old_text = $inline->text;
    my $old_offset = $inline->charOffset;
    # Set the content to the new command:
    $inline->text($command);
    # run it:
    $inline->PressEnter();
    # put the original content back on the inline:
    $inline->text($old_text);
    $inline->charOffset($old_offset);
}

# Here is a utility function to print to the output window. Both standard output
# and standard error are later tied to printing to this interface, so you can
# just use 'print' or 'say' in all your code and it'll go to this.

sub REPL::outwindow {
	# The first argument is a boolean indicating whether the output should go
	# to stderr or stdout. I would like to make this print error text in red
	# eventually, but I need to figure out how to change the color of specific
	# text items: working here
	my $to_stderr = shift;
	
	# Join the arguments and split them at the newlines and carriage returns:
	my @args = map {defined $_ ? $_ : ''} ('', @_);
	my @lines = split /([\n\r])/, join('', @args);
	# Remove useless parts of error messages (which refer to lines in this code)
	s/ \(eval \d+\)// for @lines;
	# Open the logfile, which I'll print to simultaneously:
	open my $logfile, '>>', 'prima-repl.logfile';
	IO::OutWindow::print_to_terminal(@lines) if $DEBUG_OUTPUT or $to_stderr;
	# Go through each line and carriage return, overwriting where appropriate:
	foreach(@lines) {
		# If it's a carriage return, set the current column to zero:
		if (/\r/) {
			$output_column = 0;
			print $logfile "\\r\n";
		}
		# If it's a newline, increment the output line and set the column to
		# zero:
		elsif (/\n/) {
			$output_column = 0;
			$output_line_number++;
			print $logfile "\n";
		}
		# Otherwise, add the text to the current line, starting at the current
		# column:
		else {
			print $logfile $_;
			my $current_text = $output->get_line($output_line_number);
			# If the current line is blank, set the text to $_:
			if (not $current_text) {
				$current_text = $_;
			}
			# Or, if the replacement text exceeds the current line's content,
			elsif (length($current_text) < length($_) + $output_column) {
				# Set the current line to contain everything up to the current
				# column, and append the next text:
				$current_text = substr($current_text, 0, $output_column) . $_;
			}
			# Or, replace the current line's text with the next text:
			else {
				substr($current_text, $output_column, length($_), $_);
			}
			$output->delete_line($output_line_number);
			$output->insert_line($output_line_number, $current_text);
			# increase the current column:
			$output_column += length($_);
		}
	}
	
	# close the logfile:
	close $logfile;
	
	# Let the application update itself:
	$::application->yield;

	# I'm not super-enthused with manually putting the cursor at the end of
	# the text, or with forcing the scrolling. I'd like to have some way to
	# determine if the text was already at the bottom, in which case I would
	# continue scrolling, if it was not, I would not scroll. But, I cannot find
	# how to do that at the moment, so it'll just force scroll with every
	# printout. working here:
	$output->cursor_cend;
}

###############################
# Tie STDOUT to Output window #
###############################
# Redirect standard output using this filehandle tie. Thanks to 
# http://stackoverflow.com/questions/387702/how-can-i-hook-into-perls-print
# for this one.
package IO::OutWindow;
use base 'Tie::Handle';
use Symbol qw<geniosym>;
sub TIEHANDLE {
	my $package = shift;
	return bless geniosym, $package;
}

sub to_stderr {
	return 0;
}

# Printing to this tied file handle sends the output to the outwindow function.
sub PRINT {
	my $self = shift;
	REPL::outwindow($self->to_stderr(), @_)
}
# printf behaves the same as print
sub PRINTF {
	my $self = shift;
	my $to_print = sprintf(@_);
	REPL::outwindow($self->to_stderr(), @_);
}
# This function provides access to the original stdout file handle
sub print_to_terminal {
	print main::STDOUT @_;
}
# Create the tied file handle that we will reassign
tie *PRINTOUT, 'IO::OutWindow';
# Redirect standard output to the new tied file handle
select( *PRINTOUT );

############################################
# Tie STDERR to Output window and terminal #
############################################
package IO::OutWindow::Err;
our @ISA = qw(IO::OutWindow);
# Override the to_stderr function; everything else should fall through via the
# base class
sub to_stderr {
	return 1;
}
# Create the tied file handle
tie *ERROUT, 'IO::OutWindow::Err';
# Tie stderr to the new tied file handle
*main::STDERR = \*ERROUT;

######################################
# A custom inputHistory Output class #
######################################

package PrimaX::InputHistory::Output::REPL;

bin/prima-repl  view on Meta::CPAN 



#################################
# Run any initialization script #
#################################
sub redo_initrc {
	my $filename = $initrc_filename if -f $initrc_filename;
	$filename = "$initrc_filename.pl" if -f "$initrc_filename.pl";
	if ($filename) {
		print "Running initialization script\n";
		# Load the init script and send it to 
		open my $fh, '<', $filename;
		my $text = do { local( $/ ) ; <$fh> };
		my_eval("#line 1 \"$filename\"\n$text");
		REPL::warn("Errors encountered running the initialization script:\n$@\n")
			if $@;
		$@ = '';
	}
	else {
		print "No initialization script found\n";
	}
}
redo_initrc if -f $initrc_filename or -f "$initrc_filename.pl";

run Prima;
# Remove the logfile. This will not happen with a system failure, which means
# that the logfile is 'saved' only when there was a problem. The special case of
# the user typing 'exit' at the prompt is handled in pressed_enter().
unlink 'prima-repl.logfile';

__END__

=head1 App::Prima::REPL Help

This is the help documentation for App::Prima::REPL, a graphical run-eval-print-loop
(REPL) for perl development, targeted at pdl users. Its focus is on L<PDL>, the
Perl Data Language, but it works just fine even if you don't have PDL.

At the bottom of the App::Prima::REPL window is a single entry line for direct
command input. The main window is a set of tabs, the first of which is an output
tab. Additional tabs can contain files or any other extension that has been
written as a App::Prima::REPL tab.

If your project has project-specific notes, you should be able to find them
either here: L<prima-repl.initrc> or here: L<prima-repl.initrc.pl>.

=head1 Fixing Documentation Fonts

If your documentation fonts look bad, you can change them by going to
View->Set Font Encoding.

=head1 Basic Navigation

Before I launch into the tutorial, I want to cover some basic navigation to help
you quickly get around the REPL. The following keyboard shortcuts should be
helpful to you even as we get started:

 Normal Keyboard  Mac Laptop
 CTRL-h           CTRL-h        open or switch to the help window
 ALT-1            ??????        go to the output window
 CTRL-i           CTRL-i        put the cursor in the input line
 CTRL-PageUp      CTRL-FN-Up    go to the previous tab
 CTRL-PageDown    CTRL-FN-Down  go to the next tab

=head1 Tutorials

These are a collection of tutorials to get you started using the Prima REPL.
Except for the first tutorial, text that you should enter will be prefixed with
a prompt like C<< > >>.

=head2 Basic Output

Our first exercise will be getting basic output from the REPL. Enter the
following into the input line, but don't press enter yet:

 print "Hello!"

Take note of the last line of text in the output window, then press enter.
You should see the following appear on your output screen:

 > print "Hello!"
 Hello!

What happens if you type an expression like 1+1? If you just type the expression
in the input line, you will see this as output:

 > 1+1

Why didn't it print 2? It didn't print 2 because you didn't ask it to print 2.
You can easily accomplish that by using the C<print> function, or its
abbreviation C<p>. Type the following in the input line:

 p 1+1

The output should look like this:

 > p 1+1
 2

You may be used to REPLs that print out the result of whatever action you just
took. This REPL does not do that because it is geared towards PDL use, and
the output for PDL can get exceedingly long. Rather than always print
potentially long results to the output, the Prima REPL is quiet by default and
makes it easy to print your results if you want.

=head2 Finding Documentation

Prima REPL uses Prima's built-in pod viewer (which you may be using to view this
documentation). If you have the help window open, you can look at a particular
module's documentation by pressing C<g> on your keyboard. A dialog will ask for
the name of the module with the documentation you want to read and will open
that module if it manages to find it.

There are two additional commands for finding and viewing help. The first is
the C<help> command. By itself, the C<help> command brings up the documentation
for Prima REPL. (Pressing C<CTRL-h> accomplishes the same thing.) However, you
can also specify the name of a module with documentation:

 > help Carp

This command will open the pod viewer with the requested module's documentation.



( run in 0.775 second using v1.01-cache-2.11-cpan-39bf76dae61 )