bump to v3.5; add built-in editor
This commit is contained in:
Juerd Waalboer
parent
defe8d490c
commit
43a1990974
5 changed files with 207 additions and 3 deletions
165
lib/RevBank/TextEditor.pm
Normal file
165
lib/RevBank/TextEditor.pm
Normal file
|
|
@ -0,0 +1,165 @@
|
||||||
|
package RevBank::TextEditor;
|
||||||
|
|
||||||
|
use v5.28;
|
||||||
|
use warnings;
|
||||||
|
use feature qw(signatures);
|
||||||
|
no warnings qw(experimental::signatures);
|
||||||
|
|
||||||
|
use autodie;
|
||||||
|
use RevBank::Global;
|
||||||
|
use Fcntl qw(:flock);
|
||||||
|
use Carp qw(croak);
|
||||||
|
use Time::HiRes qw(sleep);
|
||||||
|
|
||||||
|
my $tab = 4;
|
||||||
|
|
||||||
|
sub _find_next($win, $textref) {
|
||||||
|
my $editor = $win->getobj('editor');
|
||||||
|
my $find = $win->getobj('find');
|
||||||
|
my $a = $find->getobj('answer');
|
||||||
|
my $b = $find->getobj('buttons');
|
||||||
|
|
||||||
|
my $q = $a->get;
|
||||||
|
|
||||||
|
pos($$textref) = $editor->pos;
|
||||||
|
my $status = "not found";
|
||||||
|
my $offset;
|
||||||
|
if ($$textref =~ /\Q$q/gi) {
|
||||||
|
$status = "found";
|
||||||
|
$offset = $+[0];
|
||||||
|
} else {
|
||||||
|
$editor->pos(0);
|
||||||
|
pos($$textref) = 0;
|
||||||
|
if ($$textref =~ /\Q$q/gi) {
|
||||||
|
$status = "wrapped";
|
||||||
|
$offset = $+[0];
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
$find->{-title} = ucfirst $status;
|
||||||
|
if ($status ne "not found") {
|
||||||
|
$editor->pos($offset);
|
||||||
|
$editor->{-search_highlight} = $editor->{-ypos};
|
||||||
|
} else {
|
||||||
|
$editor->{-search_highlight} = undef;
|
||||||
|
}
|
||||||
|
$win->draw;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _find($win) {
|
||||||
|
my $editor = $win->getobj('editor');
|
||||||
|
my $text = $editor->get;
|
||||||
|
|
||||||
|
my $find = $win->add(
|
||||||
|
'find', 'Dialog::Question',
|
||||||
|
-question => "Search for:",
|
||||||
|
-buttons => [
|
||||||
|
{ -label => '[Find next]', -onpress => sub {
|
||||||
|
_find_next($win, \$text);
|
||||||
|
} },
|
||||||
|
{ -label => '[Cancel]', -onpress => sub {
|
||||||
|
$win->getobj('find')->loose_focus;
|
||||||
|
$editor->{-search_highlight} = undef;
|
||||||
|
} },
|
||||||
|
]
|
||||||
|
);
|
||||||
|
my $a = $find->getobj('answer');
|
||||||
|
my $b = $find->getobj('buttons');
|
||||||
|
|
||||||
|
$a->onFocus( sub { shift->pos(999) } );
|
||||||
|
|
||||||
|
$a->set_binding(sub {
|
||||||
|
$b->{-selected} = 0; # [Find next]
|
||||||
|
$b->focus;
|
||||||
|
$b->press_button;
|
||||||
|
$win->draw;
|
||||||
|
}, Curses::KEY_ENTER());
|
||||||
|
|
||||||
|
$find->set_binding(sub {
|
||||||
|
$b->{-selected} = 1; # [Cancel]
|
||||||
|
$b->focus;
|
||||||
|
$b->press_button;
|
||||||
|
$win->draw;
|
||||||
|
}, "\cX", "\cC");
|
||||||
|
$b->set_routine('press-button' => sub { $b->press_button });
|
||||||
|
|
||||||
|
$find->modalfocus;
|
||||||
|
$win->delete('find');
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _editor($title, $data) {
|
||||||
|
our $cui ||= Curses::UI->new;
|
||||||
|
my $win = $cui->add('main', 'Window');
|
||||||
|
$title = "[$title] Ctrl+X: exit Ctrl+F: find Ctrl+C/K/V: copy/cut/paste";
|
||||||
|
|
||||||
|
my $editor = $win->add(
|
||||||
|
'editor', 'TextEditor',
|
||||||
|
-title => $title,
|
||||||
|
-text => $data,
|
||||||
|
-border => 1,
|
||||||
|
-padbottom => 1, # ibm3151/screen lastline corner glitch workaround
|
||||||
|
-wrapping => 0,
|
||||||
|
-hscrollbar => 0,
|
||||||
|
-vscrollbar => 0,
|
||||||
|
);
|
||||||
|
|
||||||
|
my $return;
|
||||||
|
|
||||||
|
my @keys = (
|
||||||
|
[ Curses::KEY_HOME() => 'cursor-scrlinestart' ],
|
||||||
|
[ Curses::KEY_END() => 'cursor-scrlineend' ],
|
||||||
|
[ "\cK" => 'delete-line' ], # nano (can't do meta/alt for M-m)
|
||||||
|
[ "\cU" => 'paste' ], # nano
|
||||||
|
[ "\c[" => sub { } ],
|
||||||
|
[ "\cL" => sub { $cui->draw } ],
|
||||||
|
[ "\c^" => sub { $editor->pos(0) } ],
|
||||||
|
[ "\c_" => sub { $editor->pos(length($editor->get)) } ],
|
||||||
|
[ "\cI" => sub { $editor->add_string(" " x ($tab - ($editor->{-xpos} % $tab))) } ],
|
||||||
|
[ "\cS" => sub { $cui->dialog("Enable flow control :)") } ],
|
||||||
|
[ "\cQ" => sub {} ],
|
||||||
|
[ "\cC" => sub { $editor->{-pastebuffer} = $editor->getline_at_ypos($editor->{-ypos}) } ],
|
||||||
|
[ "\cF" => sub { _find($win) } ],
|
||||||
|
[ "\cX" => sub {
|
||||||
|
my $answer = $cui->dialog(
|
||||||
|
-message => "Save changes?",
|
||||||
|
-buttons => [
|
||||||
|
{ -label => "[Save]", -value => 1 },
|
||||||
|
{ -label => "[Discard]", -value => 0 },
|
||||||
|
{ -label => "[Cancel]", -value => -1 },
|
||||||
|
],
|
||||||
|
-values => [ 1, 0 ],
|
||||||
|
);
|
||||||
|
$return = $editor->get if $answer == 1;
|
||||||
|
$cui->mainloopExit if $answer >= 0;
|
||||||
|
} ],
|
||||||
|
);
|
||||||
|
|
||||||
|
$editor->set_binding(reverse @$_) for @keys;
|
||||||
|
$editor->focus();
|
||||||
|
|
||||||
|
$cui->mainloop;
|
||||||
|
$cui->leave_curses;
|
||||||
|
$cui->delete('main');
|
||||||
|
|
||||||
|
return $return;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub edit($filename) {
|
||||||
|
if (not eval { require Curses::UI }) {
|
||||||
|
my $install = -e "/etc/debian_version"
|
||||||
|
? "apt install libcurses-ui-perl"
|
||||||
|
: "cpan Curses::UI";
|
||||||
|
|
||||||
|
die "Couldn't load the Perl module Curses::UI.\n" .
|
||||||
|
"Please install it! (sudo $install)\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
open my $fh, ">>", $filename;
|
||||||
|
flock $fh, LOCK_EX | LOCK_NB
|
||||||
|
or die "Someone else is alreading editing $filename.\n";
|
||||||
|
|
||||||
|
my $save = _editor($filename, scalar slurp $filename);
|
||||||
|
spurt $filename, $save if defined $save;
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
37
lib/RevBank/TextEditor.pod
Normal file
37
lib/RevBank/TextEditor.pod
Normal file
|
|
@ -0,0 +1,37 @@
|
||||||
|
=head1 NAME
|
||||||
|
|
||||||
|
RevBank::TextEditor - Basic Lightweight User-friendly TextEditor
|
||||||
|
|
||||||
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
|
require RevBank::TextEditor;
|
||||||
|
RevBank::TextEditor::edit($filename);
|
||||||
|
|
||||||
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
|
BLUT is a built-in text editor based on Curses::UI.
|
||||||
|
|
||||||
|
It was made because vim is too hard for unprepared newbies, and nano too,
|
||||||
|
really: not everyone knows that C<^X> means Ctrl+X, making nano almost as hard
|
||||||
|
to exit as vim. And of course, none of the really user friendly editors out
|
||||||
|
there would work well on our old IBM 3151 terminal. (For instance, C<^S> and
|
||||||
|
C<^Q> are used for software flow control, or as the manual of said terminal
|
||||||
|
calls it, "pacing".)
|
||||||
|
|
||||||
|
And of course, all the editors out there will let you open other files, or even
|
||||||
|
run shells...
|
||||||
|
|
||||||
|
=head2 Functions
|
||||||
|
|
||||||
|
=head3 edit($filename)
|
||||||
|
|
||||||
|
Runs the editor.
|
||||||
|
|
||||||
|
=head2 CAVEATS
|
||||||
|
|
||||||
|
=over 2
|
||||||
|
|
||||||
|
=item * It's a really dumb editor, and many unsupported presses will end up as
|
||||||
|
garbage.
|
||||||
|
|
||||||
|
=back
|
||||||
|
|
@ -23,7 +23,8 @@ sub _read_market() {
|
||||||
|
|
||||||
sub command :Tab(market,&tab) ($self, $cart, $command, @) {
|
sub command :Tab(market,&tab) ($self, $cart, $command, @) {
|
||||||
if ($command eq 'market') {
|
if ($command eq 'market') {
|
||||||
system $ENV{EDITOR} || 'vi', $filename;
|
require RevBank::TextEditor;
|
||||||
|
RevBank::TextEditor::edit($filename);
|
||||||
return ACCEPT;
|
return ACCEPT;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -23,7 +23,8 @@ sub _read_products() {
|
||||||
|
|
||||||
sub command :Tab(edit,&tab) ($self, $cart, $command, @) {
|
sub command :Tab(edit,&tab) ($self, $cart, $command, @) {
|
||||||
if ($command eq 'edit') {
|
if ($command eq 'edit') {
|
||||||
system $ENV{EDITOR} || 'vi', $filename;
|
require RevBank::TextEditor;
|
||||||
|
RevBank::TextEditor::edit($filename);
|
||||||
return ACCEPT;
|
return ACCEPT;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
||||||
2
revbank
2
revbank
|
|
@ -18,7 +18,7 @@ use RevBank::Global;
|
||||||
use RevBank::Messages;
|
use RevBank::Messages;
|
||||||
use RevBank::Cart;
|
use RevBank::Cart;
|
||||||
|
|
||||||
our $VERSION = "3.4";
|
our $VERSION = "3.5";
|
||||||
our %HELP1 = (
|
our %HELP1 = (
|
||||||
"abort" => "Abort the current transaction",
|
"abort" => "Abort the current transaction",
|
||||||
);
|
);
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue