view release on metacpan or  search on metacpan

lib/IO/Pager/Perl.pm  view on Meta::CPAN

    eval "use Win32::Console::ANSI;";
    if( $@ ){
      warn "Could not load Win32::Console::ANSI, falling back to dumb mode - $@"; }
    else{
      $ENV{TERM} = 'WINANSI';
      #Windows lacks vb as does the fallback Term::Cap vt220 entry, add our own
      #https://www.ibiblio.org/oswg/oswg-nightly/oswg/en_US.ISO_8859-1/articles/alessandro-rubini/visual-bell/visual-bell-howto.html#VISIBLEBELL
      $ENV{TERMCAP} = do{ undef $/; $_=<DATA>; y/\n//d; $_ };
    }
  }
  else{
    #Try to enable mouse support
    print "\e[?1000;1006;1015h";
  }
  #Speed is mostly useless except Term::Cap demands it
  my $t = Term::Cap->Tgetent({ OSPEED => $param{speed} });
  my $dumb = eval{ $t->Trequire(qw/cm ce cl sf sr/) } ? 1 : 0;

  #CORE:  cm=>cup,  ce=>el,   cl=>clear, sf=>ind,  sr=>ri
  #EXTRA: md=>bold, me=>sgr0, mr=>rev,   us=>smul, vb=>flash
  my %primitives = (# if the entries don't exist, nothing bad will happen
		    BLD   => $t->Tputs('md'), # Bold
		    ULN   => $t->Tputs('us'), # Underscore
		    REV   => $t->Tputs('mr'), # Reverse
		    NOR   => $t->Tputs('me'), # Normal
		   );
  my $text;
  if( defined( $param{text} ) ){
    my $ref = ref( $param{text} );
    if( $ref eq 'ARRAY' ){
      die "Invalid text, must be string, code ref, or [string, code ref]"
	unless (scalar( @{$param{text}} ) ==2) and
	  ref( $param{text}->[0] ) eq '' and
	  ref( $param{text}->[1] ) eq 'CODE';

      $text = $param{text}->[0];
      $param{text} = $param{text}->[1]      
    }
    elsif( $ref eq '' ){
      $text = delete( $param{text} );
    }
  }

  $param{visualBell} = delete($param{visualBeep}) if
      defined($param{visualBeep}) and not defined($param{visualBell});

  my $me = bless {
		  # default values
		  _cursor => 0,		_end => 0,	   _left => 0,
		  _term  => $t,		_dumb => $dumb,    _txtN => 0,
		  _search => '',	_statCols => 0,    _lineNo=>[0],
		  lineNo => 0,		pause => '',	   #pause=>"\cL" #more
		  raw => 0,		statusCol => 0,	   squeeze=>0,
		  visualBell => 0,	fold => 0,         _fileN => 1,
		  _mark => {1=>0},      scrollBar => 0,
		  %dims,

		  # if the termcap entries don't exist, nothing bad will happen
		  %primitives,
		  #UI Composites
		  MENU    => $primitives{BLD}.$primitives{REV},	# popup menus
		  HILT    => $primitives{BLD}.$primitives{ULN},	# search entry
		  SRCH    => $primitives{BLD}.$primitives{ULN},	# search entry

		  # user supplied values override
		  %param,
		 }, $class;

  $me->add_text($text) if defined $text;

  $me->{_I18N}={
		prompt=>	'',
		404=>		'Not Found',
		top=>		'Top',
		bottom=>	'Bottom',
		minihelp=>	"<h>=help \000<space>=down <b>=back <q>=quit",
		continue=>	'press any key to continue',
		searchwrap=>    'No more matches, next search will wrap',
		nowrap=>        'Text::Wrap unavailable, disabling folding',
		help=>		<<EOH
 q           quit             \000 h       help
 r C-l       refresh          \000 R       flush buffers
 /           search           \000 ?       search backwards
 n P         next match       \000 p N     previous match
 space C-v   page down        \000 b M-v   page up
 enter down  line down        \000 y up    line up
 d           half page down   \000 u       half page up
 g <         goto top         \000 G >     goto bottom
   left      scroll left 1 tab\000   right scroll right 1 tab
 S-left      scroll left 1/2  \000 S-right scroll right 1/2
 m           mark position    \000 '       return to mark
 #           line numbering   \000 \\d+\\n   jump to line \\d+
:n           next file        \000 :p      previous file
 C           toogle raw       \000 S       toggle folding
EOH
	       };

  our %config;
  add_keys(\&help,      'h', 'H');
  add_keys(\&close,     'q', 'Q', ':q', ':Q');
  add_keys(\&refresh,   'r', "\cL", "\cR");
  add_keys(\&next_match,'n', 'P');
  add_keys(\&prev_match,'p', 'N');
  add_keys(\&to_bott,   '>', 'G', '$', "\e>", "\e[F", "\e0E", "\e0W", "\e[4~");
                                     #M->      ?     End     End     End
  add_keys(\&downpage,  ' ', 'z', "\cV", , 'f', "\cF", "\e ", "\e[6~"); #M-  PgDn
  add_keys(\&downpage,  "\eOs") if $ENV{TERM} eq 'WINANSI';
  add_keys(\&downhalf,  'd', "\cD");
  add_keys(\&downline,  'e', 'j', 'J', "\cE", "\cN", "\e[B"); #down
  add_keys(\&downline_raw, "\n", "\r");
  add_keys(\&upline,    'y', 'k', "\cY", "\cK", 'K', 'Y', "\cP", "\e[A"); #up
  add_keys(\&uphalf,    'u', "\cU");
  add_keys(\&uppage,    'w', 'b', "\cB", "\ev", "\e[5~"); #M-v PgUp
  add_keys(\&uppage,  "\eOy") if $ENV{TERM} eq 'WINANSI';
  add_keys(\&to_top,    '<', 'g',      "\e<", "\e[H", "\e0",          "\e[1~");
                                        #M-<    Home    Home            Home
  add_keys(\&next_file, ':n', "\e[1;4C");
  add_keys(\&prev_file, ':p', "\e[1;4D");
  add_keys(\&save_mark, 'm', "\e[2~"); #Ins
  add_keys(\&shift_left, "\e\[1;2D", "\e("); #S-left  S-M-9
  #Cannot have M-[ for left, \e[ conflicts with other codes