@rem = '--*-Perl-*--
@echo off
if "%OS%" == "Windows_NT" goto WinNT
perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
goto endofperl
:WinNT
perl -x -S "%0" %*
if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
if %errorlevel% == 9009 echo You do not have Perl in your PATH.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl
#line 15
use strict;
use Win32::Console;


our $VERSION = 0.12;

our $CONSOLE = new Win32::Console(STD_OUTPUT_HANDLE);
#$CONSOLE->Mode(ENABLE_PROCESSED_OUTPUT); #  
$CONSOLE->Display;

use vars qw(
    $FG_BLACK
    $FG_BLUE
    $FG_LIGHTBLUE
    $FG_RED
    $FG_LIGHTRED
    $FG_GREEN
    $FG_LIGHTGREEN
    $FG_MAGENTA
    $FG_LIGHTMAGENTA
    $FG_CYAN
    $FG_LIGHTCYAN
    $FG_BROWN
    $FG_YELLOW
    $FG_GRAY
    $FG_WHITE

    $BG_BLACK
    $BG_BLUE
    $BG_LIGHTBLUE
    $BG_RED
    $BG_LIGHTRED
    $BG_GREEN
    $BG_LIGHTGREEN
    $BG_MAGENTA
    $BG_LIGHTMAGENTA
    $BG_CYAN
    $BG_LIGHTCYAN
    $BG_BROWN
    $BG_YELLOW
    $BG_GRAY
    $BG_WHITE

    $ATTR_NORMAL
    $ATTR_INVERSE
);

our $highlight = chr($BG_LIGHTCYAN | $FG_BLACK);
our $prompt_attr = ($BG_LIGHTRED | $FG_WHITE);
our $info_attr = ($BG_WHITE | $FG_BLACK);
our $normal_attr = $CONSOLE->Attr();

our ($cols, $rows, $curr_col, $curr_row, 
	$write, $left_x, $top_y, 
	$right_x, $bottom_y, $y,
	$max_cols, $max_rows) 
	= $CONSOLE->Info();
our $pagesize = $bottom_y - $top_y;
our $length = $right_x - $left_x+1;

our $tab=" " x 4;
our $start = 0;
our 	($debug, 
	$command, @commands, $comm_line, 
	$re, $filter, $full, 
	$prompt, $file_d, $title);
our (@pretty_info, $p_count, $p_total);

if ($ARGV[0]=~/-i/) {
	shift @ARGV;
	system "echo. | $0 \"$ARGV[0]\"";
	exit;
}	

if ($ARGV[0]=~/(-c:(.*))/) { 
	$comm_line=$1;
	@commands=
		split/(?<!\\);/,$2;  	#split on un-escaped semicolons
	shift @ARGV; 
	info ("Expecting commands:  ". (join ", ", @commands));
}
if ($ARGV[0]=~/(-h|\/h|\/\?)/) { help(); exit}

while (@ARGV > 1) { 
	my $arg = shift @ARGV; 
	system "$0 $comm_line $arg"; 
};

if ($ARGV[0]=~/[*?]/) {
	my @files = glob($ARGV[0]);
	while (@files > 1) {
		my $arg = shift @files;
		system "$0 $comm_line $arg"; 
	};	
	if ($files[0]) { $ARGV[0]=$files[0] };
}
info ("Formatting $ARGV[0]: ...");	

our @pretty = get_pretty();

{
 my (undef, $rows, undef, undef, undef, $xleft, $ytop) = $CONSOLE->Info();
 (undef, $y) = $CONSOLE->Cursor();
 #correct if near the end of the buffer.
 if ($y+$pagesize > $rows) { 
	print "\n" x ($y+$pagesize-$rows+1);
	#$y = $rows-$pagesize-1;
	(undef, undef, undef, undef, undef, undef, $y) = $CONSOLE->Info;
 } else {
	 $CONSOLE->Window(1, 0, $y, $length-1,$y+$pagesize);
 }
}
our $numlines = scalar @pretty;
exit unless $numlines;
################################

open (IN, "< CONIN\$") or die;

our $pagesize = $bottom_y - $top_y;
our $length = $right_x - $left_x+1;


MAIN: {

	$start = $numlines-$pagesize if $start > $numlines;
	$start = 0 if $start < 0;
############
#	our $pagesize = $bottom_y - $top_y;
#	our $length = $right_x - $left_x+1;


############
	my(undef, undef, undef, undef, undef, 
		$xleft, $ytop) = $CONSOLE->Info();
	
	$CONSOLE->WriteRect("  p "x(($length+1) * ($pagesize+1)),0,$ytop,$length, $ytop+$pagesize );
	$CONSOLE->Cursor($xleft, $ytop);

	#TESTING using Cls each time (faster, and neater, but clobbers
	# everything in console!)
	#$CONSOLE->Cls($normal_attr);

 my $endtext = my $end = $start+$pagesize-1;
  if ($end >= $numlines) {$end = $numlines;$endtext="END"};

 #print @pretty[$start..$end];
  display ($start, $end);

 my $file = $ARGV;
 if ($file =~/^-?$/) { 
	$file_d="pipe"
   } else {
	$file_d=$file;
  }
 
COMMAND: {
 my $percent = int($pretty_info[$end]->[1]/$p_total*100);

	if ($full) {
	 print ;
	 $prompt = "($file_d) $start-$endtext\/$numlines [$pretty_info[$start]->[0]-$pretty_info[$end]->[0]\/$p_count] ($percent\% of ${p_total}B)";
	} else {
	 $prompt = "$start to $endtext of $numlines lines ($percent\% of $p_total bytes) -- ";
	 my $target = int($length * .85 - 6); 
	 my $filename=$file_d;
	 $filename=~s/.*[\\](.*)/$1/;
	 $filename=substr($filename, 0, $target-length($prompt));
	 $prompt = "--$title ($filename) $prompt";
	}
	my ($x, $y) = $CONSOLE->Cursor();
	my (undef, undef, undef, undef, undef, $xleft, $ytop) = $CONSOLE->Info();
	
	$CONSOLE->Attr($prompt_attr);
	$CONSOLE->Cursor(0, $pagesize+$ytop);
	$CONSOLE->Write($prompt);
	$CONSOLE->Attr($normal_attr); 

  if ($command = shift @commands) { 
	#print "\n";
	$start-- unless $start; 
	# This is to allow a search passed in command line to
	# find a string match on the first line...

  } else {
	  chomp ($command = <IN>);
	my (undef, undef, undef, undef, undef, 
		$xleft, $ytop,$xright,$ybott) = $CONSOLE->Info();
	if ($length != ($xright-$xleft+1)) {
		info ("Reformatting mo window");
		my $newline = $pretty_info[$start]->[0];
		$command=~s/^\s*(.*)\s*$/$1/;
		system "$0 -c:==$newline;\"$command\" $ARGV";
		exit;
	}
	if ($pagesize != ($ybott-$ytop)) {
		$pagesize = $ybott-$ytop;
		# do I need any other actions here? otherwise just assign!
	}

  }

 #################################
 # page down (RETURN)

 $command=~/^\s*$/ and do {
	 $start+=$pagesize;
	 last if $start >= $numlines;
	 redo MAIN;	
	};

 #################################
 # redraw r

 $command=~/^\s*r/ and do {
	 redo MAIN;	
	};


 #################################
 # single & multiple page navigation < and >

 $command=~/^\s*<\s*(\d*)/ and do {
	my $numpages = $1 || 1;
	$start-=($pagesize * $numpages);
	redo MAIN;
	};

 $command=~/^\s*>\s*(\d*)/ and do {
	my $numpages = $1 || 1;
	$start+=($pagesize * $numpages)+1;
	redo MAIN;
	};
 #################################
 # single and multiple line navigation + and -

 $command=~/^\s*-\s*(\d*)/ and do {
	my $num = $1 || 1;
	$start-=$num;
	redo MAIN;
	};
 $command=~/^\s*\+\s*(\d*)/ and do {
	my $num = $1 || 1;
	$start+=$num;
	redo MAIN;
	};
 #################################
 # goto line =, == (screen and logical)

 $command=~/^\s*=(=)?\s*(\d+)/ and do {
	my $num = $2;
	$start=$num;
	$start=$pretty_info[$start]->[2] if $1;
	redo MAIN;
	};

 #################################
 # Start and End of document  ^  $
 $command=~/^\s*\^/ and do {
	$start=0;
	redo MAIN;
	};

 $command=~/^\s*\$/ and do {
	$start=$numlines-$pagesize+1;
	redo MAIN
	};

 #################################
 # full listing
 $command=~/^\s*f\s*$/ and do {
	 $full ? ($full=0) : ($full = 1);
 	 redo COMMAND;
 };



 #################################
 # Quit Pager

 $command=~/^\s*(q|x|exit)/i and exit;

 #################################
 # Searches

 $command=~/^\s*\/\s*$/ and search_down($re,1,undef);
 $command=~/^\s*\/(.+?)(\/(i?))?\s*$/ and search_down($1,$2,$2);

sub search_down {
	my ($isre, $case_i);
	($re, $isre, $case_i) = @_;
	$re or do { print "No search string specified!\n"; redo COMMAND};
	$re = nice($re) unless $isre;
	$re="(?i)$re" if $case_i;
	my $count = $start;
	SEARCH_F: for (@pretty[($start+1)..$numlines]) { 
		$count++;
		if (/$re/) { 
			#print "found '$re' at $count!\n";
			$start = $count; 
			redo MAIN 
		};
	}
	info ( "'$re' not found");
	print "\n";
	redo COMMAND;
}
 $command=~/^\s*\?\s*$/ and search_up($re,1,undef);
 $command=~/^\s*\?(.+?)(\?(i?))?\s*$/ and search_up($1,$2,$2);

sub search_up {
	my ($isre, $case_i);
	($re, $isre, $case_i) = @_;
	$re or do { print "No search string specified!\n"; redo COMMAND};
	$re = nice($re) unless $isre;
	$re="(?i)$re" if $case_i;
	my $count = $start;
	my $count;
	SEARCH_B: for ($count=$start-1;$count>0;$count--) { 
		if ($pretty[$count]=~/$re/) { 
			#print "found '$re' at $count!\n";
			$start = $count; 
			redo MAIN 
		};
	}
	info("'$re' not found");
	print "\n";
	redo COMMAND;
}
 #################################
 # Set the filter  ~filter   ~filter~   ~filter~i   ~filter

 $command=~/^\s*~\s*$/ and do { $filter = ''; $re = ''; redo MAIN };

 $command=~/^\s*~(.+?)(~(i?))?\s*$/ and do {
	my ($isre, $case_i);
	($filter, $isre, $case_i) = ($1,$2,$3);
	$filter = nice($filter) unless $isre;
	$filter="(?i)$filter" if $case_i;
	redo MAIN;
 };

 #################################
 # Editor commands

 $command=~/^\s*(ed|edit|vi)$/i and do {
	my $ed = $1;
	my $editor;
	if (lc $ed eq "vi") {
		my $startpoint = ($pretty_info[$start]->[0])+1;
		$editor = "vi +$startpoint";
	} else {
		if (! $ENV{EDITOR}) { print "The EDITOR environment variable needs to be set\n"; redo COMMAND};
		$editor = $ENV{EDITOR};
	}
	if ($ARGV=~/^-?$/) {
		print "Creating a temporary file: this mo session will close and open in a new window.";
		my $temp = $ENV{TEMP} || $ENV{TMP} || ".";
		my $time=time;
		$file="$temp\\mofile$time.txt";
		open (TMP, ">$file") or die "Couldn't create temporary file: $!\n";
		print TMP join '', @pretty;
		close TMP or die "Problem closing temp file: $!\n";
		my $pid = fork; defined ($pid) or die "Couldn't fork!: $!\n";
		if (! $pid) {exec "start /I $0 -c:$ed $file";}
		# (This is because this gets rid of the IO setup
		# by the pipe to |mo.  Is there a better way of
		# doing this? - this opens up a separate window - I'd
		# rather have in the same one)
		# "cmd /c $0 -c:$ed $file" seems to work OK for non-console
		# apps, but hangs vi.
		exit unless $pid;
		waitpid ($pid, 0);
		exit;
	}
	# edit the file using the relevant system variable
	#print "$editor \"$file\"";
	system "$editor \"$file\"";
	
	# transfer to a new process of mo (because the file may have changed)
	my $pid = fork; defined ($pid) or die "Couldn't fork!: $!\n";
	if (! $pid) { exec "$0 -c:+$start \"$file\""; exit
	} else {
		wait;
		exit;
	}
  };


 #################################
 # Shell command
 $command=~/^\s*!(.*)$/ and do {
		system $1;
		info ("Shell command '$1' returned");
		redo COMMAND;
 };

 #################################
 # Perl command
 $command=~/^\s*\*(.*)$/ and do {
		my $result = (eval $1);
		$@ and info( "Error: $result");
		info ("Perl command '$1' returned");
		redo COMMAND;
 };

 #################################
 # perldoc

 $command=~/\s*perldoc\s+(.*)/ and do {
		(my $name=$1)=~tr/ /_/;
		my $command = "perldoc $1 |mo -c:*\$title='$name';\"^\"";
		system $command;	
		redo COMMAND;
 };

 #################################
 # mo some mo files...

 $command=~/\s*mo\s+(.*)/ and do {
		system $command;	
		redo COMMAND;
 };


 #################################
 # Help
 if ($command=~/^\s*(help|panic)/) {
	help ();
	redo COMMAND;
 };


 #################################
 # Not a command: print Usage info.
 info( "Not a recognized command: try 'help' for more info");
redo COMMAND;
}
}


exit;

#################################

sub display {
	my ($start, $end)=@_;
	my $filter=$filter || $re;
	if ($filter) {
		for (@pretty[$start..$end]) {
			my ($x, $y) = $CONSOLE->Cursor();
			print $_;
			my $loc=0;
			while (/(.*?)($filter)/g) {
				$loc+=length($1);
				my $attrs = $highlight x length($2);
				$CONSOLE->WriteAttr($attrs, $loc, $y);
				$loc+=length($2);
			}
		}
	} else {
		print @pretty[$start..$end];
	}
}

#################################

sub nice {
	# make a string into a literal search string

	my $string = shift;
	$string=~s#\.#\\\.#g;
	$string=~s#\*#\\\*#g;
	$string=~s#\(#\\\(#g;
	$string=~s#\)#\\\)#g;
	$string=~s#\[#\\\[#g;
	$string=~s#\]#\\\]#g;
	$string=~s#\}#\\\}#g;
	$string=~s#\{#\\\{#g;
	$string=~s#\?#\\\?#g;
	$string=~s#\$#\\\$#g;
	$string=~s#\^#\\\^#g;
	$string=~s#\|#\\\|#g;

	return $string;
}
#################################
sub get_pretty {
	local @pretty;
	$p_total=0;
	$p_count=0;
	$pretty_info[0]=[1];
	my $old_file= "";
	while (<>) {
		my $file = $ARGV;
		if ($old_file ne $file){};
		my $line = $_;
		$line=~s/\t/$tab/g;
		pretty($line);
	}
	return @pretty;
}

sub pretty {
	my $line = shift;
	debug ("PR:$line");
	if (length ($line) < $length) { 
		chomp($line);
		push @pretty, "$line\n"; 
		$p_total+=length($line)+1;
		$pretty_info[scalar @pretty]=[++$p_count, $p_total];
		$pretty_info[$p_count]->[2]=scalar @pretty;

		return 
	}
	my $trunc = substr($line,0,$length-1,"");
	debug ( "TR:$trunc/$line\n");
	if ($trunc=~/^(.*)([[:punct:]\s])(.*)$/) {
		push @pretty, "$1$2\n";
		$p_total+=length("$1$2");
		$pretty_info[scalar @pretty]=[$p_count, $p_total];
		debug ( "[1:$1][2:$2][3:$3]");
		$line="$3$line";
		debug ("?$line");
		pretty ($line);
	} else {
		push @pretty, "$trunc\n";
		$p_total.=length($trunc);
		$pretty_info[scalar @pretty]=[$p_count, $p_total];
		debug ("!$line");
		pretty ($line);
	}
}	

sub debug {
	my $what = shift;
	print $what if $debug;
}

sub info {
	my $what = shift;
	$CONSOLE->Attr($info_attr);
	print $what;		
	$CONSOLE->Attr($normal_attr);
	print "\n";
}
###############################################
sub help {
my $usage=<<EOF;
###########################
'mo' by hakim\@earthling.net
version $VERSION

DESCRIPTION
===========
A replacement for the standard Win32 'more' filter. It is more fully featured, having stolen from Unix versions various features like highlighting, 2-way navigation and searches.
It doesn't do stepping backwards through the file list, or searching through more than one file.  Yet, anyway.

USAGE
=====
	1) mo [-c:command1;command2;..] file1 file2 ..
	2) command | mo
	3) mo -i

1. pages the contents of the specified files
2. pages the contents of the command's output piped to mo
3. opens mo in 'interactive' mode (e.g. opens a blank temporary file)

COMMANDS
========
These can be used on the command line (with the -c switch), or interactively within mo.

	RETURN          next page
	q, x, exit      exit the pager
	help            display this help message
	f               toggle prompt details

	> [num]         forward (num) pages
	< [num]         up      (num) pages
	+ [num]         forward (num) lines
	- [num]         up      (num) lines
	= num           goto (screen) line num
	== num          goto (file) line num
	^, \$            To the start or end of the document

	/string         search for literal string
	/regex/[i]      search for regular expression 
	                (use 'i' for case insensitive)
	/               search for last searched expression
	?string         }
	?regex?[i]      } as / but searches backwards
	?               }
	~filter[~[i]]   filter the text for a string or expression,
	                highlighting where found.  Options as / and ?
	~               clears filter and current search pattern

	ed, edit, vi    edit the file ('vi' edits at current line)
	!command        Runs a shell command
	*command        Runs a Perl command
	perldoc doc	Opens the document in perldoc
	mo file1...	Opens some new files within mo

EXAMPLES and NOTES
==================

1)	The filename can now be specified as a glob. e.g.:
	mo *.txt
If more than one file is mo'd, exiting will only exit the current file.
E.g.: the other files will still be mo'd in turn.  CTRL-C should terminate the entire session).
The form:
	mo "command |"
can also be used (e.g. similar to 'command | mo')

2)	The text editor used by the edit command must be set in the 'EDITOR' variable. e.g.:
	set EDITOR=notepad	(from the Command Shell)
The 'vi' command is hard-coded to 'vi' at the moment however.  (A version of vi is available in the NT resource kit for example)

3)	mo -c:+3;/rem file1.txt

file1.txt is opened.  Skip 3 lines, then find the first occurrence of 'rem'.

4)	mo -c:~Win32~i;/Console console.pod 

Opens console.pod, filters for Win32 (case insensitive), and searches for Console

5)	To use semicolons in a command, escape them by preceding them with a backslash.

e.g.	mo -c:~print\;;+3 file1.txt

6)	To use mo as the default pager for perldoc, try either:
	set PAGER=mo
	set PERL_PAGER=mo
from the DOS Shell command line

7)	For more information about Regular Expressions, try 
	!perldoc perlre       - from the mo command line, or 
	perldoc perlre        - as above, but opening the document within mo
	perldoc perlre        - from the DOS Shell window.

8)	If the filter is not set, then the last searched expression will be filtered instead.

9)	'f' toggles between:
	1) file name and screen line details only. 
	2) full path, screen and logical file position.

10)	Is 'mo -i' useful?  It seemed like a good idea at the time.

HISTORY
=======
v 0.1
	- Fixed some bugs and created some others...
	- Tested the behaviour of mo at the beginning or the end of a console buffer.
v 0.12
	- Auto-reformat when mo realises window has resized. (The prompt bar doesn't change yet though: could cause odditied on 'thin' console screens)

BUGS
====
- The IO is quite primitive: every command has to end in newline: I may change this later on.
Also, if the command is a piped command, the 'edit' function would not return the IO to the editor window (e.g. the editor would hang).  At the moment, this is worked around by creating a new window to use this functionality.

- The pretty printer used is also unsophisticated, and doesn't handle punctuation in the most elegant of ways... It would be nice to ship this out to a user-customizable external filter.

- The output of piped command (command | mo) can be edited, but the form 'mo "command |" cannot.

- The pages are printed on the same area of console.  (This area is cleared before each successive page, and is quite a nice tidy way of doing things).
There is currently no support to do either a) cls of whole console for each page, or b) scroll pages one after each other instead, though this would be very trivial (earlier versions of mo worked this way).
The final prompt bar is not tidied away at the end of the session.

- Sometimes the highlighting appears misplaced by one line: I need to test to discover which case this is in.

- I've not yet done error trapping on the Regex searches...

AUTHOR & LICENSE
================
By hakim\@earthling.net (Feb 2001)
Distributed with the same conditions as Perl itself.

Please contact me to inform about bugs, changes you would like (or have made!), or other suggestions and comments.

EOF
my $temp = $ENV{TEMP} || $ENV{TMP} || ".";

open (MOTXT, ">$temp\\mo.help") or do {
	info ( "Sorry: Nicely formatted help is not available - there may be a problem with your Temporary directory ($temp): $!\n");
	info ( "Press <RETURN> to see the help string anyway:");
	local *IN;
	open (IN, "< CONIN\$");
	my $dummy = <IN>;
	print $usage;
	return;
};		
print MOTXT $usage;
close MOTXT or do {
	info ( "Sorry: Nicely formatted help is not available - there may be a problem with your Temporary directory ($temp): $!\n");
	info ("Press <RETURN> to see the help string anyway:");
	local *IN;
	open (IN, "< CONIN\$");
	my $dummy = <IN>;
	print $usage;
	return;
};		
# e.g. Use mo itself to print the help information:
# this means it will be nicely wrapped if screen size
# etc. is different.
system "$0 -c:~\\bmo\\b $temp\\mo.help" ;
}

__END__
:endofperl