#!/opt/perl/bin/perl -w
#
# Simple UTF-8 line editor
#

use strict;

binmode STDIN, ":utf8";
binmode STDOUT, ":utf8";

my @lines = ();
my $fname;

our (%emap, %cmap);
my ($emap, $cmap);
our ($defemap, $defcmap);
my (@cmapinfo, @cmapstk);


sub GetFL {
    print "\nFirst/last line (1-" . scalar(@lines) . "): ";
    my $r = <STDIN>; defined $r or return ();
    chomp $r; length($r) or return ();
    my @fl = split(/[, ]+/, $r);
    my $f = $fl[0]; my $l = (defined $fl[1] ? $fl[1] : $f);
    $f =~ /^[0-9]+$/ or return (); $l =~ /^[0-9]+$/ or return ();
    $f < 1 and $f = 1;
    $f > scalar(@lines) and $f = scalar(@lines);
    $l > scalar(@lines) and $l = scalar(@lines);
    $f > $l and $f = $l;
    return ($f, $l);
}

sub SetCmap {
    my $i = shift;
    (scalar @cmapstk and $cmapinfo[$i] == $cmapstk[$#cmapstk]) ?
	    (pop @cmapstk) : (push @cmapstk, $cmapinfo[$i]);
    $cmap = (scalar @cmapstk ? $cmapstk[$#cmapstk] : undef);
}

sub Parse {
    my $s = shift;
    while ($s =~ /(^|[^\\])(\\u([0-9A-Fa-f]+);)/) {
	my $c = chr(eval "0x" . $3);
	$s =~ s/\Q$2\E/$c/;
    }
    while ($s =~ /(^|[^\\])(\\([^\\\s][^;\s]*);)/) {
	exists $cmap{$3} and do {my $m = $3; $s =~ s/\Q$2\E/!$m;/; next};
	$emap or do {$s =~ s/\Q$2\E/\?/; next};
	my $c = (exists $$emap{$3} ? chr($$emap{$3}) : "?");
	$s =~ s/\Q$2\E/$c/;
    }
    @cmapinfo = ();
    while ($s =~ /(^|[^!])(!([^!\s][^;\s]*);)/) {
	$cmapinfo[$-[2]] = $cmap{$3};
	$s =~ s/\Q$2\E//;
    }
    if (scalar @cmapinfo) {
	my $tmp = "";
	my $i;
	for ($i = 0; $i < length($s); $i++) {
	    $cmapinfo[$i] and SetCmap $i;
	    my $c = substr($s, $i, 1);
	    $tmp .= ($cmap && exists $$cmap{$c} ? chr($$cmap{$c}) : $c);
	}
	$cmapinfo[$i] and SetCmap $i;
	$s = $tmp;
    }
    $s =~ s/(\\)\\/$1/g;
    return $s;
}

sub Input {
    my $n = shift() - 1; $n < 0 and return;
    my @ta = ();
    print "\n";
    while (1) {
	my $l = <STDIN>; defined $l or last;
	chomp $l;
	$l eq "." and last;
	push(@ta, Parse($l));
    }
    if ($n > scalar(@lines)) {
	my $lc = scalar(@lines);
	for (my $i = 0; $i < $n - $lc; $i++) {
	    push(@lines, "");
	}
	push(@lines, @ta);
    } else {
	splice(@lines, $n, 0, @ta);
    }
}

sub Print {
    scalar(@lines) or return;
    my $shownum = shift;
    my ($f, $l) = GetFL or return;
    print "\n";
    for (my $i = $f - 1; $i < $l; $i++) {
	$shownum ? printf " %5d  %s\n", $i + 1, $lines[$i] :
		print "$lines[$i]\n";
    }
}

sub Find {
    scalar(@lines) or return;
    print "\nPattern: ";
    my $pat = <STDIN>; defined $pat or return;
    chomp $pat; length($pat) or return;
    $pat = Parse($pat);
    for (my $i = 0; $i < scalar(@lines); $i++) {
	my $r = eval '$lines[$i] =~ /$pat/';
	$@ and do {warn $@; last};
	$r and printf " %5d  %s\n", $i + 1, $lines[$i];
    }
}

sub Subst {
    scalar(@lines) or return;
    my ($f, $l) = GetFL or return;
    print "\nSubstitution: ";
    my $regex = <STDIN>; defined $regex or return;
    chomp $regex; length($regex) or return;
    $regex = Parse($regex);
    for (my $i = $f - 1; $i < $l; $i++) {
	eval "\$lines[\$i] =~ $regex";
	$@ and do {warn $@; last};
    }
}

sub Copy2 {
    my ($f, $l, $to) = @_;
    if ($to > scalar(@lines)) {
	my $lc = scalar(@lines);
	for (my $i = 0; $i < ($to - 1) - $lc; $i++) {
	    push(@lines, "");
	}
	push @lines, @lines[($f-1)..($l-1)];
    } else {
	splice @lines, $to - 1, 0, @lines[($f-1)..($l-1)];
    }
}

sub Copy {
    scalar(@lines) or return;
    my ($f, $l) = GetFL or return;
    print "\nCopy to: ";
    my $to = <STDIN>; defined $to or return;
    chomp $to; length($to) or return;
    $to =~ /^[0-9]+$/ or return;
    Copy2($f, $l, $to);
}

sub Move {
    scalar(@lines) or return;
    my ($f, $l) = GetFL or return;
    print "\nMove to: ";
    my $to = <STDIN>; defined $to or return;
    chomp $to; length($to) or return;
    $to =~ /^[0-9]+$/ or return;
    Copy2($f, $l, $to);
    my $len = ($l + 1) - $f;
    $to < $f and $f += $len;
    splice @lines, $f - 1, $len;
}

sub Delete {
    scalar(@lines) or return;
    my ($f, $l) = GetFL or return;
    splice @lines, $f - 1, ($l + 1) - $f;
}

sub ReadFile2 {
    my $tmp = shift;
    open(FILE, "<:utf8", $tmp) or do {print STDERR "\nError: $!\n"; return};
    @lines = ();
    while (<FILE>) {
	chomp;
	push(@lines, $_);
    }
    close(FILE);
    $fname = $tmp;
}

sub ReadFile {
    print "\nRead from file"; $fname and print " [$fname]"; print ": ";
    my $tmp = <STDIN>; defined $tmp or return;
    chomp $tmp; length($tmp) or do {$fname ? $tmp = $fname : return};
    ReadFile2 $tmp;
}

sub WriteFile {
    scalar(@lines) or return;
    print "\nWrite to file"; $fname and print " [$fname]"; print ": ";
    my $tmp = <STDIN>; defined $tmp or return;
    chomp $tmp; length($tmp) or do {$fname ? $tmp = $fname : return};
    open(FILE, ">:utf8", $tmp) or do {print STDERR "\nError: $!\n"; return};
    for (my $i = 0; $i < scalar(@lines); $i++) {
	print FILE "$lines[$i]\n";
    }
    close(FILE);
    $fname = $tmp;
}

sub SetMap2 {
    my ($mode, $name) = @_;
    my $exists = ($mode ? exists $emap{$name} : exists $cmap{$name});
    $exists or do {print STDERR ($mode ? "\nEscape map" : "\nCharacter map") .
	    " `$name' doesn't exist\n"; return};
    $mode ? ($emap = $emap{$name}) : ($cmap = $cmap{$name});
}

sub SetMap {
    my $mode = shift;
    print ($mode ? "\nEscape map: " : "\nCharacter map: ");
    my $name = <STDIN>; defined $name or return;
    chomp $name; length($name) or do
	    {undef ($mode ? $emap : $cmap); return};
    SetMap2 $mode, $name;
}


my $rcfile = "$ENV{'HOME'}/.pluerc";
-f $rcfile and do {do $rcfile or die "$@\n"};

my $mapfile = "$ENV{'HOME'}/.plue/maps";
-f $mapfile and do {do $mapfile or die "$@\n"};

$defcmap and SetMap2 0, $defcmap;
$defemap and SetMap2 1, $defemap;

scalar(@ARGV) and ReadFile2 $ARGV[0];

while (1) {
    print "\nSelect (#, p, n, /, s, c, m, d, r, w, k, e, q) [" .
    	    scalar(@lines) . "]: ";
    my $r = <STDIN>; defined $r or exit;
    chomp $r;
    SWITCH: {
	$r =~ /^[0-9]+$/ and do {Input $r; last};
	$r =~ /^[Pp]$/ and do {Print 0; last};
	$r =~ /^[Nn]$/ and do {Print 1; last};
	$r =~ /^\/$/   and do {Find; last};
	$r =~ /^[Ss]$/ and do {Subst; last};
	$r =~ /^[Cc]$/ and do {Copy; last};
	$r =~ /^[Mm]$/ and do {Move; last};
	$r =~ /^[Dd]$/ and do {Delete; last};
	$r =~ /^[Rr]$/ and do {ReadFile; last};
	$r =~ /^[Ww]$/ and do {WriteFile; last};
	$r =~ /^[Kk]$/ and do {SetMap 0; last};
	$r =~ /^[Ee]$/ and do {SetMap 1; last};
	$r =~ /^[Qq]$/ and exit;
	print "\nInvalid entry\n";
    }
}
.