#!/usr/bin/perl

my($loadkeys,$loadkeyspath,$userpath,$keysparms,
$parms,$parmstemp,$pgroup,$version,$press,$case_val,$mp,$sql);
#require("common.sub");
#declarations for $0.pl
$keymap= $mapfile ="";#default keymap names
$userpath = "";#the default user path for files
$loadkeyspath = "";#the default loadkeys path
$loadkeys = "loadkeys";#the name of the loadkeys client
#You should leave this file as it is for a template for keyspk.pl
#This program is covered under the gpl.
$restore = $help = $speakup = 0;

@keyval=( #characters are followed by their shifted character
'','','1!','2@','3#','4$','5%','6^','7&','8*','9(','0)','-_','=+','',
'','qQ','wW','eE','rR','tT','yY','uU','iI','oO','pP','[{',']}','',
"","aA","sS","dD","fF","gG","hH","jJ","kK","lL",";:","'\"","",
'`~','','\|','zZ','xX','cC','vV','bB','nN','mM',',<','.>','/?','','','','  ');

@val=("00","01","02","03","04","05","06","07","08","09");

@func=("F1","F2","F3","F4","F5","F6","F7","F8","F9");

#a long scalar
$default_speakup= "keycode  71 = 0x0d0b
	shift keycode 71 = seven
		altgr	keycode 71 = 0x0d0f
#keycode  71 = KP_7            
	alt     keycode  71 = Ascii_7         
keycode  72 = 0x0d0a
	shift keycode 72 = eight
	altgr keycode 72 = 0x0d20
#keycode  72 = KP_8            
	alt     keycode  72 = Ascii_8         
keycode  73 = 0x0d0c
	shift keycode 73 = nine
		altgr	keycode 73 = 0x0d0d
#keycode  73 = KP_9            
	alt     keycode  73 = Ascii_9         
keycode  74 = 0x0d1e
	shift keycode 74 = minus
	altgr keycode 74 = 0x0d24
keycode  75 = 0x0d08
	shift keycode 75 = four
	altgr keycode 75 = 0x0d22
#keycode  75 = KP_4            
	alt     keycode  75 = Ascii_4         
keycode  76 = 0x0d07
	shift keycode 76 = five
#keycode  76 = KP_5            
	altgr	keycode  76 = 0x0d12
#	alt     keycode  76 = Ascii_5         
keycode  77 = 0x0d09
	shift keycode 77 = six
	altgr keycode 77 = 0x0d23
#keycode  77 = KP_6            
	alt     keycode  77 = Ascii_6         
#keycode  78 = KP_Add          
keycode  78 = 0x0d14
	shift keycode 78 = plus
	altgr keycode 78 = 0x0d21
keycode  79 = 0x0d05	
	shift keycode 79 = one
#keycode  79 = KP_1            
	altgr	keycode 79 = 0x0d10
	alt     keycode  79 = Ascii_1         
keycode  80 = 0x0d04
	shift keycode 80 = two
#keycode  80 = KP_2            
	altgr	keycode  80 = 0x0d11
	alt     keycode  80 = Ascii_2         
keycode  81 = 0x0d06		
	shift keycode 81 = three
	altgr 	keycode 81 = 0x0d0e
#keycode  81 = KP_3            
	alt     keycode  81 = Ascii_3         
#keycode  82 = 0x0d14
keycode  82 = AltGr
	shift keycode 82 = zero
#keycode  82 = KP_0            
	alt     keycode  82 = Ascii_0         
#keycode  83 = KP_Period       
keycode  83 = 0x0d1b
	shift keycode 83 = period
	altgr	keycode 83 = 0x0d1d
	altgr   control keycode  83 = Boot            
	control alt     keycode  83 = Boot            
keycode  84 = Last_Console    
keycode  85 =
keycode  86 = less             greater          bar             
	alt     keycode  86 = Meta_less       
keycode  87 = F11              F11              Console_23      
	control keycode  87 = F11             
	alt     keycode  87 = Console_11      
	control	alt     keycode  87 = Console_11      
keycode  88 = F12              F12              Console_24      
	control keycode  88 = F12             
	alt     keycode  88 = Console_12      
	control	alt     keycode  88 = Console_12      
keycode  89 =
keycode  90 =
keycode  91 =
keycode  92 =
keycode  93 =
keycode  94 =
keycode  95 =
keycode  96 = 0x0d03
	altgr	keycode 96 = 0x0d1c
#keycode  96 = KP_Enter        
	shift keycode 96 = Return
";#ennd of default_sppeakup

#these are the valid keys for speakup key changes in lower case 
@kv=('k1','k2','k3','k4','k5','k6','k7','k8','k9','k.','kr','ke','kd','kn',
'kl','kt','kh','ku','kp','i1','i2','i3','i4','i5','i6','i7','i8','i9','i.',
'ir','ie','id','in','il','it','ih','iu','ip','km','im','k-','i-','k+',
'i+','');

#these are the characters for each value
@k_kpd=(
"71khk7ihi7KHIHK7I7","72kuiuk8i8KUIUK8I8","73kpipk9i9KPIPK9I9","74kmimk-i-KMIMK-I-",
"75klk4ili4KLILK4I4","76k5i5K5I5","77ktitk6i6KTITK6I6","78ksisk+i+KSISK+I+",
"79kek1iei1KEIEK1I1","80kdidk2i2KDIDK2I2","81knink3i3KNINK3I3","","83k.i.K.I.",
"","","","","","","","","","","","","96krirKRIR","");

#keypad descriptions
@spk_key=("KeyPad-k8		Say current Line",
"InsKeyPad-i8		say from top of screen to reading cursor.",
"KeyPad-k7		Say Previous Line (UP one line)",
"KeyPad-k9		Say Next Line (down one line)",
"KeyPad-k5		Say Current Word",
"InsKeyPad-i5		Spell Current Word",
"KeyPad-k4		Say Previous Word (left one word)",
"InsKeyPad-i4		say from left edge of line to reading cursor.",
"KeyPad-k6		Say Next Word (right one word)",
"InsKeyPad-i6		Say from reading cursor to right edge of line.",
"KeyPad-k2		Say Current Letter",
"InsKeyPad-i2		say current letter phonetically",
"KeyPad-k1		Say Previous Character (left one letter)",
"KeyPad-k3		Say Next Character (right one letter)",
"KeyPad-plus ks		Say Entire Screen",
"InsKeyPad-plus is		Say from reading cursor to bottom of screen.",
"KeyPad-Minus km		Park reading cursor (toggle))",
"InsKeyPad-minus km		Say character hex and decimal value.",
"KeyPad-period k.		Say Position (current line, position and console)",
"InsKeyPad-period i.	say colour attributes of current position.",
"InsKeyPad-i9		Move reading cursor to top of screen (insert pgup)",
"InsKeyPad-i3		Move reading cursor to bottom of screen (insert pgdn)",
"InsKeyPad-i7		Move reading cursor to left edge of screen (insert home)",
"InsKeyPad-i1		Move reading cursor to right edge of screen (insert end)",
"KeyPad-Enter kr		Shut Up (until keyhit) and sync reading cursor",
"InsKeyPad-Enter ir	Shut Up (until toggled back on) and sync cursors",
"InsKeyPad-star n<x|y> go to line (y) or column (x). Where 'n' is any\n		allowed value for the row or column for your current screen.\n This keystroke will not be changed by this program. The other $#spk_key values may be changed.");

#loookup hex definitions
@hexdef=("96 k FULL_QUIET 0x0d03 process commands in buffer and shut up", 
"80 k _CHAR 0x0d04 this character", 
"79 k _PREV_CHAR 0x0d05 character left of this char", 
"81 k _NEXT_CHAR 0x0d06 char right of this char", 
"76 k _WORD 0x0d07 this word under reading cursor", 
"75 k _PREV_WORD 0x0d08","77 k _NEXT_WORD 0x0d09",
"72 k _LINE 0x0d0a this line", 
"71 k _PREV_LINE 0x0d0b line above this line", 
"73 k _NEXT_LINE 0x0d0c",
"73 i TOP_EDGE 0x0d0d move to top edge of screen", 
"81 i BOTTOM 0x0d0e","75 i LEFT 0x0d0f","77 i RIGHT 0x0d10",
"80 i _PHONETIC_CHAR 0x0d11 this character phonetically", 
"76 i SPELL_WORD 0x0d12 spell this word by letter", "78 k _SCREEN 0x0d14",
"83 k _POSITION 0x0d1b","96 i SPEECH_OFF 0x0d1c","83 i _ATTRIBUTES 0x0d1d",
"74 k SPEAKUP_PARKED 0x0d1e","72 i _FROM_TOP 0x0d20","78 i _TO_BOTTOM 0x0d21",
"75 i _FROM_LEFT 0x0d22","77 i _TO_RIGHT 0x0d23","74 i _CHAR_NUM 0x0d24");

$press = "\npress enter to continue:\n";
$altgr="altgr keycode";
$parms=$parmstemp="-v";
$version="keyspk Version 0.1.0.";


sub pd{#save to the capture array and send to loadkeys
if ($sql ne ""){
$capture[$c_ct]=$sql;
$c_ct++;
open_loadkeys();
print KH ("$sql\n");
close(KH);}#end of if
}#end of pd

sub menu_list{#the menu after pressing m
print <<EOF;
			$0 Menu

   ?  help                              3  send a file to loadkeys
   )    check a file                    (  change user path for files
   a  add a macro to $keymap           b  save the capture file to disk
   c  change speakup keys              d  delete speakup key copied to keyboard
   k  environment variables            l  new keymap file for loadkeyss
   m  this menu                        n  view the capture array
   o  execute a capture line           p  toggle case conversion
      q  quit the program              r  restore speakup defaults
   s  speakup default key assignments  t  transfer a speakup command to keyboard
   u  change loadkeys parameters       v  view macros and transfered keys
   w  write and send file to loadkeys  x  remove a stringmacro
   y  toggle loadkeys parameters
EOF
}#end of menu_list

sub key_help{#help for the program
print <<EOF;
--help | -h this message:
--speakup | -s default speakup key description
--restore | -r restore speakup default key map
requires --mapfile="keymap"
--mapfile="speakupmap" load this map file

The default loadkeys name is $loadkeys The process number is $pgroup
use the ) command to check the statistics of a file.  The log file logs the output from loadkeys. Turn this feature on by
pressing - at the menu prompt if the command may cause problems.
The program will not exit if there is a file error or
if a file cannot be opened. Be sure that you have read / write privileges in the
logged directory when asked. Enjoy your macross!Characters are converted
to UPPER CASE. Use p or P to toggle the case setting at the prompts.
settings: Off, convert to upper case, convert to lower case. Enter ends a   
request. Character conversion is disabled for file names but it is activated
when the file name or path is completed.
The case of `MENU' at the menu prompt shows the status of case conversion. The
input line appears again in its converted form if case conversion is active.
The menu prompt shows a `>' when case conversion is disabled.
EOF
quit() if $help;
ret();}#end of key_help

sub admin{#set the parameters for $0.pl
my($ct,$tmp);
$in_f = $0;
open_in_f($in_f);
$keymap=keymapname() if ($keymap eq "") && ($mapfile eq "");
print "checking for $loadkeys:\n";
foreach $loadkeys(keys(%ENV)){
if ($loadkeys eq 'PATH'){
$field = $ENV{$loadkeys};
 printf("%-4.4s: $ENV{$loadkeys}\n", $loadkeys);}
}#end of foreach
@array = split(/:/, $field);
for ($ct = 0; $ct <= $#array; $ct++){
$loadkeyspath = "$array[$ct]/";
chdir($loadkeyspath);
print "$loadkeyspath\n";
$loadkeyspath = "" if !-x $loadkeys;
last if -x $loadkeys;}
if(!-x $loadkeys){
for (;;){
print "Please enter the path for $loadkeys including the trailing slash?\n";
$loadkeyspath=&query();
last if -d $loadkeyspath;}#end of for
}#end of if
print "$loadkeys exists in your path:\n" if -x $loadkeys;
$userpath=set_path();
$row[7] =~s/\"\"/\"$userpath\"/;
$row[8] =~s/\"\"/\"$loadkeyspath\"/;
$out_f="$0.pl";
check_exist($out_f);
for ($ct = 0; $ct <= $#row; $ct++){
print OUTFILE "$row[$ct]\n";}#end of for
close($OUTFILE);
$sql=chmod(0755, $out_f);
print "The file $userpath$out_f is executable.\n" if -x $out_f;
print <<EOF;
The new working directory is:
$userpath

type M or m for the keylist at the menu prompt, or quit or Quit to exit $0.
This program will contimue running with your new settings. Please use the
new file $out_f as your regular file.

http://www.hurontel.on.ca/~barryp/index.html
barryp\@hurontel.on.ca
gliddle\@hurontel.on.ca

Do you wish to display some help before you begin for the first time?(Y, N)
EOF
return if !&query();
if (uc($_) eq 'Y'){
&key_help;}
`pwd`;
$sql = "";}#end of admin

sub query{#the input line
$_ = <STDIN>;
chomp($_);
if ($_ eq 'p' || $_ eq 'P'){
&case;
return if !query();}
if (length($_)){
if ($case_val==1){
tr/a-z/A-Z/;}
if ($case_val==2){ 
tr/A-Z/a-z/;}
}#end of if
print "$_\n" if $case_val;
if (uc($_) eq 'QUIT'){
quit();}
$_;}#end of query

sub quit{#  quit 
die "Thank you for using $0\n";}#end of quit

sub parameters{#parameters for loadkeys
print "Enter the new parameters for loadkeys or leave the field blank: `$parms'\n";
$answer=&ans();
$parmstemp=$parms =$answer;
$keysparms=0;
loadkeysparms();
return($keysparms,$parms,$parmstemp);}#end of parameters

sub addkey{#create a key macro
my ($ct,$tmp,$fc,$hc,$i,$str);
for (;;){#make some macros before writing the file
for (;;){#search arrays for macro use
print "Enter a printable character to used\n with the insert key\nfor your macro.";
$sql="";
check();#get a key
next if $macro eq "";
for ($i=0, $hc=0; $i<=$#row; $i++){
for ($no=0, $tmp=$hc;$tmp<=$#hex; $tmp++){
if ($row[$i]=~/# keyspk ins-$macro /){ #this key is in the file
print "this key exists:\n";
$newkey=$no=0;
$macro="";
last;}
print "$row[$i]\n" if /# keyspk/;
if ($row[$i]=~/$hex[$hc]/){
$hc++;
$no=1;
print "Found $row[$i]\n" if$no ==1;
last;}
next if $no==1;
last if $no==0;}
last if $macro eq "";}
next if $macro eq "";
last if $newkey>0;}#end of for
print "Using $macro $newkey $hex[$hc]\n";
$comment = "\n# keyspk ins-$macro $newkey $hex[$hc]";
print "Type your macro 256 characters maximum:\n";
for(;;){
$ct=length($sql);
print "$ct characters:  Type a string and end the entry with a blank line.\n";
last if !query();
$tmp=length($_);
last if $tmp+$ct > 256;
$sql .= "$_\\n" if length($_)>0;}#end of for
chomp $sql;
$sql="$altgr $newkey = $hex[$hc]\nstring $hex[$hc] = \"$sql\"";
$sql="$comment\n$sql";
$row[$#row] .=$sql;
pd();
print "Would you like to create another macro? (Y, N)\n";
query();
next if uc($_) eq 'Y';
last;}#end of for
@row;}#end of addkey

sub key_descript{# speakup key list fort and d
print <<EOF;
The following letters represent:
    r return  l leftarrow t rightarrow  h home  e end 
u up arrow d down arrow  p pageup n pagedown s plus  m minus  . period
- minus + plus
each letter must follow i or k. Keys may be represented by their numeric
value. k7 i6 or kh it
both keys must be in either upper or lower case.
Enter a 2 character string to represent the key you wish to change:
EOF
}#end of key_descript

sub change_key{#move a key for speakup
for(;;){#ask for a key 
$start=0;
setkey();
print"$row[$rc]\n";
print " $row[$old_rc]\n";
$row[$rc]=~s/$hex_key/$old_hex_key/g;
$row[$old_rc]=~s/$old_hex_key/$hex_key/g;
print "changed to:\n";
print "$row[$rc]\n";
print"$row[$old_rc]\n";
$sql="$row[$old_rc]";
pd();
$sql="$row[$rc]";
pd();
print "$row[$rc]\n$row[$old_rc]\n";
print "Would you like to change any more keys? (Y, N)\n";
query();
last if uc($_) eq 'N';}#end of for
@row;}#end of change_key

sub readfile{#read the keymap file
$in_f=$keymap;
&open_in_f($in_f);}#end of readfile

sub setkey{#speakup key set
for ($i=$start;$i <2; $i++){
$old_key_hex=$key_hex;
$old_rc=$rc;
for(;;){
$key_hex="";
key_descript();
$macro =query();
next if length($macro) != 2;
$macro=lc($macro);
for ($x=0; $x<=$#kv; $x++){
last if $kv[$x]=~/$macro/;}#end of for
print "Looking for `$macro'\\n";
for ($ct=0; $ct<=$#k_kpd; $ct++){
last if $k_kpd[$ct]=~/$macro/;}#end of for
$ct+=71;
next if $ct==97;
last;}
print "Key $macro found at value $ct\n";
chop $macro;
for ($y=0;$y<=$#hexdef; $y++){
@array = split(/ +/, $hexdef[$y]);
if ($array[0] == $ct && $array[1] eq $macro){
$key_hex = $array[3];}
   }#end of for
print "Using $key_hex\n";
for ($rc=0; $rc<=$#row; $rc++){
last if $row[$rc]=~/$ct/ && $row[$rc]=~/$key_hex/;}#end of for
print "did not find this key in the table:\n" if $#row == $rc;
$old_key_hex=$key_hex if $start==1;#for transfering to keyboard
last if $i==1 && $old_key_hex && $key_hex;}#end of for
@row;}#end of setkey

sub transkey{#move a key to the keyboard
for(;;){#ask for a key 
$start=1;
setkey();
for (;;){#search arrays to transfer speakup key
print "Enter a printable character to use with the ins key or the altgr key:\n";
check();
next if $macro eq "";
for ($no=0, $x=0; $x<=$#row; $x++){
if ($row[$x]=~/keycode $newkey / || $row[$x]=~/keycode   $newkey /
 || $row[$x]=~/keycode  $newkey /){
$y=$x;
print "The key $macro is valid.\n";
$no=1;
$macro="";
last;}#end of if
last if $no>0;
last if $macro eq "";}
if ($no == 1){
$row[$y].="\n	$altgr $newkey = $key_hex";
last;}
last if $newkey>0;}#end of for
print " $row[$rc]\n";
print "Transfered to:\n";
$row[$y].="\n	$altgr $newkey = $key_hex";
print " $row[$y]\n";
$sql=$row[$rc];
pd();
$sql=$row[$y];
pd();
print "Would you like to copy any more keys? (Y, N)\n";
query();
next if uc($_) eq 'Y';
last if uc($_) eq 'N';}#end of for
@row;}#end of transkey

sub check{#check for a macro key
$macro=query();
return("") if $macro eq "";
for ($ct=0; $ct <= $#keyval; $ct++){
$newkey=0;
if ($keyval[$ct]=~/$macro/){
$newkey=$ct;
last;}
last if $newkey>0;
next if $newkey==0;}#end of for
print "Searching for a position for $macro in the key table:\n";
return($macro,$newkey);}#end of check

sub delete_key{#delete a transfered key
$start=1;
setkey();
for (;;){#search arrays to delete a speakup key
print "Enter a charater to delete used with the ins key or the altgr key:\n";
check();
next if $macro eq "";
for ($no=0, $x=0; $x<=$#row; $x++){
if ($row[$x]=~/$altgr $newkey / || $row[$x]=~/$altgr   $newkey /
 || $row[$x]=~/keycode  $newkey /){
$y=$x;
print "this key exists:\n";
$no=1;
$macro="";
last;}#end of if
last if $no>0;
last if $macro eq "";}
last if $newkey>0;}#end of for
if ($no == 1){#remove this keycode
print "removing the key:\n";
$row[$y]=~s/		$altgr $newkey = $hexkey//;
$row[$y]=~s/	$altgr $newkey = $hexkey//;
$row[$y]=~s/$altgr $newkey = $hexkey//;
print " $row[$rc]\n";
print "Deleted:\n";
print " $row[$y]\n";
$sql=$row[$rc];
pd();
$sql=$row[$y];
pd();
mapfile(@row);}#end of if
else {
print "No key found.\n"}
@row;}#end of delete_key

sub open_loadkeys{#open the pipe to loadkeys
my $file = "|$loadkeyspath$loadkeys $parms \n";
unless(open(KH, "$file")){
warn("Can't oben loadkeys with:\n$file\n");}
KH;}#end of open_loadkeys

sub remove_key{#remove a key macro
my ($ct,$tmp,$fc,$hc,$i);
for (;;){#search arrays
print "Enter a printable character to remove\n with the insert key\n";
print "Leave the field blank to terminate:";
check();
last if $macro eq "";
for ($i=0, $hc=0; $i<=$#row; $i++){
next if $row[$i] eq "" || ! ($row[$i]=~/$newkey/);
$no=0;
for ($tmp=$hc;$tmp<=$#hex; $tmp++){
if ($row[$i]=~/$hex[$hc]/){
$hc++;
$no=1;
print "Found $row[$i]\n" if$no ==1;}#end of if
if ($row[$i]=~/# keyspk ins-$macro /){ #this key is in the file
print " $row[$i]\n";
print "this macro exists: Remove it ? (Y, N)\n";
query();
last if uc($_) eq 'N';
if (uc($_) eq 'Y'){
$newkey=$no=0;
$macro="";
$row[$i]="";
$x=$i;
for(; $x<=$#row; ++$x){#remove the lines
last if $row[$x]=~/# keyspk/;
$row[$x]="";}#end of for
}#end of if
last if $macro eq "";}#end of if
next if $no==1;
next if uc($_) eq 'N';
last if $no==0;}
$macro="" if uc($_) eq 'N';
last if $macro eq "";}
next if $macro eq "";
last if uc($_) eq 'N';
last if $newkey>0;}#end of for
mapfile(@row);
@row;}#end of remove_key

sub file_check{#what type of file
 print "Enter the name of the file to check:\n";
my $name = &ans();
if (-l $name){
lstat($name);
} else {
stat($name);}
 print "Testing flags for $name \n";#look for wc
chdir "/usr/bin";
if (-x"wc"){
print " Lines Words Name        characters\n";
$wc = "|wc  $name";
unless(open(KH, "$wc")){
warn("Can't open wc with $tmp\n");}
close($KH);}
chdir($userpath);
system "ls -l $name";
 print "\n is readable" if ( -r $name);
 print "\n is writable" if ( -w $name);
 print "\n is executable" if ( -x $name);
 print "\n is owned " if ( -o $name);
 print "\nReal User ID tests ";
 print "\n is readable" if ( -R $name);
 print "\n is writable" if ( -W $name);
 print "\n is executable" if ( -X $name);
$tmp = -O $name;
 print "\n is owned by group $tmp " if ( -O $name);
 print "\nReality Checks ";
 print "\n is a file " if (-f $name);
 print " that exists " if ( -e $name);
 print " has zero bytes " if ( -z $name);
if ($tmp = -s $name){
 print " has $tmp bytes in it\n" if ( -s $name);
 print "\n is a Text file " if (-T $name);}
 print "\n is a directory " if (-d $name);
 print "\n is a link " if (-l $name);
 print "\n is a socket " if (-S $name);
 print "\n is a pipe " if (-p $name);
 print "\n is a block device " if (-b $name);
 print "\n is a character device " if (-c $name);
 print "\n has setuid bit set " if (-u $name);
 print "\n has sticky bit set " if (-k $name);
 print "\n has gid bit set " if (-g $name);
 print "\n is open to terminal " if (-t $name);
 print "\n is a Binary file " if (-B $name);
print $press;
return("") if !query();
 return("");}#end of file_check

sub loadkeys_view{#view a file
my($tmp);
print "Enter the file name to view.\n";
&load;
for ($ct = 0,$tmp = 0; $ct <= $#row; $ct++, $tmp++){
print "$row[$ct]\n";
last if $_ eq "";
if ($tmp == 19){
$tmp = -1;
next if !query();
print $press;}
}#end of for
}#end of loadkeys_view

sub save_cap_file($cap, $out_f){#save an output file
$out_f="$userpath$out_f";
if ($cap eq 'C'){
&check_exist;
print "Creating the file $out_f.\n" if -e $out_f;}
elsif ($cap eq 'A'){
 unless(open(OUTFILE, ">>$out_f")){
 warn("cannot open the output file $out_f\n");
&error_file;}
print "Appending the file $out_f.\n";}
return OUTFILE;}#end of save_cap_file

sub load{#an input file
return if (!($in_f=&ans()));
&open_in_f($in_f);}#end of load

sub cap_file{#choose append or create for files
print "Create a new fild or append a current file?(C, A)\n";
return if !query();
$cap = uc($_);
$loadkeyscap = $cap if !$loadkeyscap;
print "Enter the file name to save, and $press";
return if !($out_f=&ans());
return($loadkeyscap,$cap,$out_f);}#end of cap_file

sub create_capture_file{#create a file from the capture array
my($tmp);
if ($c_ct ){
&cap_file;
if ($out_f ne ""){
&save_cap_file($cap, $out_f);
for ($tmp = 0; $tmp <= $#capture; $tmp++){
 print OUTFILE "$capture[$tmp]";}
close(OUTFILE);
print "The capture file has been written to\n$out_f\n" if -e $out_f;
$c_ct=0 if -e $out_f;
} else {
print "Nothing to save.\n";}
}
return($c_ct, @capture);}#end of create_capture_file

sub capture_list{#list the capture array
my($tmp);
if ($c_ct){
for ($tmp = 0; $tmp <= $#capture; $tmp++){
printf("%d:  %s", $tmp, $capture[$tmp]);}
&capture_execute($sql);}
else {
print "Nothing sabed.\n";}
}#end of capture_list

sub capture_execute($sql){#execute a command from the capture array
my($tmp);
if ($c_ct){
printf("%d: Enter the command number in the capture array to execute:\n",
$#capture+1);
return if !query();
 s/\D//g;
$tmp = $_;
$sql = $capture[$tmp-1];
} else {
print "nothing saved\n";}
}#end of capture_execute

sub error_file{#try to recover from a file error
my($tmp);
print "Is this an input or output file ?(I, O)\n";
return if !query();
$tmp = uc($_);
print "Now the File Name:\n";
return if (!(&ans()));
if ($tmp eq 'O'){
$out_f = $answer;
&cap_file;}
else {
$in_f = $answer;}
}#end of error_file

sub environment{#environment variables
foreach $key(keys(%ENV)){
 printf("%-10.10s: $ENV{$key}\n", $key);}
}#end of environment



sub password{#system username and password
my $password_ask;
 $pgroup = getpgrp(0);
$username = getpwuid($ <);
$password_ask=0; #set to 1 if you want the system username and password
if ($password_ask){
print
"Enter your user name for this machine, if you ar logged as root enter root:\n";
$case_val=2;
&case;#comment the portions of this function to satisfy your needs
die "Thank you for using $0\n" if !&query;
 $pgroup = getpgrp(0);
if ($username ne $_){
die "The user $_ is not allowed on this computer:\n";}
print "Enter your current password for this machine:\n";
$pwd =(getpwuid($username))[1];
 system "stty -echo";
 $passwd = <STDIN>;
 system "stty echo";
chomp($passwd);#comment if using shadow passwords or for security
if (crypt($passwd, $pwd) ne $pwd){
die("Incorrect password: !\n");}
}
return($username,$passwd);}#end of password

sub case{#toggle automatic case conversion at any prompt with p
if ($case_val==1){
$case_val = 2;
print "CASE CONVERSION IS set to lowercase:\n";}
elsif ($case_val==2){
$case_val = 0;
print "CASE CONVERSION IS off:\n";}
else {
$case_val = 1;
print "Case conversion is SET TO UPPERCASE:\n";}
$case_val;}#end of case

sub open_in_f($in_f){#open an input file
undef @row;
 unless(open(IN_FILE, "$in_f")){
 warn("cannot open the input file\n$in_f\n");
&error_file;}
print "Loading file $in_f.\n";
 @row = <IN_FILE>;
close(IN_FILE);
chomp(@row);
return($in_f,@row);}#end of open _in_f

sub ans{#ask for a case sensitive request
my ($xt);
$xt=$case_val;
$case_val=0;
print
"\nThis is a case sensitive request, your previous case setting will be restored.\n"
if $xt>=1;
$answer=&query();
$_=$answer;
$case_val=$xt;#return to the previous case setting
$answer;}#end of ans

sub ret{#an enter prompt
print $press;
&query;}#end of ret

sub view_keyss{#view the keys transfered to the keyboard
print "Searching for an altgr key,  type q to return\n";
for ($x=0, $i=0, $tmp=0; $i<=$#row; $i++){
if (($x %20 ==0 || $x %21 ==0) && $x >0){
$x=0;
&ret;
last if uc($_) eq 'Q';}#end of if
next if $row[$i]=~/# /;
if ($row[$i]=~/string/){
print "$row[$i]\n";
$x+=2;
next;}#end of if
for ($ct=0; $ct <= $#keyval; $ct++){
next if $keyval[$ct] eq "";
if ($row[$i]=~/$ct/ && $row[$i]=~/altgr/){
printf("Line: %d value: %d ins - %s\n", $i++, $ct, $keyval[$ct]);
$x++;
last;}#end of if
}#end of for
}#end of for
}#end of view_key

sub loadkeysparms{#toggle the loadkeys parameters used with the pipe
if ($keysparms){
$keysparms = 0;
$parmstemp = "$parms";
$parms = "";
print "loadkeys parameters are disabled: `$parms'\n";}
else {
$keysparms = 1;
$parms=$parmstemp;
print "loadkeys parameters are enabled: `$parms'\n";}
return($parms,$parmstemp,$keysparms);}#end of loadkeysparms

sub set_path{#set a directory path
for (;;){
print <<EOF;
Please make shure that you choose a read/write/execute directory so that the
output file may be made executable. You may move it to a directory in
your path such as ~/bin/.
Do you wish to use
$currdir
as your default user directory? (Y, N)
EOF
query();
if (uc($_) eq 'Y'){
$userpath=$currdir;}
else{
print "Enter the absolute path for your files with the trailing /:\n";
$tbl=1;
next if !&ans();
$userpath = $_;
$tbl=0;}
chdir($userpath) if -d $userpath;
print "The directory is executable.\n" if -x $userpath && $mp ne 'Y';
last if -d $userpath;}#end of loop
$userpath;}#end of set_path

#main
use Cwd;
$currdir=cwd();
$currdir.="\/";
use Getopt::Long qw(GetOptions);
print <<EOF;
Welcome to $version
The current directory is:
$currdir
Type QUIT or quit to exit at the prompts.  
EOF
&admin if $keymap eq ""; 

Getopt::Long::config ('bundling');
GetOptions (\%options, 'speakup|s', 'restore|r', 'mapfile=s', 'help|h')
or exit 1;
$help=1 if $options{help};
 foreach $_(keys %options ) {#list the options
printf "%s option = %s\n", $_, $options{$_}; }#end of foreach
key_help () if $options{help};
$speakup=1 if $options{speakup};
speakup_announce() if $options{speakup};
$mapfile = $options{mapfile} if $options{mapfile} ne "";
$restore=1 if $options{restore};
restore_key() if $options{restore};
mapfile(@row) if $options{mapfile} ne "";
print "$currdir\n";
password();
$keysparms=0;
for ($i=0, $hc=0; $i<=$#func; $i++){#create the hex array
for ($tmp=0; $tmp<=$#val; $tmp++, $hc++){
$hex[$hc]="$func[$i]$val[$tmp]";}#end of for
}#end of for

print <<EOF;
The default loadkeys program is $loadkeys The process number is $pgroup
The loadkeys path is:  $loadkeyspath
The default keymap file is: $userpath$keymap
EOF
loadkeysparms();
$case_val=2;
&case;
readfile();#read the keymap file
menu_list();
for (;;){#the main menu
$sql = $mp = "";
if ($c_ct){
print "$c_ct macros in the capture array: ";}
if ($case_val==1){
print "MENU>";}
elsif ($case_val==2){
print "menu>";}
else {
print ">";}
next if !query();
$mp = uc($_);
$mp =~s/\s//g;
if ($mp eq 'U'){
&parameters($loadkeys);}
elsif ($mp eq 'N'){
&capture_list;}
elsif ($mp eq 'B'){
&create_capture_file;}
elsif ($mp eq'O'){
&capture_execute($sql);}
elsif ($mp eq 'M'){
&menu_list;}
elsif ($mp eq 'A'){
&addkey;}
elsif ($mp eq 'W'){
&mapfile(@row);}
elsif ($mp eq 'Q'){
&quit;}
elsif ($mp eq 'C'){
&change_key;}
elsif ($mp eq 'D'){
&delete_key;}
elsif ($mp eq 'T'){
&transkey;}
elsif ($mp eq 'S'){
&speakup_announce;}
elsif ($mp eq 'R'){
&restore_key;}
elsif ($mp eq 'X'){
&remove_key;}
elsif ($mp eq 'Y'){
&loadkeysparms;}
 elsif ($mp eq 'K'){
 &environment;}
elsif ($mp eq '3'){
&send_file;}
elsif ($mp eq 'V'){
&view_keyss;}
elsif ($mp eq 'L'){
$keymap=keymapname();}
elsif ($mp eq 'N'){
&loadkeys_view;}
elsif ($mp eq ')'){
&file_check;}
elsif ($mp eq '?'){
&key_help;}
elsif ($mp eq '('){
$userpath=set_path();}
 else {
 print "Invalid command `$mp':";}
}#end of main

sub send_file{#send a file to loadkeys
my $file;
print "Sending a file to $loadkeys\\n";
for (;;){
if ($name==1){
$_='Y';}
if ($keymap eq "" && $mapfile eq ""){
print "Is the file \n$userpath$out_f? (Y, N)\n" if$name==0;
&query() if $name==0;}
if (uc($_) eq 'Y' || $mapfile ne ""){
$file=$out_f;}
else {
print "Enter the name of the keymap file to send to loadkeys:\n";
$file=&ans();}
if (-f $file){
$sql="$loadkeyspath$loadkeys $parms $file\n";
system $sql;}
last  if -f $file;}#end of for
$name=0;}#end of send_file

sub mapfile(@row){#load send and save keymap file
if ($mapfile eq ""){
print "Enter the name of the new keymap file:\n";
$out_f=&ans();}
else{
$out_f=$mapfile;}
$tmp=$keysparms;
	loadkeysparms() if $keysparms;
&check_exist;
for ($ct = 0; $ct <= $#row; $ct++){
print OUTFILE "$row[$ct]\n" if length($row[$ct]) >0;}#end of for
close($OUTFILE);
$name=1;
send_file($out_f);
loadkeysparms() if $keysparms ne $keysparms;
quit if $mapfile ne "";}#end of mapfile

sub restore_key{#restore a keys to original speakup settings
my ($ct,$tmp,$fc,$hc,$i);
for ($i=0; $i<=$#row; $i++){#remove as many keys before writing the file
last if $row[$i]=~/71/;}
$hc=$i;#beginning of insert
for(; $i<=$#row; $i++){
last if $row[$i]=~/97/;
$row[$i]="";}
$row[$hc]=$default_speakup;
$keymap=keymapname() if ($mapfile eq "") && ($mapfile eq "");
mapfile() if $mapfile ne "";
quit() if $restore;}#end of restore_key

sub speakup_announce{#list the default commands for speakup
for ($i=0; $i<=$#spk_key; $i++){
print "$spk_key[$i]\n";
ret() if $i % 20 == 0 && $i >0 && $speakup == 0;}
quit() if $speakup;}#end of speakup_announce

sub keymapname{#new keymap file name
for (;;){
print "Is the keymap file speakupmap? (Y, N)";
query();
if (uc($_) eq 'Y'){
$keymap="speakupmap";
$row[6] =~s/\"\"/\"$keymap\"/  if $mp eq "";
last;}
print "Enter the keymap file  name to load for your macros:\n";
&query();
$row[6] =~s/\"\"/\"$_\"/ if $keymap eq "";
$keymap = $_;
last if -f $mapfile;
last if -f $keymap;}
readfile() if $mp ne "" && $keymap ne "";
$keymap;}#end of keymapname

sub check_exist{#check and open an output file
if ($mapfile eq ""){
print "\nReplace $out_f?(Y, N)" if (-f $out_f);
&query() if -f $out_f;
if (uc($_) eq 'Y'){ 
unlink $out_f;}
}else {
$out_f=$mapfile;
unlink $out_f if -e $out_f;}
 unless(open(OUTFILE, ">$out_f")){
 warn("cannot open the output file $out_f\n");
&error_file;}
}#end of check_exist

1;
