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, @) {
|
||||
if ($command eq 'market') {
|
||||
system $ENV{EDITOR} || 'vi', $filename;
|
||||
require RevBank::TextEditor;
|
||||
RevBank::TextEditor::edit($filename);
|
||||
return ACCEPT;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -23,7 +23,8 @@ sub _read_products() {
|
|||
|
||||
sub command :Tab(edit,&tab) ($self, $cart, $command, @) {
|
||||
if ($command eq 'edit') {
|
||||
system $ENV{EDITOR} || 'vi', $filename;
|
||||
require RevBank::TextEditor;
|
||||
RevBank::TextEditor::edit($filename);
|
||||
return ACCEPT;
|
||||
}
|
||||
|
||||
|
|
|
|||
2
revbank
2
revbank
|
|
@ -18,7 +18,7 @@ use RevBank::Global;
|
|||
use RevBank::Messages;
|
||||
use RevBank::Cart;
|
||||
|
||||
our $VERSION = "3.4";
|
||||
our $VERSION = "3.5";
|
||||
our %HELP1 = (
|
||||
"abort" => "Abort the current transaction",
|
||||
);
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue