@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
In reply to mo (a pager for Win32) by osfameron
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |