«

#!/usr/bin/perl -w

use Tk; require Tk;
use Cwd;
use strict;
my $cwd=getcwd;
my $newwindow = new MainWindow;
my $typedslash;
my $copy1;
print $^O;
$typedslash = '/';

$newwindow -> minsize (640, 480);
$newwindow -> maxsize (640, 480);
$newwindow -> title ("SimpleEdit");
$newwindow -> configure (-background=>'cyan');

#my $new = $newwindow>$button
my @L_contents= ("SimpleEdit: Type a path to save to or a path to a
file you wish to open.");
# set up the window
my $entrybox = $newwindow->Scrolled ("Text", -height=>19) -> pack
(-fill=>"x");
$entrybox -> configure (-background=>"lightblue");
$entrybox -> focusForce ();

my $L_output = $newwindow -> Label (-textvariable=>\$L_contents[0],
-text=>"SimpleEdit") -> pack (-fill=>"x");
my $savevar = $cwd;
my $savebox = $newwindow -> Entry (-font=>"Courier") -> pack
(-fill=>"x");
my $fr = $newwindow -> Frame (-height=>10, -width=>30) ->
pack(-side=>'left', -padx=>5);
$fr -> configure (-background=>"pink");

my $chdir = $fr -> Button (-font=>"Courier", -text=>"Change Directory",
-command=>\&changedir, -activebackground=>'green') -> pack
(-fill=>'x');

my $mkdir = $fr -> Button (-font=>"Courier", -text=>"Make Directory",
-command=>\&makedir, -activebackground=>'green') -> pack ( -fill=>'x');


my $linuxprinting = $fr -> Button (-font=>"Courier", -text=>"Print
(linux only)", -command=>\&lpr, -
activebackground=>'green') -> pack ( -fill=>'x');
{
$linuxprinting->configure(-state=>"disabled");
}

$savebox -> insert (0, $cwd . $typedslash);

my $exitbutton = $newwindow -> Button (-text=>"Exit SimpleEdit",
-activebackground=>"violet", -command=>sub { exit } )-> pack
(-side=>"bottom", -fill=>"x");
my $help = $newwindow -> Button (-command=>\&help, -text=>"Click for
Help", -font=>"Courier") ->pack(-fill=>'x', -pady=>3);


$exitbutton -> configure (-background=>"black");
$exitbutton -> configure (-foreground=>"white");
my $opendoc = $newwindow -> Button(-text=>"Open",
-activebackground=>"green", -command=>\&opendoc) -> pack (-fill=>"x",
-side=>"bottom");
my $newdoc = $newwindow -> Button(-text=>"New",
-activebackground=>"green", -command=>\&newdoc) -> pack
(-side=>"bottom", -fill=>"x");
my $save = $newwindow -> Button(-text=>"Save Document",
-activebackground=>"green", -command=>\&saveit) -> pack

(-side=>"bottom",-fill=>"x");

my $contentssave;
my @contents;

MainLoop();

sub help
{

}

sub changedir
{
$contentssave = $savebox -> get();
if (-d $contentssave)
{
$L_contents[0] = 'Directory change was sucesfull';
chdir ($contentssave);
}
else
{
$L_contents[0] = "Not a valid directory name";
}
}
sub saveit {
$contentssave = $savebox -> get;
@contents = $entrybox -> Contents();
if (-d $contentssave)
{
$L_contents[0] = "Error saving file. File is a directory.";
}
else
{
open (H_CONTS, ">$contentssave");
print H_CONTS @contents;
close H_CONTS;
$L_contents[0] = "File saved succesfully.";
}


#$savethisthing -> destroy();
}
my $prfilecount = 0;
sub lpr
{
while()
{
last if (! -e "$prfilecount~tmp$prfilecount.tmp");
$prfilecount+=1;
}
open PR, ">$prfilecount~tmp$prfilecount.tmp";
print PR $entrybox -> Contents();
close PR;
my $a = "$prfilecount~tmp$prfilecount.tmp";
my $ret = system ("lp", "$a");
unlink $a;
}
sub opendoc
{
$contentssave=$savebox->get;

if (-d $contentssave)
{
$L_contents[0] = "File is a directory. Can't open
those.";
}
elsif (-d $contentssave)
{
$L_contents[0] = "File is a binary file. Cannot open
those.";
}
elsif (! -e $contentssave)
{
$L_contents[0] = "File does not exist. Retype the
path.";
}
else
{
open (C, $contentssave);
my @conts=<C>;
close (C);
$entrybox -> Contents (@conts);
}

}
my $c = 0;
sub makedir
{
$contentssave = $savebox -> get();
if (-e $contentssave )
{
$L_contents[0] = "Directory already exists or you are trying to
overwrite another file.";
}
if (mkdir ($contentssave))
{
$L_contents[0] = "New directory created!";
}
else
{
$L_contents[0] = "New directory creation process failed.";
}
}
sub newdoc
{
my $cwd2 = getcwd;
$contentssave = $savebox->get;
$L_contents[0]="You have started a new document.";
$entrybox -> Contents ('');
my $len = length ($savebox -> get) + 1;
$savebox -> delete (0, $len);
$savebox -> insert (0, $cwd2 .
"${typedslash}anotherdocument$c.txt") if $c;
$savebox -> insert (0, $cwd2 .
"${typedslash}anotherdocument0.txt") if ! $c;
$c++;
}


sub gogogo
{
exit;
}