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:
#                k - mark
#                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 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';

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

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

my %opt;
getopts('dp: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;
    }
    if ($opt{'d'}) {
        print "command: /$command/ ";
        print "adrs[0]: /$adrs[0]/ " if defined($adrs[0]);
        print "adrs[1]: /$adrs[1]/ " if defined($adrs[1]);
        print "args[0]: /$args[0]/ " if defined($args[0]);
        print "\n";
    }

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

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

#
# Print contents of requested lines
#

sub edPrint {
    my $mode = shift;

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

    if ($mode == $PRINT_NUM) {
        for my $i (@adrs) {
            print $i, "\t", $lines[$i];
        }
    } elsif ($mode == $PRINT_BIN) {
        for my $i (@adrs) {
            print escape_line($i);
        }
    } else {
        for my $i (@adrs) {
            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);

    # parse args

    $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;
    }
    if (!defined($args[0]) || length($args[0]) == 0) {
        edWarn(E_PATTERN);
        return;
    }

    # 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[0]..$adrs[1]) {
        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])) {
        $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;
    }
    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 0;
    }
}


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

    # v7 docs say this does not affect current line.  GNU ed sets the line.
    # We go with the v7 docs.
}

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

#
# 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] < 0) {
        return 1;
    }
    if (s/\A,//) { # address separator
        $adrs[1] = getAddr();
        if (defined($adrs[1]) && $adrs[1] < 0) {
            return 1;
        }
        unless (defined $adrs[0]) {
            $adrs[0] = 1;
            $adrs[1] = maxline() unless defined $adrs[1];
        }
    }
    if (s/\A([gv])\///) {
        my $invert = $1 eq 'v';
        my $end = rindex $_, '/';
        return 0 if $end == -1; # g/re/p needs trailing /
        my $pat = substr $_, 0, $end;
        my $repcmd = substr $_, $end + 1;
        my @found = edSearchGlobal($pat, $invert);
        if (@found) {
            $isGlobal = 1;
            $command = $repcmd;
            @adrs = @found;
        }
        return 1;
    }
    if (s/\A([acdEefHhijlmnPpQqrstWw=\!])//) { # optional argument
        $command = $1;
        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([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 $i;
        my @chars = split //;
        for ($i = 0; $i < scalar(@chars); $i++) {
            my $j = $i - 1;
            $j = 0 if $j < 0;
            last if $chars[$i] eq $delim && $chars[$j] ne '\\';
        }
        my $re = substr $_, 0, $i;
        if (length($re) == 0) {
            return A_NOPAT unless defined $SearchPat;
            $re = $SearchPat;
        }
        $_ = substr $_, $i + 1;
        if ($delim eq '/') {
            $n = edSearchForward($re);
        } else {
            $n = edSearchBackward($re);
        }
        $n = A_NOMATCH unless $n;
    }
    return $n;
}

#
# Search forward for a pattern...wrap if not found
#
# Inputs:
#        pattern                - via argument
#        CurrentLineNum        - global
#        lines                - global
#
# Return:
#        0                - not found
#        >0                - line where first found
#

sub edSearchForward {
    my($pattern) = @_;

    $SearchPat = $pattern;
    for my $line (($CurrentLineNum + 1) .. maxline(), 1 .. $CurrentLineNum) {
        if ($lines[$line] =~ /$pattern/) {
            return $line;
        }
    }
    return 0;
}

#
# Search backward for a pattern...wrap if not found
#
# Inputs:
#        pattern                - via argument
#        CurrentLineNum        - global
#        lines                - global
#
# Return:
#        0                - not found
#        >0                - line where first found
#

sub edSearchBackward {
    my($pattern) = @_;

    $SearchPat = $pattern;
    my @idx = ($CurrentLineNum .. maxline(), 1 .. ($CurrentLineNum - 1));
    foreach my $line (reverse @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];
    }
    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 {
    die "Usage: ed [-p prompt] [-ds] [file]\n";
}

#
# 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] [-ds] [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 -d

Print debugging information on standard output.

=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 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 a single command letter of the following: 'd', 'l', 'n' and 'p'.
CMD can be omitted.

=item v/PATTERN/CMD

Repeatedly run command CMD for each line in the buffer not matching PATTERN.
CMD is a single command letter of the following: 'd', 'l', 'n' and 'p'.
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 =

Display current line number

=back

=head1 AUTHOR

Written by George M Jones

=cut