#!/usr/bin/perl
use warnings;
use strict;
use Getopt::Long qw(:config bundling gnu_getopt); # allows short options to be bundled
use File::Copy;
my $VERSION = 0.7;
$| = 1; # output buffering - doesn't wait for a newline or somesuch to print

# Predefine subs
sub VERSION_MESSAGE;	# version info
sub HELP_MESSAGE;	# help message
sub printlines;		# prints the relevant lines
sub getin;		# parses user input
sub getlines;		# gets the lines for editing
sub writefile;		# writes the file
sub getline;		# gets a line from the user
sub remstr;		# removes the current line

# bunch of global variables
my ($in, $out,		# filehandles
    @lines, @nums,	# the stored text
    $file, $infile,	# I/O location/destination
    $reg, $mods,	# the regex to match against
    $store, @file,	# if it's remembered, where it's remembered
    $backup, $suffix,	# do we backup, and if so, as what?
    $posix,		# can we (or possibly later, how do we) get unbuffered input?
    %vis, %uvar,	# variables for the user
    %hist);		# the user's previous commands

# Stuff to do with options. First declare default values.
$suffix = '~'; # the backup suffix. I'll make it more of a template later. Possibly.
$posix = ($^O eq "MSWin32" ? 0 : 1); # not POSIX if Windows, otherwise assume it is.
$mods = ''; # the regex modifiers.

# Now we can actually get their preferences
my %opts = (suffix => \$suffix, posix => \$posix);
GetOptions(\%opts, 'h|help', 'v|version', 'suffix:s', 'posix!');

# -v or -h should give info, then quit
VERSION_MESSAGE() if $opts{'v'};
HELP_MESSAGE() if $opts{'h'};
exit 0 if $opts{'v'} or $opts{'h'};

# If it's a POSX-compliant system, we need the POSIX module.
require POSIX if $posix; # importing :termios_h doesn't work for some reason (didn't when in BEGIN, anyway).

# Work out the file and the regex
($file, $reg) = @ARGV if $#ARGV; # If there's two arguments, that's them. More than two, only the first ones used
unless ($#ARGV) { # There was only a single argument. If it exists as a file, assume that was the intent.
	($file, $reg) = (-f $ARGV[0] ? ($ARGV[0], ".") : ("-", $ARGV[0]));
	print "NOTE: Only one argument given, ";
	print "treating as filename. All lines will match.\n" if -f $ARGV[0];
	print "treating as regex. Reading from standard input.\n" unless -f $ARGV[0];
} elsif ($#ARGV == -1) {
	($file, $reg) = ('-', '.'); # if there are no arguments, read from STDIN with "." as the regex
	print "NOTE: No arguments given. Reading from standard input, every line will match.\n";
}

# Configure stuff we haven't been told
$store = ($file eq '-' ? 1 : 0); # if the file is STDIN, make sure to remember what we're given
$backup = ($store || $suffix eq '') ? 0 : 1; # I really ought to put $backup and $store together. I think.
$infile = $file; # where we read from, instead of write to. Mainly for use with :saveas, but could be useful

# let the user see these config settings. It's about all of them, I think.
$vis{'tofile'}	= \$file; # a bunch of stuff for the user to see and/or modify with set.
$vis{'fromfile'} = \$infile; # 'vis' is short for 'visible', in case I forget and wonder why I used such a crappy name.
$vis{'regex'}	= \$reg;
$vis{'suffix'}	= \$suffix;
$vis{'backup'}	= \$backup;
$vis{'posix'}	= \$posix;

getlines(); #get the lines for editing
printlines(); # prints the lines that can be edited
getin() while 1; # executes the commands

# Here be subroutines.
# Arr.

sub getlines { # gets the lines for editing
	splice @lines;
	splice @nums;
	unless ($store == 2) { open $in, $infile or warn "Can't open $infile: $!\n"; } # Opens the handle
	my $i = 0;
	while ($_ = ($store == 2 ? $file[$i] : <$in>)) {
		if (/$reg/) {
			push @lines, $_; # Add each line that matches $reg to @lines
			push @nums, $.; # Add the position of each one of said lines to @nums
		}
		push @file, $_ if $store == 1;
		$i++;
	}
	$store = 2 if $store;
	not ($store == 2) ? close $in : 1; # closes the filehandle
}

sub printlines { #prints the relevant lines
	my $long = 0; # Length of longest line
	length $_ > $long ? $long = length $_ : 1 for @lines; # Sets $long to what it should be
	$long -= 1; # should be five higher than the actual value; the ruler makes it 6 (7?) higher
	my $rule = ' ' x 6; # Ruler to go across the top
	$rule .= "1   "; # It should be no loner than longest line, first digit of each number on the 5-char mark
	!($_ % 5) ? $rule .= $_.' 'x(5-length $_) : 1 for 5 .. $long; # Sets $rule properly
	print "$rule\n"; # Prints the ruler
	for (0 .. $#lines) { # Prints the lines stored, the ruler after every fifth
		print "\n$rule\n" unless $_ % 5 || !$_;
		print $_+1,":"," "x(5-length $_),$lines[$_];
	}
}

sub writefile { # prints the file to a particular filehandle
	my ($if, $of) = @_;
	my $i = 0; # array offset
	my $j = 1;
	my $next = $nums[$i];
	while ($_ = ($store ? $file[$j-1] : <$if>)) {
		if ($j == $next) {{
			print $of $lines[$i];
			$i++ if $#nums >= $i;
			$next = $nums[$i] || 0;
			redo if $next == $j;
		}} else {
			print $of $_;
		}
		$j++;
	}
}

sub save { # save the file
	my $suf;
	unless ($store) {
		$suf = $suffix || '.tmp';
		copy($infile, "$infile$suf") or warn "Can't make backup $infile$suf: $!\n";
		open $in, "$infile$suf" or warn "Can't read backup $infile$suf: $!\n"; # reads the backup
	}
	open $out, "> $file" or warn "Can't write to $file: $!\n"; # open the original for writing
	writefile($in, $out);
	unless ($store) {
		close $in;
		unlink "$infile$suf" unless $backup;
	}
	close $out;
}

sub getin { # Get and execute user input
	my $cmd = getline('^[a-zA-Z]|\n'); # Gets the key they pressed
	$_ = $cmd; # Easy access
	s/(?<!%)%\{(\w+)\}/${$vis{$1}}/g; # Replace %var with the user variable, unless preceeded by %
	s/(?<!%)%\[?(\w+)\]?/${$uvar{$1}}/g; # Replace %var, %[var], %[var or %var], unless preceeded by %
	s/(?>%%)/%/g; # replace double percentages with single. ?> is non-backtracking.
	
	# First, all the character-commands
	if (/^q/i) { # the q command quits.
		remstr($_) if $posix;
		print "q(uit)\n" if $posix;
		exit 0;
       	} elsif (/^p/i) { # the p command prints the relevant lines
		remstr($_) if $posix;
		print "p(rint)\n" if $posix;
		printlines();
	} elsif (/^h/i) { # the h command displays the help message
		remstr($_) if $posix;
		print "h(elp)\n" if $posix;
		HELP_MESSAGE();
	} elsif (/^s/i) { # the s command saves
		remstr($_) if $posix;
		print "s(ave)\n" if $posix;
		save();
	} elsif (/^c/i) { # the c command cats the file - manually, for portability's sake
		remstr($_) if $posix;
		print "c(atanate)\n" if $posix;
		open $in, $infile or warn "Can't read $infile: $!\n"; # reopen filehandle
		writefile($in, *STDOUT);
		close $in; # close it again

	# More interesting commands
	} elsif (/^`/) { # a backtick - execute shell command
		my $prompt = substr $_, 1;
		system $prompt;
	} elsif (/^=/) { # changing the regex
		$reg = substr $_, 1;
		getlines();
		printlines();
	} elsif (/^\+/) { # adding to the regex
		$reg .= "|" . substr $_, 1;
		getlines();
		printlines();
	} elsif (/^-/) { # removing from the regex
		my $noreg = substr $_, 1;
		for (my $i = 0; $i <= $#lines; $i++) {
			if ($lines[$i] =~ /$noreg/) {
				splice @lines, $i, 1;
				splice @nums, $i, 1;
				$i--;
			}
		}
		printlines();
	} elsif (/^[<>]/) { # adding a line somewhere
		my ($off, $string) = split / /, substr($_, 1), 2;
		$off-- if /^</;
		my $i = $off - (/^</ ? 0 : 1);
		splice @lines, $off, 0, "$string\n";
		splice @nums, $off, 0, $nums[$i];
		printlines();
	} elsif (/^:/) { # long command
		$_ = substr $_, 1;
		if (/^[sl]et/i) { # internal variable
			my @args = split /\s+|=/, $_, 3;
			shift @args;
			my $hash = (/^s/ ? \%vis : \%uvar); # the hash to use - either config options or user values
			if ($#args == 1) { # we're setting a variable
				${$hash->{$args[0]}} = $args[1];
				print "$args[0] = $args[1]\n";
			} else {
				foreach (sort keys %$hash) {
					my $match = (defined $args[0] ? $args[0] : '.');
					print "$_ = ${$hash->{$_}}\n" if /$match/;
				}
			}
		} elsif (/^cat/i) { # cat the file
			$store and do { print @file; return; };
			open $in, $infile;
			print <$in>;
			close $in;
		} elsif (/^sav(e(as)?)?/i) { # change the filename, then save
			$file = (split /\s+/, $_, 2)[1];
			save();
			$infile = $file;
		}

	# Editing. Perhaps it should be in its own subroutine. Feh.
	} elsif (/^\d/) {
		# Get the line numbers, first
		my ($line, $rest) = split /\s+/, $_, 2; # the line(s) to operate on and everything else
		$line =~ s/-/../g; # allow ranges using hyphens instead of double dots
		my @getnos = split /,/, $line; # split it into the various ranges
		my @linenos; # the numbers themselves
		foreach (@getnos) {
			my ($main, $step) = split(/\//, $_, 2);
			$step = $step || 1;
			foreach (eval $main) { # go through the range indicated by the main part of the wossname
				push @linenos, $_-1 unless $_ % $step; # if the step allows, let it be operable
			}
		}
		
		# Now make the changes. First the variables which will probably be used.
		my ($off, $len, $string);

		# A regex. Is there a better way to do it?
		if ($rest =~ /^\W/) {
			eval "\$lines[$_] =~ s$rest" for @linenos;

		# Insert/overwrite data
		} elsif ($rest =~ /^[oi\d]/i) {
			$rest = 'i' . $rest if $rest =~ /^\d/; # if it begins with a number, it's insertion
			($off, $string) = split /\s+/, (substr $rest, 1), 2; # offset to start at, string
			$len = ($rest !~ /^o/i) ? 0 : length $string; # characters to remove - none if i, as many as added if o
			substr $lines[$_], $off-1, $len, $string for @linenos; # inserts

		# Replace a portion with a string, or nothing.
		} elsif ($rest =~ /^r/i) { # replace x characters with string y, starting at offset z
			($off, $len, $string) = split /\s+/, (substr $rest, 1), 3; # offset, length, string
			$string = (defined $string ? $string : ''); # if it's not defined, it's blank.
			substr $lines[$_], $off-1, $len, $string for @linenos; # inserts
		}
		printlines(); # print the lines again
	}
}

sub remstr {
	my $length = length shift;
	print "\b" x $length; # send the cursor to the beginning of the text
	print " " x $length; # wipe out the text completely
	print "\b" x $length; # send the cursor back to the beginning to print from
}

sub getline {
# I don't actually understand most of this. getone() grabs the first key pressed, without needing a linebreak.
# Taken from the camel book, but modifications added such as Windows doing a regular <STDIN> since it isn't POSIX-
# compliant, and changing the structure.
	sub timekey; # gets the next key pressed within a second. I don't know a way of getting more accurate timings.
        my $string = "";
        unless ($posix) { # If it's not POSIX-compliant, just do a normal STDIN.
	        $string = <STDIN>;
	        chomp $string;
	        return $string;
        }

	# I have no idea what this does. Best not to fiddle.	
        my ($term, $oterm, $echo, $noecho, $fd_stdin);
        $fd_stdin = fileno (STDIN);
        $term     = POSIX::Termios->new();
        $term->getattr($fd_stdin);
        $oterm    = $term->getlflag();
        $echo     = &POSIX::ECHO | &POSIX::ECHOK | &POSIX::ICANON;
        $noecho   = $oterm & ~$echo;
        $term->setlflag($noecho);
        $term->setcc(&POSIX::VTIME, 1);
        $term->setattr($fd_stdin, &POSIX::TCSANOW);

	# Now THIS stuff I get.		
        my $regex = (shift @_ or "\n"); # if none specified, do what's effectively a <STDIN>
	my $pos = 0; # the character index the cursor is over
        while ($string !~ $regex) { # as long as the string doesn't match the regex...
	        sysread(STDIN, $_, 1); # get the next keypress into $_
		if (ord == 27) {{ # It's a control code. Currently one of up, down, left right. More to come.
			my $timeout = 0; # has the second elapsed?
			local $SIG{ALRM} = sub { $timeout = 1; sysread STDIN, $_, 1; }; # if it has, get a key anyway but let me know
			timekey(); # marks... set... GO!
			next if ($timeout || ord !~ /^91$/); # go to the end of the if (double braces) if it's useless or late
			if (ord == 91) { # cursor/insert/home/end/delete. More needed/wanted? If no, I can remove this check.
				local $SIG{ALRM} = sub { $timeout = 1; }; # now if it takes more than a second, just skip to the end
				timekey(); # get the next key
				next if ($timeout || $_ !~ /[A-D]/); # to the end unless it makes sense on time
				if ($_ eq 'A') { # Up. Use the last line beginning with the same character.
					my $hist;
					$hist = "glob" unless length $string;
					$string =~ /^([^a-z\s])/i and $hist = $1;
					$hist = $hist{$hist} || $string;
					$hist{'prev'} = $string unless $hist eq $string;
					remstr($string);
					chomp $hist;
					print $hist;
					$string = $hist;
					$pos = length $string;
				} elsif ($_ eq 'B') { # Down. After an up, restore the original string.
					if (exists $hist{'prev'}) {
						remstr($string);
						print $hist{'prev'};
						$string = $hist{'prev'};
						$pos = length $string;
					}
				} elsif ($_ eq 'C') { # Right. Move the cursor right or insert the above character.
					if ($pos < length $string) { # move right if there's a right to go to
						remstr($string);
						print $string;
						print "\b" x (length($string) - (++$pos));
					} elsif (exists $hist{'glob'} && length $hist{'glob'} > $pos) { # put in the last character
						my $last = substr $hist{'glob'}, $pos++, 1;
						$string .= $last;
						print $last;
					}
				} elsif ($_ eq 'D') { # Left. Move the cursor left.
					if ($pos) {
						print "\b";
						$pos--;
					}
				}
				$_ = '';
			}	
		}}
	        if (/\177|\010/) { # if it's backspace or delete (well, ^H)
			next unless $pos;
			remstr($string);
			substr $string, --$pos, 1, '';
			print $string;
			print "\b" x (length ($string) - $pos);
	        } elsif (ord >= 32) { # if it's printable
			remstr($string);
		        substr $string, $pos++, 0, $_; # and append it to the string
			print $string;
			print "\b" x (length ($string) - $pos);
	        } elsif (/\n/) { # if it's enter
			$string .= "\n";
		}
	}
        print "\n" if chomp $string;
	$string =~ /^([^a-z\s])/i and $hist{$1} = $string; # If it starts with a number or symbol, store in specific history
	$hist{'glob'} = $string; # Either way, store it in the global history as well

	# Nope, about to lose me again
        $term->setlflag($oterm);
        $term->setcc(&POSIX::VTIME, 0);
        $term->setattr($fd_stdin, &POSIX::TCSANOW);
        return $string; # don't worry, I do understand this.

	# Why do I nest these?
	sub timekey {
		alarm 1;
		sysread STDIN, $_, 1;
		alarm 0;
	}
}

sub VERSION_MESSAGE {
	print "LinEd, version $VERSION\n";
}

sub HELP_MESSAGE {
	VERSION_MESSAGE();
	print <<'END';
Syntax: lined [options] file regex
LinEd is an interactive line-based text editor, designed to correct simple
errors and make simple changes in files when a normal editor would be too
clunky.
To run it, you must pass the command-line arguments file and regex. File is
the name and path of the file you wish to edit, such as ~/foo.txt, and regex is
a Perl regular expression telling LinEd which lines you want to edit. Example:
  lined .bashrc PS1=
Will allow you to edit the line(s) in your .bashrc file which set the PS1
environment variable.
Options:
  -h, --help
           Display this help and exit
  -v, --version
           Display version info and exit
  --suffix=suf
           Sets the backup suffix to be <suf>. If <suf> is not given, no backup
             will be made; if this option is unset, it defaults to ~.
  --posix  POSIX module is supported, so use the enhanced UI. Default on
             non-Windows systems. Opposite of --no-posix.
  --noposix, --no-posix
           POSIX module is not supported, use the normal input method. Default
             for Windows. Opposite of --posix.
Commands:
  c(at)    Print the file to standard output. See also :cat
  h(elp)   Display this help
  p(rint)  Display the lines currently in the editing stack
  q(uit)   Quit
  s(ave)   Save
  
  `command Push <command> through the shell and display the output onscreen
  >line string
           Insert a new line after <line>, containing <string>.
  <line string
           Like >, but place the new line before <line>.
  :cat     Prints the file stored on disk to standard output. Compare the c
             command: that prints the file as it will be once saved, this does
             so as it was when last saved.
  :sav[e[as]] file
           Saves the file as <file>, and sets file to the one being edited.
  :set [var[=val]]
           Display/set configuration options. A plain :set will display every
             option, ":set var" will display every option with a name which
	     matches the pattern <var>, and ":set var=val" will give option
	     <var> the value <val>. Options can be interpolated into commands
	     with %{var} (to include a literal % character, prefix it with
	     another one. To include a % followed by a varible, you'll have to
	     give a variable the value %).
  :let [var[=val]]
           The same as :set, but used for user-defined variables rather than
             configuration options. They work the same in practice, but you
             should differentiate between them. Variables can be interpolated
	     into commands with %[var] or %var (%[var and %var] also work, but
	     this is a bug, not a feature).

Editing:
  A command which begins with a digit is used to modify one or more lines. The
  lines to modify can be given as a list of ranges, steps or regular numbers.
   - A range is two regular numbers separated by a hyphen (-) or a pair of
      dots (..) - it doesn't matter which. It will operate on all the line 
      numbers between them, inclusive.
   - A step is a range followed by a slash (/) and a third number. It will
      operate on only those numbers in the range which are divisible by the
      number after the slash.
   - A list is two or more regular numbers, ranges or steps separated by
      commas. It will operate on all the lines specified in any of the parts.
  "1,3-10,15-27/3", for instance, would operate on line 1, all the lines from 3
    to 10 inclusive, and 15, 18, 21, 24 and 27 - those numbers between 14 and
    27 which are divisible by 3. Whitespace cannot be used in the line number
    specification.
  
  linenos [i]offset string
           Insert <string> at offset <offset> on each of the given lines. The
             characters that were already there get shifted to the right.
  linenos o<offset>
           Insert  string at offset offset on each of the given lines, binning
             the characters that were there already.
  linenos r<offset> length string
           Remove <length> characters from offset <offset> on each of the
             given lines and replace them with <string>.
  linenos /search/replace/[modifiers]
           Replace all instances of <search> on the given lines with <replace>.

Refer to the documentation for more info.
END
}


__END__

Copyright (c) 2004 Philip Hazelden

Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated
documentation files (the "Software"), to deal in the Software without restriction, including without limitation the
rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to
permit persons to whom the Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all copies or substantial portions of
the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO
THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.