NetNews Usenet Archive 1993 #3/NN_1993_3.iso/spool/comp/lang/perl/7952

Text File | 1993-01-23 | 9.5 KB | 392 lines

Newsgroups: comp.lang.perl
Path: sparky!uunet!mcsun!sunic!uts!id.dth.dk!ej
From: [e-mail] (Erik Johansen (none#None))
Subject: Re: editor scripts.
Message-ID: <[e-mail]>
Keywords: editor editing scripts perl subroutine text
Organization: Department of Computer Science
References: <[e-mail]>
Date: Fri, 22 Jan 1993 20:17:10 GMT
Lines: 380

[e-mail] (Chaim Manaster) writes:

>The following is a repost in the hope that more people will respond
>this time. I have had many inquiries asking for the results of my
>posting, so I know there is a good deal of interest in the matter.
>This is quite logical as it is a very common need. Please respond
>if you can. Here it is once again.
>________________________________________________________________

>Does anybody out there in netland have any perl scripts that do
>simple full-screen editing on either ascii or wordprocessor format
>files that they wouldn't mind sharing? They don't have to be
>anything fancy, just plain vanilla editors (in fact they could be
>line oriented although full-screen would be preferred).
>Preferably, they would be in the form of a subroutine, but if they
>are not, I imagine that it is a minor modification for me to make.
>(I am obviously no pro at this stuff yet).

Well, well, I made up a require file for the times when you need to
edit a small text (Actual: Array of texts).

The idea is to pass an array to an &Edit call allowing the user
to do the desired changes to the text before continuing.
As this was a quick written up procedure, I am sure that a better
version will be available at some time.

Not so much talk, here it is:

------snap snap---- edit.pl -----------snap snap--------
#
# Edit module.
#
# Example of calling:
#
#   require "edit.pl";
#
#   @user_text = split(/\n/, <<TEST);
#   This is a test
#   of the editor module.
#   TEST
#
#   &Edit( *user_text );
#
#   print "Your text now:\n", @user_text;
#
#
# Works on UNIX, some changes will be needed to run on PC
# The lines in @user_test should not contain "\n".
#

$version = "1.0";

sub Edit
 {
  local( *buf ) = @_;

  &Definitions unless defined %esctab;

  local($x_max, $y_max, $x, $y, $x_off, $editing) =  (80, 24, 0,0,0, 1);

  &Repaint;

  &stty_cbreak_noecho;
  while ( $editing )
   {
    $key = &GetKey;
    $key = $esctab{ $key } if defined $esctab{ $key };
    if ( length($key) == 1 &&  $key ge " " )
     {
      push(@buf, "") while ! defined $buf[$y];
      $buf[$y] .= " " x ($x - length($buf[$y])) if $x > length($buf[$y]);
      substr( $buf[$y], $x++, $overstrike ) = $key;
      print $key;
     }
    elsif ( length($key) > 1 && $key !~ /^\033/  )
     {
      eval $key;
      print $@ if $@;
     }
    else
     {
      print "\007"; # Ring bell
     }
   }
  &stty_nocbreak_echo;
  print $CLS;  # Clear screen (remove if you don't like this)
 }

sub ShowCursor
 {
  local( $repaint ) = 0;

  # Make full wraparound

  $y++, $x=0 if $x > length($buf[$y])+1;
  --$y, $x=length($buf[$y])+1 if $x < 0;
  $y = $#buf-$y   if $y < 0;  # If further up than first line we start at end
  $y = $y-$#buf-1 if $y > $#buf+1; # efter end we get back to start

  $y_off = $y, $repaint++ if $y < $y_off;
  $y_off = $y-$y_max+1, $repaint++ if $y > $y_off + $y_max;

  print $CSI, "23;70H ($y, $x)  "; # DEBUG -remove if you don't like this

  print $CSI, $y-$y_off+1, ";", $x+1, "H" unless $repaint; # Position cursor

  $repaint;  # Return true if repaint is needed
 }

sub Repaint
 {
  &ShowCursor; # First make sure that offset etc. are right
  print $CLS;
  local( $ry, $count ) = ($y_off, $y_max);
  print substr( $buf[$ry++], 0, $x_max ), "\n"
     while --$count && defined $buf[$ry];
  &ShowCursor;
 }


sub GetKeyPart
{
 local( $buf ) = "";
 read(STDIN, $buf, 1);
 $buf;
}

sub GetKey
 {
  local( $buf ) = &GetKeyPart;
  if ( $buf eq "\033" )
   {
    $buf .= &GetKeyPart;
    $buf = "\033[" if $buf eq "\233";
    if ( $buf eq "\033[" )
     {
      $buf .= &GetKeyPart;
      $buf .= &GetKeyPart  while $buf =~ /[0-9;,]$/;
     }
   }
  $buf;
 }

#-----------------------------------------------------------------------------
# Interactive Keyboard functions
#-----------------------------------------------------------------------------
sub Help
 {
  print $CLS; # Clear scroll region and screen

  local( %help, $txt );
  foreach $val ( values %esctab )
   {
    next unless $val =~ /\#\s*(.+)\s*\-\s*/;
    $help{ $1 } = $';
   }

  format HELP_TOP =
Edit Version @<<<<<<<<<<<<<<<<<<<<<<<                          By Erik Johansen
             $version
                         HELP INFORMATION                            Page @|||
                                                                          $%

     Function key            Description
------------------------+------------------------------------------------------
.

  format HELP =
     @<<<<<<<<<<<<<<<<     ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
     $key,                 $help{$key}
~~                         ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
                           $help{$key}
.
  $^ = HELP_TOP; # Set name of header format
  $~ = HELP; # Set name of format
  $= = $y_max - 2;    # Number of lines on page (minus trailer)
  $% = 0;
  $- = 0; # Page 0 line 0
  foreach $key ( sort keys %help )
   {
    write;
    next if $- > 1; # unless end of page
    print <<SEP;
------------------------+------------------------------------------------------
SEP
    print 'Press any key to continue:';
    &GetKey;
    print $CLS;
   }
  print <<SEP;
------------------------+------------------------------------------------------
SEP
  print "\n";
  &Repaint;
 }

sub Up
 {
  $y--;
  $x=length($buf[$y])+1 if $x>length($buf[$y])+1;
  &ShowCursor && &Repaint;
 }

sub Down
 {
  $y++;
  $x=length($buf[$y])+1 if $x>length($buf[$y])+1;
  &ShowCursor && &Repaint;
 }

sub Left
 {
  $x--;
  &ShowCursor && &Repaint;
 }

sub Right
 {
  $x++;
  &ShowCursor && &Repaint;
 }


sub Return
 {
  splice( @buf, $y, 1, substr($buf[$y],0,$x), substr($buf[$y],$x));
  $y++; $x=0;
  &Repaint;
 }

sub Key_Remove
 {
  $PasteBuffer = $buf[ $y ];
  undef $buf[ $y ];
  &Repaint;
 }

sub Insert_Here
 {
  if ( defined($PasteBuffer) )
   {
    $buf[ $y ] = ""  unless defined $buf[ $y ];
    substr( $buf[ $y ], $x, $overstrike ) = $PasteBuffer;
    $y += length($PasteBuffer);
    &Repaint;
   }
  else { print "\007"; } # Ring bell
 }


sub CtrlE
 {
  $x = (defined $buf[ $y ]) ? length($buf[ $y ]) : 0;
  &ShowCursor && &Repaint;
 }

sub Home
 {
  $x = 0;
  &ShowCursor && &Repaint;
 }

sub CtrlU   # Control-U - Erase to start of line
 {
  if ( $x > 0 && defined $buf[ $y ])
   {
    $PasteBuffer = substr( $buf[ $y ], 0, $x);
    substr( $buf[ $y ], 0, $x) = "";
    &Home;
    &Repaint;
   }
  else { print "\007"; } # Ring bell
 }

sub BackSpace
 {
  if ( $x > 0 && defined $buf[ $y ] )
   {
    substr( $buf[ $y ], --$x, 1 ) = "";
    &Repaint;
   }
  else { print "\007"; } # Ring bell
 }

sub PrevScreen
 {
  $y -= 12;
  &Repaint;
 }

sub NextScreen
 {
  $y += 12;
  &Repaint;
 }

sub DO
 {
  print "Add something here";
  &Repaint;
 }

sub Definitions
 {
#  $SIG{'INT'} = 'IGNORE';

  $CSI    = "\033[";
  $CLS    = "\033[2J" . "\033[1;1H";
  $Attr   = "\033[0;7m";
  $NoAttr = "\033[0m";

  #
  # table of keyboard functions
  #
  %esctab =
   (
    "\033[A",   '&Up;            # UP - Moves up',
    "\033[B",   '&Down;            # DOWN - Moves down',
    "\033[C",   '&Right;        # RIGHT - Moves right.',
    "\033[D",   '&Left;            # LEFT - Moves left.',
    "\033[1~",  '&FindFile;        # FIND - Find file ??',
    "\033[2~",  '&Insert_Here;        # INSERT HERE - Insert contents of paste buffer here.',
    "\033[3~",  '&Key_Remove;        # REMOVE - Cuts field to paste buffer.',
    "\033[4~",  '&Mark',        # SELECT - Mark position',
    "\033[5~",  '&PrevScreen;        # PREV SCREEN - 12 lines up',
    "\033[6~",  '&NextScreen;        # NEXT SCREEN - 12 lines down',
    "\033[17~", 'undef @buf;$editing=0;    # F6 - Quit.',
    "\033[21~", '$editing=0;        # F10 - Exit',
    "\033[24~", '&SaveTo;',        # F12 - Save file as.
    "\033[25~", '&Include;',        # F13 - Include file from.
    "\033[26~", '$overstrike = 1 - $overstrike;    # F14 - Shift between insert/overwrite',
    "\033[28~", '&Help;            # HELP - Gives this Help screen.',
    "\033[29~", '&DO;            # DO - Do something',
    "\001",     '&Home;            # Ctrl-A - Move to start of line.',
    "\003",     'print "Control-C\n";exit;    # Ctrl-C - Quit program (no questions).',
    "\004",     '$editing=0;        # Ctrl-D - Exit program.',
    "\005",     '&CtrlE;        # Ctrl-E - Move to end of line.',
    "\010",     '&Home;            # Ctrl-H - Move to start of line.',
    "\012",     '&Return;         # <CR> - End currrent line',
    "\014",     '&Repaint;',            # Ctrl-L - Repaints screen.',
    "\015",     ';            # <LF> - Ignore.',
    "\025",     '&CtrlU;        # Ctrl-U - Delete to start of line.',
    "\177",     '&BackSpace;        # BACKSPACE - Remove one character.',
  );
 }

sub stty_nocbreak_noecho
 {
  system "/bin/stty -cbreak -echo pass8 </dev/tty >/dev/tty";
 }

sub stty_cbreak_noecho
 {
  system "/bin/stty cbreak -echo pass8 </dev/tty >/dev/tty";
 }

sub stty_nocbreak_echo
 {
  system "/bin/stty -cbreak echo pass8 </dev/tty >/dev/tty";
 }

"End of require - do not remove";    # My way of returning true

------snap here-------------------end of edit.pl-------------------------------




  Hope this helps
  Erik Johansen

---
    $txt=" ltrterhnuc--sor eep-\nkJ.a "; srand(53747414);
    for (1..26) { print substr($txt,rand 27,1); }  ### Is this a random write ?
---
Erik Johansen / Institute for Computer Science / Danish Technical University
[e-mail]
--
Erik Johansen / Institute for Computer Science / Danish Technical University
[e-mail]