news.utdallas.edu!tamsun.tamu.edu!cs.utexas.edu!zaphod.mps.ohio-state.edu!saimiri.primate.wisc.edu!ames!haven.umd.edu!uunet!mcsun!sunic!uts!id.dth.dk!ej Tue Jan 26 23:52:53 CST 1993
Article: 578 of comp.lang.perl
Xref: feenix.metronet.com comp.lang.perl:578
Newsgroups: comp.lang.perl
Path: feenix.metronet.com!news.utdallas.edu!tamsun.tamu.edu!cs.utexas.edu!zaphod.mps.ohio-state.edu!saimiri.primate.wisc.edu!ames!haven.umd.edu!uunet!mcsun!sunic!uts!id.dth.dk!ej
From: ej@id.dth.dk (Erik Johansen (none#None))
#Subject: Re: editor scripts.
Message-ID: <ej.727733830@id.dth.dk>
Keywords: editor editing scripts perl subroutine text
Organization: Department of Computer Science
References: <1314@alsys1.aecom.yu.edu>
Date: Fri, 22 Jan 1993 20:17:10 GMT
Lines: 380
manaster@yu1.yu.edu (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
ej@id.dth.dk
--
Erik Johansen / Institute for Computer Science / Danish Technical University
ej@id.dth.dk