The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!/usr/bin/perl 
use strict;
use warnings;


#############################################################################
##
## Based on a very early version of Padre...
## The first version that could already save files.
##
## Copyright:   (c) The Padre development team
## Licence:     This program is free software; you can redistribute it and/or
##              modify it under the same terms as Perl itself
#############################################################################

# see package main at the bottom of the file


#####################
package Demo::Editor;
use strict;
use warnings FATAL => 'all';

use base 'Wx::App';

sub OnInit {
	my $frame = Demo::Frame->new;
	$frame->Show(1);
}

#####################
package Demo::Frame;
use strict;
use warnings FATAL => 'all';


use Wx ':everything';
use Wx::Event ':everything';
use Wx::Scintilla ();

use File::Spec::Functions qw(catfile);
use File::Basename qw(basename);

use base 'Wx::Frame';

our $VERSION = '0.01';
my $default_dir = "";
my $editor;
our $nb;
my %nb;
my $search_term = '';


sub new {
	my ($class) = @_;

	my $self = $class->SUPER::new(
		undef,
		-1,
		'Editor ',
		[ -1,  -1 ],
		[ 750, 700 ],
	);
	$nb = Wx::Notebook->new(
		$self, -1, wxDefaultPosition, wxDefaultSize,
		wxNO_FULL_REPAINT_ON_RESIZE | wxCLIP_CHILDREN
	);

	$self->_create_menu_bar;

	$self->setup_editor;
	return $self;
}

sub _create_menu_bar {
	my ($self) = @_;

	my $bar  = Wx::MenuBar->new;
	my $file = Wx::Menu->new;
	$file->Append( wxID_OPEN,   "&Open" );
	$file->Append( wxID_SAVE,   "&Save" );
	$file->Append( wxID_SAVEAS, "Save &As" );
	$file->Append( wxID_CLOSE,  "&Close" );
	$file->Append( wxID_EXIT,   "E&xit" );

	my $edit = Wx::Menu->new;
	$edit->Append( wxID_FIND, "&Find" );
	$edit->Append( 998,       "&Setup" );

	my $help = Wx::Menu->new;
	$help->Append( wxID_ABOUT, "&About..." );

	$bar->Append( $file, "&File" );
	$bar->Append( $edit, "&Edit" );
	$bar->Append( $help, "&Help" );

	$self->SetMenuBar($bar);

	EVT_CLOSE( $self, \&on_close_window );
	EVT_MENU( $self, wxID_OPEN, sub { on_open( $self, @_ ) } );
	EVT_MENU( $self, wxID_SAVE, sub { on_save( $self, @_ ) } );
	EVT_MENU( $self, wxID_SAVEAS, sub { on_save_as( $self, @_ ) } );
	EVT_MENU( $self, wxID_CLOSE, sub { on_close( $self, @_ ) } );
	EVT_MENU( $self, 998, sub { on_setup( $self, @_ ) } );
	EVT_MENU( $self, wxID_FIND, sub { on_find( $self, @_ ) } );
	EVT_MENU( $self, wxID_EXIT, \&on_exit );
	EVT_MENU( $self, wxID_ABOUT, \&on_about );

	return;
}

sub on_exit {
	my ($self) = @_;
	foreach my $id ( keys %nb ) {
		if ( _buffer_changed($id) ) {
			Wx::MessageBox( "One of the files is still not saved", "xx", wxOK | wxCENTRE, $self );
			return;
		}
	}

	$self->Close;
}

sub setup_editor {
	my ( $self, $file ) = @_;

	my $editor = Demo::Panel->new($nb);

	my $title   = "Unsaved Document 1";
	my $content = '';
	if ($file) {
		if ( open my $in, '<', $file ) {
			local $/ = undef;
			$content = <$in>;
		}
		$title = basename($file);
		$editor->SetText($content);
	}
	$nb->AddPage( $editor, $title, 1 );
	$nb{ $nb->GetSelection } = {
		filename => $file,
		content  => $content,
	};

	return;
}

sub on_close_window {
	my ( $self, $event ) = @_;
	$event->Skip;
}

sub on_open {
	my ($self) = @_;

	#Wx::MessageBox( "Not implemented yet. Should open a file selector", wxOK|wxCENTRE, $self );
	my $dialog = Wx::FileDialog->new( $self, "Open file", $default_dir, "", "*.*", wxFD_OPEN );
	if ( $dialog->ShowModal == wxID_CANCEL ) {

		#print "Cancel\n";
		return;
	}
	my $filename = $dialog->GetFilename;

	#print "OK $filename\n";
	$default_dir = $dialog->GetDirectory;

	my $file = catfile( $default_dir, $filename );

	$self->setup_editor($file);

	return;
}

sub on_save_as {
	my ($self) = @_;

	my $id = $nb->GetSelection;
	while (1) {
		my $dialog = Wx::FileDialog->new( $self, "Save file as...", $default_dir, "", "*.*", wxFD_SAVE );
		if ( $dialog->ShowModal == wxID_CANCEL ) {

			#print "Cancel\n";
			return;
		}
		my $filename = $dialog->GetFilename;

		#print "OK $filename\n";
		$default_dir = $dialog->GetDirectory;

		my $path = catfile( $default_dir, $filename );
		if ( -e $path ) {
			my $res = Wx::MessageBox( "File already exists. Overwrite it?", 3, $self );
			if ( $res == 2 ) {
				$nb{$id}{filename} = $path;
				last;
			}
		} else {
			$nb{$id}{filename} = $path;
			last;
		}
	}
	$self->_save_buffer($id);
	return;
}

sub on_save {
	my ($self) = @_;
	my $id = $nb->GetSelection;
	return if not _buffer_changed($id);

	if ( $nb{$id}{filename} ) {
		$self->_save_buffer($id);
	} else {
		$self->on_save_as;
	}
	return;
}

sub _save_buffer {
	my ( $self, $id ) = @_;

	my $page    = $nb->GetPage($id);
	my $content = $page->GetText;
	if ( open my $out, '>', $nb{$id}{filename} ) {
		print $out $content;
	}
	$nb{$id}{content} = $content;

	return;
}

sub on_close {
	my ($self) = @_;

	my $id = $nb->GetSelection;
	if ( _buffer_changed($id) ) {
		Wx::MessageBox( "File changed.", wxOK | wxCENTRE, $self );
	}

	return;
}

sub _buffer_changed {
	my ($id) = @_;

	my $page    = $nb->GetPage($id);
	my $content = $page->GetText;
	return $content ne $nb{$id}{content};
}

sub on_setup {
	my ($self) = @_;
	Wx::MessageBox( "Not implemented yet.", wxOK | wxCENTRE, $self );
}


sub on_find {
	my ($self) = @_;

	my $dialog = Wx::TextEntryDialog->new( $self, "", "Type in search term", $search_term );
	if ( $dialog->ShowModal == wxID_CANCEL ) {
		return;
	}
	$search_term = $dialog->GetValue;
	$dialog->Destroy;
	return if not defined $search_term or $search_term eq '';

	print "$search_term\n";
	return;
}


sub on_about {
	my ($self) = @_;

	Wx::MessageBox(
		"wxPerl editor, (c) 2008 Gabor Szabo\n" . "wxPerl editor $VERSION, " . wxVERSION_STRING,
		"About wxPerl editor", wxOK | wxCENTRE, $self
	);
}

#####################

package Demo::Panel;

use strict;
use warnings FATAL => 'all';
use Wx::Scintilla;
use base 'Wx::Scintilla::TextCtrl';
use Wx ':everything';
use Wx::Event ':everything';

our $VERSION = '0.01';

sub new {
	my ( $class, $parent ) = @_;
	my $self = $class->SUPER::new( $parent, -1, [ -1, -1 ], [ 750, 700 ] ); # TODO get the numbers from the frame?

	my $font = Wx::Font->new( 10, wxTELETYPE, wxNORMAL, wxNORMAL );

	$self->SetFont($font);

	$self->StyleSetFont( Wx::Scintilla::STYLE_DEFAULT, $font );
	$self->StyleClearAll;

	$self->StyleSetForeground( 0,  Wx::Colour->new( 0x00, 0x00, 0x7f ) );
	$self->StyleSetForeground( 1,  Wx::Colour->new( 0xff, 0x00, 0x00 ) );
	$self->StyleSetForeground( 2,  Wx::Colour->new( 0x00, 0x7f, 0x00 ) );
	$self->StyleSetForeground( 3,  Wx::Colour->new( 0x7f, 0x7f, 0x7f ) );
	$self->StyleSetForeground( 4,  Wx::Colour->new( 0x00, 0x7f, 0x7f ) );
	$self->StyleSetForeground( 5,  Wx::Colour->new( 0x00, 0x00, 0x7f ) );
	$self->StyleSetForeground( 6,  Wx::Colour->new( 0xff, 0x7f, 0x00 ) );
	$self->StyleSetForeground( 7,  Wx::Colour->new( 0x7f, 0x00, 0x7f ) );
	$self->StyleSetForeground( 8,  Wx::Colour->new( 0x00, 0x00, 0x00 ) );
	$self->StyleSetForeground( 9,  Wx::Colour->new( 0x7f, 0x7f, 0x7f ) );
	$self->StyleSetForeground( 10, Wx::Colour->new( 0x00, 0x00, 0x7f ) );
	$self->StyleSetForeground( 11, Wx::Colour->new( 0x00, 0x00, 0xff ) );
	$self->StyleSetForeground( 12, Wx::Colour->new( 0x7f, 0x00, 0x7f ) );
	$self->StyleSetForeground( 13, Wx::Colour->new( 0x40, 0x80, 0xff ) );
	$self->StyleSetForeground( 17, Wx::Colour->new( 0xff, 0x00, 0x7f ) );
	$self->StyleSetForeground( 18, Wx::Colour->new( 0x7f, 0x7f, 0x00 ) );
	$self->StyleSetBold( 12, 1 );
	$self->StyleSetSpec( Wx::Scintilla::SCE_H_TAG, "fore:#0000ff" );

	$self->SetLexer(Wx::Scintilla::SCLEX_PERL);

	$self->SetLayoutDirection(wxLayout_LeftToRight)
		if $self->can('SetLayoutDirection');

	return $self;
}

#####################
package main;

my $app = Demo::Editor->new;
$app->MainLoop;