prefs results from the CPAN

EekBoek

	open( my $oldout, ">&STDOUT" );
	close( STDOUT );
	open( STDOUT, '>', \$out ) or die("STDOUT capture fail");

	# Call API command.
	$t = $self->{_shell}->$meth(@args);

	# Restore STDOUT.
	close(STDOUT);
	open ( STDOUT, ">&", $oldout );
    };
    if ($@) {
	my $err = $@;
	chomp $err;
	$self->process_stderr("?$err\n");
    }
    else {
    	# Process output.
	$out .= "\n" unless !$out || $out =~ /\n$/;
	if ( $t =~ /^[%!?]/ ) {
	    $self->process_stderr($t);
	}
	else {
	    $out .= $t;
	}
	$self->process_stderr($_) for @msg;
	$self->process_stdout($_) for split(/\n/, $out);
    }

    return 1;
}

sub ShowText {
    my ($self, $text, $colour) = @_;
    if ( $colour ) {
	my $t = Wx::TextAttr->new;
	$t->SetTextColour($colour);
	my $x0 = $self->{t_output}->GetLastPosition;
	$self->{t_output}->AppendText($text."\n");
	$self->{t_output}->SetStyle($x0, $self->{t_output}->GetLastPosition, $t);
    }
    else {
	$self->{t_output}->AppendText($text."\n");
    }
}

my $capturing;
sub process_stdout {
    my ($self, $text) = @_;
    my $out = decode("utf-8", $text);
    # warn("app: $out\n");
    if ( $capturing || $out eq "<html>" ) {
	$capturing .= $out . "\n";
	if ( $out eq "<html>" ) {
	    $self->SetCursor(wxHOURGLASS_CURSOR);
	}
	elsif ( $out eq "</html>" ) {
	    $self->SetCursor(wxNullCursor);
	    my ($title) = ($capturing =~ m{<title>(.+?)</title>});
	    #warn("captured $title: ", length($capturing), " characters\n");
	    my $panel = $self->{prefs_repwin} ? "d_htmlpanel" : "d_htmlpanel_$title";
	    $self->{$panel} ||= EB::Wx::Shell::HtmlViewer->new
	      ($self, -1, $title);
	    $self->{$panel}->Show(0);
	    $self->{$panel}->html->SetPage($capturing);
	    $self->{$panel}->htmltext = $capturing;
	    $self->{$panel}->SetTitle($title);
	    $self->{$panel}->Show(1);
	    $capturing = "";
	}
    }
    else {
	$self->{t_output}->AppendText($out."\n");
    }
}

sub process_stderr {
    my ($self, $text) = @_;
    my $out = decode("utf-8", $text);
    # warn("err: $out\n");
    $self->ProcessMessages($out);
}

sub ProcessMessages {
    my ($self, $err) = @_;
    return unless $err;
    my @err = split(/\n+/, $err);
    while ( @err ) {
	$err = shift(@err);
	my @i;
	if ( $err =~ /^\?+(.*)/ ) {
	    $self->ShowText($err, wxRED);
	    next unless $self->{prefs_errorpopup};
	    @i = ($1, _T("Fout"), wxOK|wxICON_ERROR);
	}
	elsif ( $err =~ /^\!+(.*)/ ) {
	    $self->ShowText($err, Wx::Colour->new("magenta"));
	    next unless $self->{prefs_warnpopup};
	    @i = ($1, _T("Waarschuwing"), wxOK|wxICON_WARNING);
	}
	else {
	    $self->ShowText($err, wxGREEN);
	    next unless $self->{prefs_infopopup};
	    @i = ($err, _T("Mededeling"), wxOK|wxICON_INFORMATION);
	}
	my $md = Wx::MessageDialog->new($self, @i, wxDefaultPosition);
	$md->ShowModal;
	$md->Destroy;
    }
}


sub OnTextEnter {
	my ($self, $event) = @_;
# wxGlade: EB::Wx::Shell::MainFrame::OnTextEnter <event_handler>

	my $cmd = $self->{t_input}->GetValue;
	return unless $cmd;
	push(@{$self->{_cmd}}, $cmd)
	  unless $cmd eq $self->{_cmd}->[-1];
	$self->{_cmdptr} = $#{$self->{_cmd}} + 1;
	$self->{t_input}->SetValue("");
	$cmd =~ s/ *\t */ /g;
	$self->RunCommand($cmd);
	$self->{t_input}->SetFocus();

# end wxGlade
}

sub OnSend {
	my ($self, $event) = @_;
# wxGlade: EB::Wx::Shell::MainFrame::OnSend <event_handler>

	&OnTextEnter;

# end wxGlade
}

sub OnEdit {
	my ($self, $event) = @_;
# wxGlade: EB::Wx::Shell::MainFrame::OnEdit <event_handler>

	my $d = $self->{d_editdialog} ||= EB::Wx::Shell::EditDialog->new;

	my $t = $self->{t_input}->GetValue;
	$t =~ s/\t/\n/g;
	$d->{t_input}->SetValue($t);
	$d->{t_input}->SetInsertionPoint( $self->{t_input}->GetInsertionPoint );
	$d->{t_input}->SetFocus;

	my $ret = $d->ShowModal;

	$d->Show(0);

	return unless $ret == wxID_APPLY;

	$t = $d->{t_input}->GetValue;
	$t =~ s/\n/\t/g;
	$self->{t_input}->SetValue($t);

	&OnTextEnter;

# end wxGlade

lib/EB/Wx/Shell/MainFrame.pm view on Meta::CPAN

	     ? __x("{pkg} versie {ver}",
		   pkg => App::Packager::Packager(),
		   ver => $dd->(App::Packager::Version()))."\n"
	     : () ),
	   __x("Over {pkg} {app}",
	       pkg => $EekBoek::PACKAGE,
	       app => "WxShell"),
	   wxOK|wxICON_INFORMATION,
	   wxDefaultPosition);
	$md->ShowModal;
	$md->Destroy;

# end wxGlade
}

sub OnSupport {
    my ($self, $event) = @_;
# wxGlade: EB::Wx::Shell::MainFrame::OnSupport <event_handler>

    my $title = _T("Ondersteuning");
    my $md = EB::Wx::Shell::HtmlViewer->new($self, -1, $title);
    $md->info_only;
    $md->html->SetPage(_T(<<EOD));
<p>Voor het uitwisselen van ervaringen, vragen om ondersteuning e.d.
kunt u zich abonneren op de mailing list voor gebruikers op
<a href="https://lists.sourceforge.net/lists/listinfo/eekboek-users">SourceForge</a>.</p>
<p>De <font color='#C81900'>EekBoek</font> gebruikers houden zelf
<a href="https://wiki.eekboek.nl/" target="_blank">een wiki</a> bij met
tips en andere wetenswaardigheden.</p>
<p><font color='#C81900'>EekBoek</font> kan gratis worden gedownload en
gebruikt. Mocht u echter aanvullende wensen hebben op het gebied van
ondersteuning dan kan dat ook.
<a href="https://www.squirrel.nl/nl/index.html" target="_blank">Squirrel Consultancy</a>
is gaarne bereid u betaalde ondersteuning te bieden, bijvoorbeeld bij het
installeren van <font color='#C81900'>EekBoek</font>, het opzetten van
administraties, en het overzetten van uw bestaande administraties naar
<font color='#C81900'>EekBoek</font>. Ook kunnen specifieke uitbreidingen
of aanpassingen naar uw wens worden gerealiseerd.</p>
<p>Voor meer informatie:
<a href="mailto:info\@squirrel.nl">info\@squirrel.nl</a>.</p>
EOD
    $md->SetTitle($title);
    $md->ShowModal;
    $md->Destroy;

# end wxGlade
}

sub OnClear {
	my ($self, $event) = @_;
# wxGlade: EB::Wx::Shell::MainFrame::OnClear <event_handler>

	$self->{t_output}->SetValue("");

# end wxGlade
}

sub OnPrefs {
    my ($self, $event) = @_;
# wxGlade: EB::Wx::Shell::MainFrame::OnPrefs <event_handler>
    $self->{d_prefs} ||= EB::Wx::Shell::PreferencesDialog->new($self, -1, "Preferences");
    for ( keys( %$prefctl ) ) {
	if ( exists $self->{d_prefs}->{"cx_$_"} ) {
	    $self->{d_prefs}->{"cx_$_"}->SetValue( $self->{"prefs_$_"} );
	}
	elsif ( exists $self->{d_prefs}->{"spin_$_"} ) {
	    $self->{d_prefs}->{"spin_$_"}->SetValue( $self->{"prefs_$_"} );
	}
    }
    my $ret = $self->{d_prefs}->ShowModal;
    if ( $ret == wxID_OK ) {
	for ( keys( %$prefctl ) ) {
	    if ( exists $self->{d_prefs}->{"cx_$_"} ) {
		$self->{"prefs_$_"} = $self->{d_prefs}->{"cx_$_"}->GetValue;
	    }
	    elsif ( exists $self->{d_prefs}->{"spin_$_"} ) {
		$self->{"prefs_$_"} = $self->{d_prefs}->{"spin_$_"}->GetValue;
	    }
	}
    }
# end wxGlade
}


sub FillHistory {
    my ($self, $histfile) = @_;
    $self->{_histfile} = $histfile;
    $self->{_cmd} = [];
    $self->{_cmdptr} = 0;
    if ( -s $histfile ) {
	my $fh;
	return unless open($fh, "<:encoding(utf-8)", $histfile);
	my $prev = '';
	while ( <$fh> ) {
	    chomp;
	    next if $_ eq $prev;
	    $self->PutOnHistory($_);
	    $prev = $_;
	}
	close($fh);
    }
    $self->{_cmdinit} = $self->{_cmdptr} = $#{$self->{_cmd}} + 1;
}

sub GetPreferences {
    my ( $self ) = @_;
    my $conf = Wx::ConfigBase::Get;
    for ( keys( %$prefctl ) ) {
	$self->{"prefs_$_"} = $conf->ReadInt( "preferences/$_", $prefctl->{$_} );
    }
}

sub SaveHistory {
    my $self = shift;
    my $fh;
    my $histfile = $self->{_histfile};

    $self->{_cmdinit} = $self->{_cmdptr} - $self->{prefs_histlines};
    $self->{_cmdinit} = 0 if $self->{_cmdinit} < 0;

    return unless open($fh, ">:encoding(utf-8)", $histfile);
    while ( $self->{_cmdinit} < $self->{_cmdptr} ) {
	print { $fh } ($self->{_cmd}->[$self->{_cmdinit}], "\n");
	$self->{_cmdinit}++;
    }
    close($fh);
}

sub SavePreferences {
    my ( $self ) = @_;
    my $conf = Wx::ConfigBase::Get;
    for ( keys( %$prefctl ) ) {
	$conf->WriteInt( "preferences/$_", $self->{"prefs_$_"} );
    }
}

sub OnMenuBal {
	my ($self, $event, $sub) = @_;
# wxGlade: EB::Wx::Shell::MainFrame::OnMenuBal <event_handler>

	if ( defined $sub && $sub >= 0 ) {
	    $self->_cmd("balans --verdicht --detail=$sub --gen-wxhtml\n");
	}
	else {
	    $self->_cmd("balans --gen-wxhtml\n");
	}
# end wxGlade
}


sub OnMenuRes {
	my ($self, $event, $sub) = @_;
# wxGlade: EB::Wx::Shell::MainFrame::OnMenuRes <event_handler>

	if ( defined $sub && $sub >= 0 ) {
	    $self->_cmd("result --verdicht --detail=$sub --gen-wxhtml\n");
	}
	else {
	    $self->_cmd("result --gen-wxhtml\n");
	}
# end wxGlade
}


sub OnMenuAP {
	my ($self, $event) = @_;
# wxGlade: EB::Wx::Shell::MainFrame::OnMenuAP <event_handler>

	$self->_cmd("crediteuren --gen-wxhtml\n");

# end wxGlade
}


sub OnMenuAR {
	my ($self, $event) = @_;
# wxGlade: EB::Wx::Shell::MainFrame::OnMenuAR <event_handler>

	$self->_cmd("debiteuren --gen-wxhtml\n");

# end wxGlade
}

sub OnMenuVAT {
	my ($self, $event) = @_;
# wxGlade: EB::Wx::Shell::MainFrame::OnMenuAR <event_handler>

	$self->_cmd("btwaangifte --gen-wxhtml\n");

# end wxGlade
}

( run in 0.850 second using v1.01-cache-2.11-cpan-0bb4e1dffa6 )