#!/usr/bin/perl

=begin metadata

Name: ed
Description: text editor
Author: George M Jones, gmj@infinet.com
License: gpl

=end metadata

=cut

# What: A perl version of Unix ed editor.
#
#   Currently implemented:
#        - most addressing modes (".","$","#","/pat/","?pat?","[+-]#, etc.)
#        - command parsing
#        - regular expressions (using perl's built in regexps)
#        - Both regular and extended (-v) error messages
#
# Why?:
#        - Because ed is "always there" (or supposed to be anyways)
#        - Because I violently dislike vi (on Unix) and NOTEPAD on WinDoze
#        - Because working on this is more fun than Y2K testing !
#
# Who:
#        George M Jones (gmj@infinet.com).  Please send changes to me.
#
# When:
#        Version 0.1
#          - 06/09/99 - Created (note that non-Y2K compliant date !!!)
#
# Irony:  This was, of course, edited originaly with emacs...
#
# Legaleese:
#        This program is released under the GNU Public License.
#
# Todo:
#        - add a "-e" flag to allow it to be used in sed(1) like fashion.
#        - add buffer size limitations for strict compatability
#        - discard NULS, chars after \n
#        - refuse to read non-ascii files
#        - Add BSD/GNU extentions

use strict;

use File::Temp qw();
use Getopt::Std qw(getopts);

use constant A_NOMATCH => -1;
use constant A_NOPAT   => -2;
use constant A_PATTERN => -3;
use constant A_NOMARK  => -4;
use constant A_RANGE   => -5;

use constant E_ADDREXT => 'unexpected address';
use constant E_ADDRBAD => 'invalid address';
use constant E_ARGEXT  => 'extra arguments detected';
use constant E_SUFFBAD => 'invalid command suffix';
use constant E_CLOSE   => 'cannot close file';
use constant E_OPEN    => 'cannot open file';
use constant E_READ    => 'cannot read file';
use constant E_NOFILE  => 'no current filename';
use constant E_FNAME   => 'invalid filename';
use constant E_UNSAVED => 'buffer modified';
use constant E_CMDBAD  => 'unknown command';
use constant E_PATTERN => 'invalid pattern delimiter';
use constant E_NOMATCH => 'no match';
use constant E_NOPAT   => 'no previous pattern';
use constant E_UNDO    => 'nothing to undo';

use constant EX_SUCCESS => 0;
use constant EX_FAILURE => 1;

# important globals

my $CurrentLineNum = 0;         # default to before first line.
my $RememberedFilename = undef; # the default filename for writes, etc.
my $NeedToSave = 0;             # buffer modified
my $UserHasBeenWarned = 0;      # warning given regarding modified buffer
my $Error = undef;              # saved error string for h command
my $Prompt = undef;             # saved prompt string for -p option
my $SearchPat;                  # saved pattern for repeat search
my $Scripted = 0;
my @lines;                      # buffer for file being edited.
my $command;                    # single letter command entered by user
my $commandsuf;                 # single letter modifier of command
my @adrs;                       # 1 or 2 line numbers for commands to operate on
my @args;                       # command arguments (filenames, search patterns...)
my %marks;
my $isGlobal;
my $HelpMode = 0;
my $UndoFile;
my $UndoLine;

# constants

my $NO_APPEND_MODE = 0;
my $NO_INSERT_MODE = 0;
my $INSERT_MODE = 1;
my $APPEND_MODE = 2;
my $QUESTIONS_MODE = 1;
my $NO_QUESTIONS_MODE = 0;
my $PRINT_NUM = 1;
my $PRINT_BIN = 2;

our $VERSION = '0.22';

my @ESC = (
    '\\000', '\\001', '\\002', '\\003', '\\004', '\\005', '\\006', '\\a',
    '\\b',   '\\t',   "\$\n",  '\\v',   '\\f',   '\\r',   '\\016', '\\017',
    '\\020', '\\021', '\\022', '\\023', '\\024', '\\025', '\\026', '\\027',
    '\\030', '\\031', '\\032', '\\033', '\\034', '\\035', '\\036', '\\037',
    ' ',     '!',     '"',     '#',     '\\$',   '%',     '&',     q('),
    '(',     ')',     '*',     '+',     ',',     '-',     '.',     '/',
    '0',     '1',     '2',     '3',     '4',     '5',     '6',     '7',
    '8',     '9',     ':',     ';',     '<',     '=',     '>',     '?',
    '@',     'A',     'B',     'C',     'D',     'E',     'F',     'G',
    'H',     'I',     'J',     'K',     'L',     'M',     'N',     'O',
    'P',     'Q',     'R',     'S',     'T',     'U',     'V',     'W',
    'X',     'Y',     'Z',     '[',     '\\\\',  ']',     '^',     '_',
    '`',     'a',     'b',     'c',     'd',     'e',     'f',     'g',
    'h',     'i',     'j',     'k',     'l',     'm',     'n',     'o',
    'p',     'q',     'r',     's',     't',     'u',     'v',     'w',
    'x',     'y',     'z',     '{',     '|',     '}',     '~',     '\\177',
    '\\200', '\\201', '\\202', '\\203', '\\204', '\\205', '\\206', '\\207',
    '\\210', '\\211', '\\212', '\\213', '\\214', '\\215', '\\216', '\\217',
    '\\220', '\\221', '\\222', '\\223', '\\224', '\\225', '\\226', '\\227',
    '\\230', '\\231', '\\232', '\\233', '\\234', '\\235', '\\236', '\\237',
    '\\240', '\\241', '\\242', '\\243', '\\244', '\\245', '\\246', '\\247',
    '\\250', '\\251', '\\252', '\\253', '\\254', '\\255', '\\256', '\\257',
    '\\260', '\\261', '\\262', '\\263', '\\264', '\\265', '\\266', '\\267',
    '\\270', '\\271', '\\272', '\\273', '\\274', '\\275', '\\276', '\\277',
    '\\300', '\\301', '\\302', '\\303', '\\304', '\\305', '\\306', '\\307',
    '\\310', '\\311', '\\312', '\\313', '\\314', '\\315', '\\316', '\\317',
    '\\320', '\\321', '\\322', '\\323', '\\324', '\\325', '\\326', '\\327',
    '\\330', '\\331', '\\332', '\\333', '\\334', '\\335', '\\336', '\\337',
    '\\340', '\\341', '\\342', '\\343', '\\344', '\\345', '\\346', '\\347',
    '\\350', '\\351', '\\352', '\\353', '\\354', '\\355', '\\356', '\\357',
    '\\360', '\\361', '\\362', '\\363', '\\364', '\\365', '\\366', '\\367',
    '\\370', '\\371', '\\372', '\\373', '\\374', '\\375', '\\376', '\\377',
);

my %WANT_FILE = (
    'e' => 1,
    'E' => 1,
    'f' => 1,
    'r' => 1,
    'w' => 1,
    'W' => 1,
);

my %cmdtab = (
    '!' => \&edPipe,
    '=' => \&edPrintLineNum,
    'f' => \&edFilename,
    'd' => \&edDelete,
    'P' => \&edPrompt,
    'p' => \&edPrint,
    's' => \&edSubstitute,
    'j' => \&edJoin,
    't' => \&edMove,
    'H' => \&edSetHelp,
    'h' => \&edHelp,
    'k' => \&edMark,
    'm' => \&edMoveDel,
    'n' => \&edPrintNum,
    'l' => \&edPrintBin,
    'Q' => \&edQuit,
    'q' => \&edQuitAsk,
    'i' => \&edInsert,
    'a' => \&edAppend,
    'w' => \&edWrite,
    'W' => \&edWriteAppend,
    'c' => \&edChangeLines,
    'E' => \&edEdit,
    'e' => \&edEditAsk,
    'r' => \&edRead,
    'u' => \&edUndo,
    '_' => \&edSetCurrentLine,
    'nop' => sub {},
);

my %ro_cmds = (
    '!' => 1,
    '=' => 1,
    'f' => 1,
    'P' => 1,
    'p' => 1,
    'H' => 1,
    'h' => 1,
    'k' => 1,
    'n' => 1,
    'l' => 1,
    'Q' => 1,
    'q' => 1,
    'W' => 1,
    'w' => 1,
    '_' => 1,
    'nop' => 1,
);

$SIG{HUP} = sub {
    if ($NeedToSave) {
        my $fh;
        if (open $fh, '>', 'ed.hup') {
            shift @lines;
            print {$fh} join('', @lines);
            close $fh;
        }
    }
    exit EX_FAILURE;
};

my %opt;
getopts('p:s', \%opt) or Usage();
if (defined $opt{'p'}) {
    $Prompt = $opt{'p'};
}
$args[0] = shift;
$args[0] = undef if (defined($args[0]) && $args[0] eq '-');
Usage() if @ARGV;
$Scripted = $opt{'s'};
edEdit($NO_QUESTIONS_MODE, $NO_APPEND_MODE);
input() while 1;

sub input {
    $command = $commandsuf = '';
    @adrs = ();
    @args = ();
    print $Prompt if defined $Prompt;
    $_ = <>;
    unless (defined $_) {
        edQuitAsk() or return;
    }
    chomp;

    if (!edParse()) {
        edWarn(E_CMDBAD);
        return;
    }
    # sanity check addresses
    foreach my $ad (@adrs) {
        next unless defined $ad;
        if ($ad == A_NOMATCH) {
            edWarn(E_NOMATCH);
            return;
        } elsif ($ad == A_NOPAT) {
            edWarn(E_NOPAT);
            return;
        } elsif ($ad == A_PATTERN) {
            edWarn(E_PATTERN);
            return;
        } elsif ($ad < 0) {
            edWarn(E_ADDRBAD);
            return;
        }
    }
    if (defined($adrs[0]) and defined($adrs[1])) {
        if ($adrs[1] < $adrs[0]) {
            edWarn(E_ADDRBAD);
            return;
        }
    }

    my $func = $cmdtab{$command};
    if (!defined($func)) {
        edWarn(E_CMDBAD);
        return;
    }

    my ($saved_buf, $saved_ln);
    if (!exists($ro_cmds{$command})) {
        $saved_buf = write_undo();
        $saved_ln = $CurrentLineNum;
    }
    my $err = $func->();
    edWarn($err) if $err;
    if ($NeedToSave && $saved_buf) {
        $UndoFile = $saved_buf;
        $UndoLine = $saved_ln;
    }
    return;
}

sub VERSION_MESSAGE {
    print "ed version $VERSION\n";
    exit EX_SUCCESS;
}

sub maxline {
    my $n = $#lines;
    if ($n < 0) {
        $n = 0;
    }
    return $n;
}

sub getrc {
    return EX_FAILURE if defined $Error;
    return EX_SUCCESS;
}

sub edChangeLines {
    my $err = edDelete();
    unless ($err) {
        $adrs[1] = undef;
        edInsert();
    }
    return $err;
}

sub edPrompt {
    return E_ADDREXT if defined $adrs[0];
    return E_ARGEXT if defined $args[0];

    if (defined $Prompt) {
	$Prompt = undef;
    } else {
	$Prompt = defined $opt{'p'} ? $opt{'p'} : '*';
    }
    return;
}

sub edHelp {
    my $toggle = shift;

    return E_ADDREXT if defined $adrs[0];
    return E_ARGEXT if defined $args[0];

    if ($toggle) {
        $HelpMode ^= 1;
    }
    if (defined($Error) && ($HelpMode || !$toggle)) {
         print "$Error\n";
    }
    return;
}

sub edMark {
    my $c = $args[0];
    if (!defined($c) || $c !~ m/\A[a-z]\z/) {
        return E_SUFFBAD;
    }
    my $ad = $adrs[1];
    $ad = $adrs[0] unless defined $ad;
    $ad = $CurrentLineNum unless defined $ad;
    $marks{$c} = $ad;
    return;
}

#
# Print contents of requested lines
#

sub edPrint {
    my $mode = shift;

    my $do_bin = $mode == $PRINT_BIN;
    my $do_num = $mode == $PRINT_NUM;

    if (defined $args[0]) {
        if ($args[0] =~ s/\A([lnp]+)//) {
            my $arg = $1;
            $do_bin = 1 if $arg =~ m/l/;
            $do_num = 1 if $arg =~ m/n/;
        }
        return E_ARGEXT if length $args[0];
    }
    unless ($isGlobal) {
        $adrs[0] = $CurrentLineNum unless (defined($adrs[0]));
        $adrs[1] = $adrs[0] unless (defined($adrs[1]));
        return E_ADDRBAD if ($adrs[0] == 0 || $adrs[1] == 0);

        my $start = $adrs[0];
        my $end = $adrs[1];
        @adrs = ($start .. $end);
    }
    for my $i (@adrs) {
        if ($do_num) {
            print $i, "\t";
        }
        if ($do_bin) {
            print escape_line($i);
        } else {
            print $lines[$i];
        }
    }
    $CurrentLineNum = $adrs[-1];
    return;
}

sub escape_line {
    my $idx = shift;

    my @chars = unpack 'C*', $lines[$idx];
    die 'internal error: unpack' unless @chars;
    my @s = map { $ESC[$_] } @chars;
    return join '', @s;
}

# does not modify buffer
sub edPipe {
    return E_ADDREXT if defined $adrs[0];

    if (defined $args[0]) {
        my $rc = system $args[0];
        print "$args[0]: $!\n" if ($rc == -1);
    }
    print "!\n";
    return;
}

# merge lines back into $lines[$adrs[0]]
sub edJoin {
    return E_ARGEXT if defined $args[0];
    if (defined($adrs[0]) && $adrs[0] == 0) {
        return E_ADDRBAD;
    }
    if (defined($adrs[1]) && $adrs[1] == 0) {
        return E_ADDRBAD;
    }
    if (!defined($adrs[0]) && !defined($adrs[1])) {
        if ($CurrentLineNum == maxline()) {
            return E_ADDRBAD;
        }
        $adrs[0] = $CurrentLineNum;
        $adrs[1] = $CurrentLineNum + 1;
    }
    elsif (defined($adrs[0]) && !defined($adrs[1])) { # nop
        return;
    }
    if ($adrs[0] == $adrs[1]) { # nop
        return;
    }

    my $buf = $lines[$adrs[0]];
    my $start = $adrs[0] + 1;
    for my $i ($start .. $adrs[1]) {
        chomp $buf;
        $buf .= $lines[$i];
    }
    $lines[$adrs[0]] = $buf;
    splice @lines, $start, $adrs[1] - $adrs[0];
    $NeedToSave = 1;
    $UserHasBeenWarned = 0;
    $CurrentLineNum = $adrs[0];
    return;
}

sub edMove {
    my $delete = shift;

    my $start = $adrs[0];
    my $end = $adrs[1];
    unless (defined $start) {
        $start = $end = $CurrentLineNum;
    }
    unless (defined $end) {
        $end = $start;
    }
    if ($start == 0 || $end == 0) { # allowed for $dst only
        return E_ADDRBAD;
    }
    $_ = $args[0];
    my $dst = getAddr();
    return E_SUFFBAD if m/\S/;
    if (defined $dst) {
        return E_NOMATCH if $dst == A_NOMATCH;
        return E_NOPAT if $dst == A_NOPAT;
        return E_ADDRBAD if $dst < 0;
    } else {
        $dst = $CurrentLineNum;
    }
    if ($delete) {
        # move a line to itself
        if ($start == $dst && $end == $dst) {
            return;
        }
        # move a range into itself
        if ($dst >= $start && $dst <= $end) {
            return E_ADDRBAD;
        }
    }

    my $count = $end - $start + 1;
    my @copy = @lines[$start .. $end];
    if ($start > $dst && $end > $dst) {
        splice(@lines, $start, $count) if $delete;
        splice @lines, $dst + 1, 0, @copy;
    } else {
        # avoid $dst referring to the wrong line
        splice @lines, $dst + 1, 0, @copy;
        splice(@lines, $start, $count) if $delete;
    }

    $NeedToSave = 1;
    $UserHasBeenWarned = 0;
    $CurrentLineNum = $dst + scalar(@copy);
    return;
}

sub edMoveDel { edMove(1); }
sub edSetHelp { edHelp(1); }
sub edPrintNum { edPrint($PRINT_NUM); }
sub edPrintBin { edPrint($PRINT_BIN); }
sub edQuitAsk { edQuit(1); }
sub edAppend { edInsert(1); }
sub edWriteAppend { edWrite(1); }
sub edEditAsk { edEdit(!$Scripted, $NO_INSERT_MODE); }
sub edRead { edEdit($QUESTIONS_MODE,$INSERT_MODE); }

#
# Perform text substitution
#

sub edSubstitute {
    my($LastMatch,$char,$first,$middle,$last,$whole,$flags,$PrintLastLine);

    if (!defined($args[0]) || length($args[0]) == 0) {
        return E_PATTERN;
    }
    unless ($isGlobal) {
        $adrs[0] = $CurrentLineNum unless (defined($adrs[0]));
        $adrs[1] = $adrs[0] unless (defined $adrs[1]);

        if ($adrs[0] == 0 || $adrs[1] == 0) {
            return E_ADDRBAD;
        }
        my $start = $adrs[0];
        my $end = $adrs[1];
        @adrs = ($start .. $end);
    }

    # do wierdness to match semantics if last character
    # is present or absent

    $char = substr $args[0], 0, 1;
    eval {
        ($whole,$first,$middle,$last,$flags) = ($args[0] =~ /(($char)[^"$char"]*($char)[^"$char"]*($char)?)([imsx]*)/);
        1;
    } or do {
        return E_PATTERN;
    };

    if (defined($char) and defined($whole) and
        ($flags eq "") and (not defined($last))) {
        $args[0] .= "$char";
        $PrintLastLine = 1;
    }

    # do the search and substitution
    for my $lineno (@adrs) {
        my $evalstring = "\$lines[\$lineno] =~ s$args[0]";

        if (eval $evalstring) {
            $LastMatch = $lineno;
            $NeedToSave = 1;
            $UserHasBeenWarned = 0;
        }

    }
    return E_NOMATCH unless defined $LastMatch;
    $CurrentLineNum = $LastMatch;

    print $lines[$LastMatch] if ($PrintLastLine);
    return;
}

#
# Delete requested lines
#

sub edDelete {
    return E_ARGEXT if defined $args[0];

    unless ($isGlobal) {
        $adrs[0] = $CurrentLineNum unless (defined($adrs[0]));
        $adrs[1] = $adrs[0] unless (defined($adrs[1]));
        return E_ADDRBAD if ($adrs[0] == 0 || $adrs[1] == 0);

        my $start = $adrs[0];
        my $end = $adrs[1];
        @adrs = ($start .. $end);
    }
    for my $i (reverse @adrs) {
        splice @lines, $i, 1;
    }
    $NeedToSave = 1;
    $UserHasBeenWarned = 0;

    $CurrentLineNum = $adrs[0];
    if ($CurrentLineNum > maxline()) {
        $CurrentLineNum = maxline();
    }
    return;
}

#
# Print or set filename
#

sub edFilename {
    if (defined($adrs[0]) or defined($adrs[1])) {
        return E_ADDREXT;
    }
    if (defined($args[0])) {
        return E_FNAME if $args[0] =~ m/\A\!/;
        return E_FNAME if $args[0] =~ m/\/\Z/;
        return E_FNAME if ($args[0] eq '.' || $args[0] eq '..');
        $RememberedFilename = $args[0];
    }
    if (defined($RememberedFilename)) {
        print "$RememberedFilename\n";
    }
    else {
        return E_NOFILE;
    }
    return;
}

#
# Write requested lines
#

sub edWrite {
    my($AppendMode) = @_;
    my($fh, $filename, $chars, $qflag);

    $chars = 0;

    if (!defined($adrs[0]) && !defined($adrs[1])) {
        $adrs[0] = 1;
        $adrs[1] = maxline();
    } elsif (defined($adrs[0]) && !defined($adrs[1])) {
        $adrs[1] = $adrs[0];
    }
    return E_ADDRBAD if $adrs[0] == 0;

    if (length $commandsuf) {
        if ($commandsuf eq 'q') {
            $qflag = 1;
        } else {
            return E_SUFFBAD;
        }
    }

    if (defined $args[0]) {
        $filename = $RememberedFilename = $args[0];
    } elsif (defined $RememberedFilename) {
        $filename = $RememberedFilename;
    } else {
        return E_NOFILE;
    }
    if ($filename =~ s/\A\!//) {
        return unless (open $fh, "| $filename"); # no error
    } else {
        my $mode = $AppendMode ? '>>' : '>';
        unless (open $fh, $mode, $filename) {
            warn "$filename: $!\n";
            return E_OPEN;
        }
    }
    for my $line (@lines[$adrs[0]..$adrs[1]]) {
        print {$fh} $line;
        $chars += length($line);
    }
    unless (close $fh) {
        warn "$filename: $!\n";
        return E_CLOSE;
    }

    $NeedToSave = $UserHasBeenWarned = 0;
    print "$chars\n" unless $Scripted;
    exit getrc() if $qflag;
    return;
}


#
# Read in the named file
#
# return:
#        0 - failure
#        1 - success

sub edEdit {
    my($QuestionsMode,$InsertMode) = @_;
    my(@tmp_lines, $chars, $fh, $filename);

    if ($InsertMode) {
        if (defined $adrs[1]) {
            $adrs[0] = $adrs[1];
        }
        if (!defined($adrs[0])) {
            $adrs[0] = maxline();
        }
    } else {
        if (defined($adrs[0]) or defined($adrs[1])) {
            return E_ADDREXT;
        }
        if ($NeedToSave && $QuestionsMode && !$UserHasBeenWarned) {
            $UserHasBeenWarned = 1;
            return E_UNSAVED;
        }
    }

    if (defined $args[0]) {
        return E_FNAME unless (length $args[0]);
        $filename = $RememberedFilename = $args[0];
    } elsif (defined $RememberedFilename) {
        $filename = $RememberedFilename;
    } else {
        $CurrentLineNum = 0;
        @lines = (0);
        return;
    }

    if (-d $filename) {
        warn "$filename: is a directory\n";
        return E_READ;
    }
    if ($filename =~ s/\A\!//) {
        return unless (open $fh, "$filename |"); # no error
    } else {
        unless (open $fh, '<', $filename) {
            warn "$filename: $!\n";
            return E_OPEN;
        }
    }
    $chars = 0;
    while (<$fh>) {
        push @tmp_lines, $_;
        $chars += length;
    }
    unless (close $fh) {
        warn "$filename: $!\n";
        return E_CLOSE;
    }
    if ($chars == 0) {
        $UserHasBeenWarned = 0;
        $CurrentLineNum = 0;
        @lines = (0);
        print "0\n" unless $Scripted;
        return;
    }
    if (substr($tmp_lines[-1], -1, 1) ne "\n") {
        $tmp_lines[-1] .= "\n";
        $chars++;
        print "Newline appended\n";
    }

    # now that we've got it, figure out what to do with it

    if ($InsertMode) {
        if (maxline() != 0 && $adrs[0] == maxline()) {
            push(@lines,@tmp_lines);
        } elsif ($adrs[0] == 0) {
            splice @lines, 1, 0, @tmp_lines;
        } else {
            splice @lines, $adrs[0] + 1, 0, @tmp_lines;
        }
        $CurrentLineNum = $adrs[0] + scalar(@tmp_lines);
        $NeedToSave = 1;
    } else {
        @lines = (undef, @tmp_lines);
        $NeedToSave = 0;
        $CurrentLineNum = maxline();
    }

    $UserHasBeenWarned = 0;
    print "$chars\n" unless $Scripted;
    return;
}

#
# Insert some text
#

sub edInsert {
    my $append = shift;
    my(@tmp_lines);

    return E_ARGEXT if defined $args[0];

    if (defined($adrs[1])) {
        $adrs[0] = $adrs[1];
    }
    if (!defined($adrs[0])) {
        $adrs[0] = $CurrentLineNum;
    }

    # suck the text into a temp array
    while (<>) {
        last if (/^\.$/);
        push(@tmp_lines,$_);
    }
    return unless (@tmp_lines); # no change

    my $src = $adrs[0];
    $src++ if ($src && $append);
    $src++ if $src == 0; # 0a == 0i == 1i

    splice @lines, $src, 0, @tmp_lines;

    $NeedToSave = 1;
    $UserHasBeenWarned = 0;
    return;
}


#
#  Print current line number
#

sub edPrintLineNum {
    return E_ARGEXT if defined $args[0];

    my $adr = $adrs[1];
    if (!defined($adr)) {
        $adr = $adrs[0];
    }
    if (!defined($adr)) {
        $adr = maxline();
    }
    print "$adr\n";
    return;
}

sub write_undo {
    my $fh = File::Temp->new;
    foreach (@lines) {
         print {$fh} $_;
    }
    seek $fh, 0, 0;
    return $fh;
}

sub edUndo {
    return E_ADDREXT if defined $adrs[0];
    return E_ARGEXT if defined $args[0];
    return E_UNDO unless defined $UndoFile;

    $CurrentLineNum = $UndoLine;
    @lines = <$UndoFile>;
    unshift @lines, undef;
    $UserHasBeenWarned = 0;
    $NeedToSave = 1; # new tmpfile
    return;
}

#
# Quit ed
#

sub edQuit {
    my($QuestionMode) = @_;

    return E_ADDREXT if defined $adrs[0];
    return E_ARGEXT if defined $args[0];

    if ($QuestionMode && $NeedToSave && !$UserHasBeenWarned) {
        $UserHasBeenWarned = 1;
        return E_UNSAVED;
    }
    exit getrc();
}

#
# Set current line
#
# Input:
#        $adrs[0] - the requested new current line
#        @lines - the buffer
#
# Side effects:
#        1. $CurrentLineNum is set
#        2. The new current line is printed.

sub edSetCurrentLine {
    return E_ARGEXT if defined $args[0];

    my $adr = $adrs[1];
    if (!defined($adr)) {
        $adr = $adrs[0];
    }
    if (defined($adr)) {
        if ($adr <= 0 || maxline() == 0 || $adr > maxline()) {
            return E_ADDRBAD;
        }
        $CurrentLineNum = $adr; # jump to specified line
    } else {
        return E_ADDRBAD if $CurrentLineNum == maxline();
        $CurrentLineNum++;
    }

    print $lines[$CurrentLineNum];
    return;
}

#
# Parse the next command
#
# Input: $_
#
# Output:
#        @adrs - the line number(s) of the lines on the input
#        $command - single character command
#
# Return:
#        1 - success
#        0 - parse failure
#

sub edParse {
    $isGlobal = 0;
    $command = 'nop';
    s/\A\s+//;
    $adrs[0] = getAddr();
    if (defined($adrs[0]) && ($adrs[0] == A_NOPAT || $adrs[0] == A_NOMATCH)) {
        return 1;
    }
    if (s/\A([,;\%])//) {
        my $sep = $1;
        return 0 if $sep eq '%' && defined($adrs[0]);
        $adrs[1] = getAddr();
        return 1 if defined($adrs[1]) && $adrs[1] < 0;

        unless (defined $adrs[0]) {
            $adrs[0] = $sep eq ';' ? $CurrentLineNum : 1;
            $adrs[1] = maxline() unless defined $adrs[1];
        }
    }
    if (s/\A([gv])\///) {
        my $invert = $1 eq 'v';
        my $re = getRe('/', 1);
        unless (defined $re) {
            $adrs[0] = A_PATTERN;
            return 1;
        }
        if (length($re) == 0) {
            unless (defined $SearchPat) {
                $adrs[0] = A_NOPAT;
                return 1;
            }
            $re = $SearchPat;
        }
        my @found = edSearchGlobal($re, $invert);
        return 1 unless @found; # nothing to do
        $isGlobal = 1;
        @adrs = @found;
    }
    if (s/\A([acdEefHhijklmnPpQqrstuWw=\!])//) { # optional argument
        $command = $1;
        if ($command eq 'W' || $command eq 'w') {
            if (s/\A[Qq]//) {
                $commandsuf = 'q';
            }
        }
        if ($WANT_FILE{$command} && m/\A\S/) {
            return 0; # space before filename
        }
        s/\A\s+//;
        $args[0] = $_ if length;
        return 1;
    }
    if (m/\A\s*\z/) { # set line if command omitted
        $command = '_';
        return 1;
    }
    return 0;
}

sub getAddr {
    my $n;
    if (s/\A([\-\^\+]+)//) { # '++--' == current+0
        $n = $CurrentLineNum;
        foreach my $c (split //, $1) {
            $n += $c eq '+' ? 1 : -1;
        }
    } elsif (s/\A\'([a-z])//) {
        $n = exists $marks{$1} ? $marks{$1} : A_NOMARK;
    } elsif (s/\A([0-9]+)//) { # '10' == 10
        $n = $1;
    } elsif (s/\A\.//) { # '.' == current line
        $n = $CurrentLineNum;
    } elsif (s/\A\$//) { # '$' == max line
        $n = maxline();
    } elsif (s/\A([\/\?])//) { # search: '/re/' or '?re?'
        my $delim = $1;
        my $re = getRe($delim);
        $re = '' unless defined $re; # delim not needed
        if (length($re) == 0) {
            return A_NOPAT unless defined $SearchPat;
            $re = $SearchPat;
        }
        $n = edSearch($re, $delim eq '?');
        $n = A_NOMATCH unless $n;
    }
    if (defined $n) {
        return A_RANGE if $n < 0 || $n > maxline();
    }
    return $n;
}

sub getRe {
    my ($delim, $delimreq) = @_;
    my $i;
    my @chars = split //;
    my $sz = scalar @chars;

    for ($i = 0; $i < $sz; $i++) {
        my $j = $i - 1;
        $j = 0 if $j < 0;
        last if $chars[$i] eq $delim && $chars[$j] ne '\\';
    }
    return if $delimreq && $i == $sz;
    my $re = substr $_, 0, $i;
    $_ = substr $_, $i + 1;
    return $re;
}

sub edSearch {
    my ($pattern, $backward) = @_;

    $SearchPat = $pattern;
    my $cur = $CurrentLineNum;
    my @idx;
    if ($backward) {
        @idx = reverse ($cur .. maxline(), 1 .. ($cur - 1));
    } else {
        @idx = (($cur + 1) .. maxline(), 1 .. $cur);
    }
    foreach my $line (@idx) {
        if ($lines[$line] =~ /$pattern/) {
            return $line;
        }
    }
    return 0;
}

sub edSearchGlobal {
    my($pattern, $invert) = @_;

    my $end = maxline();
    my $start = 1;
    if (defined $adrs[0]) {
        if ($adrs[0] == 0) {
            edWarn(E_ADDRBAD);
            return;
        }
        $start = $end = $adrs[0];
    }
    if (defined $adrs[1]) {
        if ($adrs[1] == 0) {
            edWarn(E_ADDRBAD);
            return;
        }
        $end = $adrs[1];
    }
    $SearchPat = $pattern;
    my @found;
    for my $i ($start .. $end) {
        my $match;
        if ($invert) {
            $match = $lines[$i] !~ m/$pattern/;
        } else {
            $match = $lines[$i] =~ m/$pattern/;
        }
        push @found, $i if $match;
    }
    return @found;
}

sub Usage {
    print "usage: ed [-p prompt] [-s] [file]\n";
    exit EX_FAILURE;
}

#
# Print error and save it
#
# edWarn($msg)
#

sub edWarn {
    my $msg = shift;

    $Error = $msg;
    print "?\n";
    if ($HelpMode) {
        print "$msg\n";
    }
}

__END__

=encoding utf8

=head1 NAME

ed - text editor

=head1 SYNOPSIS

ed [-p prompt] [-s] [file]

=head1 DESCRIPTION

ed initially reads its input file into a buffer.
If no file argument is provided the buffer will be empty.
Commands are then entered to display, modify and save the buffer.
Line numbers within the buffer are referred to as addresses.
Address 1 is the first line in the buffer; address 0 is invalid.

ed keeps track of the current line selected in the buffer.
Commands for modifying the buffer can be entered without an explicit
address; the current line will be processed.
Entering a bare address such as "2" first resets the current
line pointer, then prints the line.

Commands are denoted by a single letter.
The "p" command prints one or more lines.
An address can precede a command, so "2p" first resets the current
line pointer then prints the line.
This is the same result as for entering the bare address "2";
however, print is explicit.

A command may operate on a range of addresses at once.
An address range is entered as two numbers separated by a comma, e.g. "1,10".
The numbers are included as the first and last number of the range.
So "1,10" spans from line 1 to 10.
A range is then used as a command prefix, e.g. "1,2p" will print 2 lines.
Addressing a line outside the scope of the buffer results in an error.

The commands "a", "c" and "i" allow text to be entered into the buffer.
Text input is terminated by a line containing the single character ".".
If an error occurs ed will print "?".
The "h" command fetches the saved error message and prints it.

=head2 OPTIONS

The following options are available:

=over 4

=item -p STRING

Use the specified STRING as a command prompt.
By default no prompt is displayed.

=item -s

Suppress byte counts and diagnostics

=back

=head2 EDITOR COMMANDS

=over 4

=item a

Append text

=item c

Change text

=item d

Delete text

=item E FILE

Forced "e" command; suppress warning prompt

=item e FILE

Load and edit the named FILE argument

=item f [FILE]

Show/set a filename

=item H

Toggle help mode; this causes descriptive errors to be displayed

=item h

Display last error

=item i

Insert text

=item j

Join a range of lines into a single line.
The current address is set to the destination address.

=item kCH

Mark an address with the lowercase letter CH.
The mark can then be used as 'CH in place of an address.

=item l

Print lines with escape sequences for non-printable characters

=item m

Move a range of lines to a new address.
The current address is set to the last line moved.

=item n

Print from buffer with line number prefix

=item P

Toggle command prompt mode.
A string provided by -p will be used; otherwise, the default is '*'

=item p

Print from buffer

=item Q

Forced "q" command; suppress warning prompt

=item q

Quit program

=item r FILE

Read named FILE into buffer

=item /PATTERN

Search for PATTERN in the buffer, starting from the current line.
If no pattern is given the previous search is repeated.

=item ?PATTERN

Search backwards for PATTERN in the buffer, starting from the current line.
If no pattern is given the previous search is repeated.

=item g/PATTERN/CMD

Search globally in buffer for PATTERN and run command CMD on each matching line.
CMD is one of the following commands: 'd', 'l', 'n', 'p' and 's'.
CMD can be omitted.

=item v/PATTERN/CMD

Repeatedly run command CMD for each line in the buffer not matching PATTERN.
CMD is one of the following commands: 'd', 'l', 'n', 'p' and 's'.
CMD can be omitted.

=item s///

Substitute text with a regular expression

=item t

Copy (transfer) lines to a destination address.
The current address is set to the last line copied.

=item u

Undo the last command, restoring the editor buffer to its previous state.
The current address is set to what it was before the previous command.
The undo function is its own inverse, so multiple levels of undo are not possible.

=item W [FILE]

Write buffer to file in append mode

=item w [FILE]

Write buffer to file

=item wq [FILE]

Write buffer to file, then quit

=item =

Display current line number

=back

=head1 EXIT STATUS

=over 4

=item * 0 - All commands were processed successfully

=item * 1 - An error occurred

=back

=head1 AUTHOR

Written by George M Jones

=cut
