examples/editor.pl - metacpan.org

=pod

=head1 NAME

examples/editor.pl - A basic text editor

=head1 FEATURES

Demonstrates usage of L<Prima::Edit> class,
and, in lesser extent, of standard find/replace dialogs.

=cut

use strict;
use warnings;

use Prima qw(Edit Bidi Application MsgBox StdDlg);

eval "use Encode;";
my $can_utf8 = $@ ? 0 : 1;
$::application->wantUnicodeInput($can_utf8);

package Indicator;
use vars qw(@ISA);
@ISA = qw(Prima::Widget);

sub profile_default
{
	my %def = %{$_[ 0]->SUPER::profile_default};
	return {
		%def,
		editor   => undef,
		text     => '',
		growMode => gm::Floor,
		left     => 0,
		bottom   => 0,
		height   => $::application->font->height + 2,
	}
}

sub init
{
	my $self = shift;
	my %profile = $self->SUPER::init(@_);
	$self-> {editor} = $profile{editor};
	$self-> reset;
	return %profile;
}

sub on_paint
{
	my ($self,$canvas) = @_;
	$canvas-> rect3d( 0, 0, $self-> width - 1, $self-> height - 1, 
		1, $self-> dark3DColor, $self-> light3DColor, $self-> backColor);
	$canvas-> text_out( $self-> text, 
		4, ( $self-> height - $canvas-> font-> height) / 2);
}

sub reset
{
	my $self    = $_[0];
	my $editor  = $self-> {editor};
	my @c = $editor-> cursorLog;
	$self-> text( sprintf("%s %d:%d", ($editor-> modified ? '*' : ' '), 
		$c[0]+1,$c[1]+1));
	$self-> repaint;
}


package Editor;
use vars qw(@ISA);
@ISA = qw(Prima::Edit);

sub profile_default
{
	my %def = %{$_[ 0]-> SUPER::profile_default};
	my @accelItems = @{$def{accelItems}};
	my @acc = (
		[ PushMark  => 0, 0, km::Ctrl|kb::Down, q(push_mark)],
		[ PopMark   => 0, 0, km::Ctrl|kb::Up,   q(pop_mark)],
	);
	splice( @accelItems, -1, 0, @acc);
	return {
		%def,
		accelItems => \@accelItems,
	}
}

sub set_cursor
{
	my $self = shift;
	my @c = $self-> cursor;
	$self-> SUPER::set_cursor(@_);
	return if $c[0] == $_[0] && $c[1] == $_[1];
	$self-> owner-> {status}-> reset 
		if $self-> owner-> {status} && !$self-> change_locked;
}

sub push_mark
{
	my $self = $_[0];
	$self-> add_marker( $self-> cursor);
}

sub pop_mark
{
	my $self = $_[0];
	my $m = $self-> markers;
	return if scalar @{$m} == 0;
	$self-> cursor( @{$$m[-1]});
	$self-> delete_marker( -1);
}

package EditorWindow;
use vars qw(@ISA);
@ISA = qw(Prima::Window);

sub profile_default
{
	my %def = %{$_[ 0]-> SUPER::profile_default};
	return {
		%def,
		fileName => undef,
		utf8     => $can_utf8,
		menuItems => [
			[ '~File' => [
				[ '~New'        => q(new_window)],
				[ '~Open...'    => 'F3' => kb::F3, q(open_file)],
				[ '~Save'       => 'F2' => kb::F2, q(save_file)],
				[ 'Save ~as...' => q(save_as)],
				[],
				['E~xit'        => 'Alt+X' => '@X' => sub {$::application-> close}]
			]],
			[ '~Edit' => [
				['~Cut'   => 'Ctrl+Del'   => kb::NoKey, sub{$_[0]-> {editor}-> cut}],
				['C~opy'  => 'Ctrl+Ins'   => kb::NoKey, sub{$_[0]-> {editor}-> copy}],
				['~Paste' => 'Shift+Ins'  => kb::NoKey, sub{$_[0]-> {editor}-> paste}],
				['~Delete' => 'Shift+Del' => kb::NoKey, sub{$_[0]-> {editor}-> delete_block}],
				[],
				['~Find...' => 'Esc'      => kb::Esc   , q(find)],
				['~Replace...'=> 'Ctrl+S' => '^S'      , q(replace)],
				['Find ~next' => 'Ctrl+L' => '^L'      , q(find_next)],
				[],
				['~Undo' => 'Alt+Backspace' => kb::NoKey   , sub {$_[0]-> {editor}-> undo}],
				['~Redo' => 'Ctrl+R'        => kb::NoKey   , sub {$_[0]-> {editor}-> redo}],
			]],
			['~Options' => [
				[ '@syx' => '~Syntax hilite' => sub{ $_[0]-> {editor}-> syntaxHilite( $_[2] )}],
				[ '@*aid' => '~Auto indent' => sub{ $_[0]-> {editor}-> autoIndent( $_[2] )}],
				[ '@wwp' => '~Word wrap' => sub{ $_[0]-> {editor}-> wordWrap( $_[2] )}],
				[ '@psb' => '~Presistent blocks' => sub{ $_[0]-> {editor}-> persistentBlock( $_[2] )}],
				[],
				[ '@*hsc' => '~Horizontal scrollbar' => sub{ $_[0]-> {editor}-> hScroll( $_[2])}],
				[ '@*vsc' => '~Vertical scrollbar'   => sub{ $_[0]-> {editor}-> vScroll( $_[2])}],
				[],
				(
					$can_utf8 ? 
					['utf'  => 'UTF-8 mode' => sub {
						my $utf8_mode = $_[0]-> menu-> utf-> toggle;
						$_[0]-> {utf8} = $utf8_mode;
						$::application-> wantUnicodeInput($utf8_mode);
					}] :
					()
				),
				[ 'Set ~font' => q(setfont)],
			]]
		],
	}
}

my $windows = 0;

sub init
{
	my $self = shift;
	my %profile = $self-> SUPER::init(@_);
	my $fn = $profile{fileName};
	my $cap = '';
	$self-> menu-> utf-> check if $self-> {utf8} = $profile{utf8};
	if ( defined $fn) {
		if ( open FILE, '<'.($profile{utf8} ? 'utf8' : ''), $fn) {
			if ( ! defined read( FILE, $cap, -s $fn)) {
				Prima::MsgBox::message("Cannot read file $fn:$!");
				$fn = undef;
			}
			close FILE;
		} else {
			Prima::MsgBox::message("Cannot open file $fn:$!");
			$fn = undef;
		}
	}
	$fn = '.Untitled' unless defined $fn;
	my $fh = $::application->font->height + 1;
	$self-> {editor} = $self-> insert( Editor =>
		name      => 'Edit',
		textRef   => \$cap,
		origin    => [ 0, $fh],
		size      => [ $self-> width, $self-> height - $fh],
		hScroll   => 1,
		vScroll   => 1,
		growMode  => gm::Client,
	);
	undef $cap;
	$self-> text( $fn);
	$self-> {status} = $self-> insert( Indicator =>
		name    => 'StatusBar',
		width   => $self-> width,
		editor  => $self-> {editor},
	);
	$self-> {editor}-> focus;
	$self-> {findData} = undef;
	$windows++;
	return %profile;
}


sub on_close
{
	my $self = $_[0];
	if ( $self-> {editor}-> modified) {
		my $r =  Prima::MsgBox::message_box(
			$self-> text,
			'File '.$self-> text. ' has been modified.  Save?',
			mb::YesNoCancel|mb::Warning);
		return if mb::No == $r;
		$self-> clear_event, return if mb::Cancel == $r;
		$self-> clear_event, return unless $self-> save_file;
	}
}

sub on_destroy
{
	$::application-> close unless --$windows;
}

sub new_window
{
	my $self = $_[0];
	my $ww = EditorWindow-> create(
		size   => [$self-> size],
		left   => $self-> left + 10,
		bottom => $self-> bottom - 10,
		font   => $self-> font,
		utf8   => $self-> {utf8},
	);
	$ww-> {editor}-> focus;
	return $ww;
}

sub open_file
{
	my $self = $_[0];
	my $f = Prima::open_file;
	if ( defined $f) {
		my $ww = EditorWindow-> create(
			size     => [$self-> size],
			left     => $self-> left + 10,
			bottom   => $self-> bottom - 10,
			fileName => $f,
			font     => $self-> font,
			utf8     => $self-> {utf8},
		);
		$ww-> {editor}-> focus;
	}
}

sub save_file
{
	my $self = $_[0];
	return $self-> save_as if $self-> text eq '.Untitled';
	my $fn = $self-> text;
	if ( open FILE, '>'.($self-> {utf8} ? 'utf8' : ''), $fn) {
		my $cap = $self-> {editor}-> text;
		Encode::_utf8_off($cap) if $can_utf8 and !$self-> {utf8};
		my $swr = syswrite(FILE,$cap,length($cap));
		close FILE;
		unless (defined $swr && $swr==length($cap)) {
			undef $cap;
			unlink $fn;
			Prima::MsgBox::message_box( 
				$self-> text, 
				"Cannot save to $fn", mb::Error|mb::OK);
			return 0;
		}
		undef $cap;
		$self-> {editor}-> modified(0);
		$self-> {status}-> reset;
		return 1;
	} else {
		Prima::MsgBox::message_box( 
			$self-> text, "Cannot save to $fn", mb::Error|mb::OK);
	}
	return 0;
}

sub save_as
{
	my $self = $_[0];
	my $fn = Prima::save_file;
	my $ret = 0;
	if ( defined $fn) {
	SAVE:while(1) {
		next SAVE unless open FILE, '>'.($self-> {utf8} ? 'utf8' : ''), $fn;
		my $cap = $self-> {editor}-> text;
		Encode::_utf8_off($cap) if $can_utf8 and !$self-> {utf8};
		my $swr = syswrite(FILE,$cap,length($cap));
		close FILE;
		unless (defined $swr && $swr==length($cap)) {
			undef $cap;
			unlink $fn;
			next SAVE;
		}
		undef $cap;
		$self-> {editor}-> modified(0);
		$self-> {status}-> reset;
		$self-> text( $fn);
		$ret = 1;
		last;
	} continue {
		last SAVE unless 
			mb::Retry == Prima::MsgBox::message_box( 
				$self-> text, "Cannot save to $fn",
				mb::Error|mb::Retry|mb::Cancel
			);
	}}
	return $ret;
}

my $findDialog;

sub find_dialog
{
	my ( $self, $findStyle) = @_;
	my %prf;
	%{$self-> {findData}} = (
		replaceText  => '',
		findText     => '',
		replaceItems => [],
		findItems    => [],
		options      => 0,
		scope        => fds::Cursor,
	) unless defined $self-> {findData};
	my $fd = $self-> {findData};
	my @props = qw(findText options scope);
	push( @props, q(replaceText)) unless $findStyle;
	if ( $fd) { for( @props) { $prf{$_} = $fd-> {$_}}}
	$findDialog = Prima::FindDialog-> create unless $findDialog;
	$findDialog-> set( %prf, findStyle => $findStyle);
	$findDialog-> Find-> items($fd-> {findItems});
	$findDialog-> Replace-> items($fd-> {replaceItems}) unless $findStyle;
	my $ret = 0;
	my $rf  = $findDialog-> execute;
	if ( $rf != mb::Cancel) {
		{ for( @props) { $self-> {findData}-> {$_} = $findDialog-> $_()}}
		$self-> {findData}-> {result} = $rf;
		$self-> {findData}-> {asFind} = $findStyle;
		@{$self-> {findData}-> {findItems}} = @{$findDialog-> Find-> items};
		@{$self-> {findData}-> {replaceItems}} = @{$findDialog-> Replace-> items} 
			unless $findStyle;
		$ret = 1;
	}
	return $ret;
}

sub do_find
{
	my $self = $_[0];
	my $e = $self-> {editor};
	my $p = $self-> {findData};
	my @scope;
	FIND:{
		if ( $$p{scope} != fds::Cursor) {
			if ( $e-> has_selection) {
			my @sel = $e-> selection;
				@scope = ($$p{scope} == fds::Top) ? ($sel[0],$sel[1]) : ($sel[2], $sel[3]);
			} else {
				@scope = ($$p{scope} == fds::Top) ? (0,0) : (-1,-1);
			}
		} else {
			@scope = $e-> cursor;
		}
		my @n = $e-> find( $$p{findText}, @scope, $$p{replaceText}, $$p{options});
		if ( !defined $n[0]) {
			Prima::MsgBox::message("No matches found");
			return;
		}
		$e-> cursor(($$p{options} & fdo::BackwardSearch) ? $n[0] : $n[2], $n[1]);
		$e-> selection( $n[0], $n[1], $n[2], $n[1]);
		unless ( $$p{asFind}) {
			if ( $$p{options} & fdo::ReplacePrompt) {
				my $r = Prima::MsgBox::message_box( $self-> text,
				"Replace this text?",
				mb::YesNoCancel|mb::Information|mb::NoSound);
				redo FIND if ($r == mb::No) && ($$p{result} == mb::ChangeAll);
				last FIND if $r == mb::Cancel;
			}
			$e-> set_line( $n[1], $n[3]);
			redo FIND if $$p{result} == mb::ChangeAll;
		}
	}
}

sub find
{
	my $self = $_[0];
	return unless $self-> find_dialog(1);
	$self-> do_find;
}

sub replace
{
	my $self = $_[0];
	return unless $self-> find_dialog(0);
	$self-> do_find;
}


sub find_next
{
	my $self = $_[0];
	return unless $self-> {findData};
	$self-> do_find;
}

my $fontDialog;

sub setfont
{
	my $self = $_[0];
	$fontDialog = Prima::FontDialog-> create() unless $fontDialog;
	$fontDialog-> logFont( $self-> font);
	return unless $fontDialog-> execute;
	$self-> font( $fontDialog-> logFont);
}

package Generic;

my @fn = @ARGV;
@fn = (undef) unless scalar @fn;

for ( @fn) {
my $w = EditorWindow-> create(
        origin => [ 10, 100],
        size   => [ $::application-> width - 820, $::application-> height - 150],
	fileName => $_,
	font => {
		size => 16,
		name => 'Courier New',
	},
);
}

run Prima;
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)