@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->Inf
+o();
 (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[$st
+art]->[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 n
+eeds to be set\n"; redo COMMAND};
        $editor = $ENV{EDITOR};
    }
    if ($ARGV=~/^-?$/) {
        print "Creating a temporary file: this mo session will close a
+nd 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 chang
+ed)
    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 f
+eatured, having stolen from Unix versions various features like highl
+ighting, 2-way navigation and searches.
It doesn't do stepping backwards through the file list, or searching t
+hrough 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 interac
+tively 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 termi
+nate 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 'EDI
+TOR' variable. e.g.:
    set EDITOR=notepad    (from the Command Shell)
The 'vi' command is hard-coded to 'vi' at the moment however.  (A vers
+ion 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 wi
+th 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 cons
+ole buffer.
v 0.12
    - Auto-reformat when mo realises window has resized. (The prompt b
+ar 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 ma
+y 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 th
+is 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 t
+his out to a user-customizable external filter.

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

- The pages are printed on the same area of console.  (This area is cl
+eared before each successive page, and is quite a nice tidy way of do
+ing 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 t
+his 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 hav
+e 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