ed

#!/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...
#
# Commentary:
#        The guiding principals of this implentation are:
#                - Functionality
#                - Understandability
#
#        "perl coolness" was not a guiding principal, as the author is at best
#        an accomplished perl user.  If you like the program, use it.
#        If you don't, don't.
#
# Legaleese:
#        This program is released under the GNU Public License.
#
# Todo:
#        - Implement the following commands from the v7 docs:
#                u - undo
#
#        - 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 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 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 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 $SupressCounts = 0;          # byte counts are printed by default
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 $EXTENDED_MESSAGES = 0;

# 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.18';

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,
    '_' => \&edSetCurrentLine,
    'nop' => sub {},
);

$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;
$SupressCounts = $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 > maxline() || $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;
    }
    $func->();
}

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

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

sub edChangeLines {
    if (edDelete()) {
        $adrs[1] = undef;
        edInsert();
    }
}

sub edPrompt {
    if (defined $adrs[0]) {
        edWarn(E_ADDREXT);
        return;
    }
    if (defined $args[0]) {
        edWarn(E_ARGEXT);
        return;
    }
    if (defined $Prompt) {
	$Prompt = undef;
    } else {
	$Prompt = defined $opt{'p'} ? $opt{'p'} : '*';
    }
}

sub edHelp {
    my $toggle = shift;

    if (defined $adrs[0]) {
        edWarn(E_ADDREXT);
        return;
    }
    if (defined $args[0]) {
        edWarn(E_ARGEXT);
        return;
    }
    if ($toggle) {
        $EXTENDED_MESSAGES ^= 1;
    }
    if (defined($Error) && ($EXTENDED_MESSAGES || !$toggle)) {
         print "$Error\n";
    }
}

sub edMark {
    my $c = $args[0];
    if (!defined($c) || $c !~ m/\A[a-z]\z/) {
        edWarn(E_SUFFBAD);
        return;
    }
    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/;
        }
        if (length $args[0]) {
            edWarn(E_ARGEXT);
            return;
        }
    }
    unless ($isGlobal) {
        $adrs[0] = $CurrentLineNum unless (defined($adrs[0]));
        $adrs[1] = $adrs[0] unless (defined($adrs[1]));

        if ($adrs[0] == 0 || $adrs[1] == 0) {
            edWarn(E_ADDRBAD);
            return;
        }
        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];
}

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 {
    if (defined $adrs[0]) {
        edWarn(E_ADDREXT);
        return;
    }
    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 {
    if (defined($args[0])) {
        edWarn(E_ARGEXT);
        return;
    }
    if (defined($adrs[0]) && $adrs[0] == 0) {
        edWarn(E_ADDRBAD);
        return;
    }
    if (defined($adrs[1]) && $adrs[1] == 0) {
        edWarn(E_ADDRBAD);
        return;
    }
    if (!defined($adrs[0]) && !defined($adrs[1])) {
        if ($CurrentLineNum == maxline()) {
            edWarn(E_ADDRBAD);
            return;
        }
        $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];
}

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
        edWarn(E_ADDRBAD);
        return;
    }
    my $dst = $args[0];
    unless (defined $dst) {
        $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) {
            edWarn(E_ADDRBAD);
            return;
        }
    }

    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)
}

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(!$SupressCounts, $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) {
        edWarn(E_PATTERN);
        return;
    }
    unless ($isGlobal) {
        $adrs[0] = $CurrentLineNum unless (defined($adrs[0]));
        $adrs[1] = $adrs[0] unless (defined $adrs[1]);

        if ($adrs[0] == 0 || $adrs[1] == 0) {
            edWarn(E_ADDRBAD);
            return;
        }
        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 {
        edWarn(E_PATTERN);
        return;
    };

    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;
        }

    }
    unless (defined $LastMatch) {
        edWarn(E_NOMATCH);
        return;
    }

    $CurrentLineNum = $LastMatch;

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

#
# Delete requested lines
#

sub edDelete {
    if (defined $args[0]) {
        edWarn(E_ARGEXT);
        return;
    }
    unless ($isGlobal) {
        $adrs[0] = $CurrentLineNum unless (defined($adrs[0]));
        $adrs[1] = $adrs[0] unless (defined($adrs[1]));

        if ($adrs[0] == 0 || $adrs[1] == 0) {
            edWarn(E_ADDRBAD);
            return;
        }
        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 1;
}

#
# Print or set filename
#

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

#
# 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];
    }
    if ($adrs[0] == 0) {
        edWarn(E_ADDRBAD);
        return;
    }
    if (length $commandsuf) {
        if ($commandsuf eq 'q') {
            $qflag = 1;
        } else {
            edWarn(E_SUFFBAD);
            return;
        }
    }

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

    $NeedToSave = 0;
    $UserHasBeenWarned = 0;
    print "$chars\n" unless ($SupressCounts);

    if ($qflag) {
        exit EX_SUCCESS;
    }
}


#
# 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])) {
            edWarn(E_ADDREXT);
            return 0;
        }
        if ($NeedToSave && $QuestionsMode && !$UserHasBeenWarned) {
            $UserHasBeenWarned = 1;
            edWarn(E_UNSAVED);
            return 0;
        }
    }

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

    if (-d $filename) {
        warn "$filename: is a directory\n";
        edWarn(E_READ);
        return 0;
    }
    if ($filename =~ s/\A\!//) {
        return unless (open $fh, "$filename |"); # no error
    } else {
        unless (open $fh, '<', $filename) {
            warn "$filename: $!\n";
            edWarn(E_OPEN);
            return 0;
        }
    }
    $chars = 0;
    while (<$fh>) {
        push @tmp_lines, $_;
        $chars += length;
    }
    unless (close $fh) {
        warn "$filename: $!\n";
        edWarn(E_CLOSE);
        return 0;
    }
    if ($chars == 0) {
        $UserHasBeenWarned = 0;
        $CurrentLineNum = 0;
        @lines = (0);
        print "0\n" unless $SupressCounts;
        return 1;
    }
    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 $SupressCounts;
    return 1;
}

#
# Insert some text
#

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

    if (defined($args[0])) {
        edWarn(E_ARGEXT);
        return;
    }
    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,$_);
    }
    if (scalar(@tmp_lines) == 0) {
        return 1;
    }

    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 1;
}


#
#  Print current line number
#

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

#
# Quit ed
#

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

    if (defined $adrs[0]) {
        edWarn(E_ADDREXT);
        return;
    }
    if (defined($args[0])) {
        edWarn(E_ARGEXT);
        return;
    }
    if ($QuestionMode && $NeedToSave && !$UserHasBeenWarned) {
        $UserHasBeenWarned = 1;
        edWarn(E_UNSAVED);
        return;
    }
    exit EX_SUCCESS;
}

#
# 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 {
    if (defined($args[0])) {
        edWarn(E_ARGEXT);
        return 0;
    }

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

    print $lines[$CurrentLineNum];
    return 1;
}

#
# 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([acdEefHhijklmnPpQqrstWw=\!])//) { # 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;
    }
    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 ($EXTENDED_MESSAGES) {
        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 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 AUTHOR

Written by George M Jones

=cut