a tk text editor (works on windows and linux)

R

robin

#!/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;
}
 
M

Matt Garrish

robin said:
#!/usr/bin/perl -w

use Tk; require Tk;
Click to expand...

Oh man...
use Cwd;
use strict;
Click to expand...

And warnings are where?
sub help
{

}
Click to expand...

That makes sense somehow...
sub gogogo
{
exit;
}
Click to expand...

And that seals it.

I can't even begin to express how bad this program is. I ran it just for
amusement, and the first thing I noticed is that it really doesn't matter
whether you use new, open or anything else. Just type in a file name, add
some text and you can save over any file without so much as a prompt that no
file is open and the file exists.Why exactly did you post this half-baked
code?

Matt
 
M

Matt Garrish

A. Sinan Unur said:
He's running with the -w switch.
Click to expand...

Oh, you're right. That's new for him. Maybe I was too quick to... no, I
stand by the rest... : )
...


He wanted us to know that the village idiot is alive and well.
Click to expand...

I think it's a challenge to robic0. He saw his parser and wanted to
re-establish his position at the bottom of the food chain.

Matt
 
A

A. Sinan Unur

I think it's a challenge to robic0. He saw his parser and wanted to
re-establish his position at the bottom of the food chain.
Click to expand...

It seems that he has fallen short: No cursing, no foul screams of
national pride etc. The problem with robin is that he cannot bring
himself to do things step-by-step, methodically. The problems with
robic0 are way, way beyond that.

Sinan
 
U

Uri Guttman

ASU> It seems that he has fallen short: No cursing, no foul screams of
ASU> national pride etc. The problem with robin is that he cannot bring
ASU> himself to do things step-by-step, methodically. The problems with
ASU> robic0 are way, way beyond that.

ya know, i leave you guys to run this group for a year, and i come back
and new trolls are in residence. what kind of c.l.p.m hackers are you?!
i did see some line noise from robic0 and i even flamed one (but to my
disappointment i got no response). this is the first i have seen of
robin and such a wonderful slobbering of code such as i haven't seen in
a while. the joys of usenet are forever.

looks like the sheriff is back in town. :)

uri
 
M

Matt Garrish

Uri Guttman said:
ASU> [email protected]:


ASU> It seems that he has fallen short: No cursing, no foul screams of
ASU> national pride etc. The problem with robin is that he cannot bring
ASU> himself to do things step-by-step, methodically. The problems with
ASU> robic0 are way, way beyond that.

ya know, i leave you guys to run this group for a year, and i come back
and new trolls are in residence. what kind of c.l.p.m hackers are you?!
Click to expand...

You don't remember robin? I thought you hacked his bulletin board a couple
of years ago... : )

He seems to show up every now and again to share his neat-o code with us.
Unlike robic0's desperate need for attention from usenet, I think robin
honestly believes he's doing people a service by posting it.

Matt
 
U

Uri Guttman

MG> My apologies: credit where credit is due... : )

MG> (I was probably thinking of poor Mr. Newton.)

was that the fat alaskan electrician? the most amazing part of that was
that i never did touch his site. in fact i have never tried to break or
crack into any box in my entire life. just not interesting to me.

ah, the memories. if only i could power off and wipe some of them out.

uri
 
A

A. Sinan Unur

MG> My apologies: credit where credit is due... : )
MG> (I was probably thinking of poor Mr. Newton.)
Click to expand...

Thanks. I try to cling on to whatever amusement I can find.
was that the fat alaskan electrician?
Click to expand...

Ohmigod! I found one of the threads. It is times like this I really
appreciate GG (and the fact that I just haven't been around long enough.
the most amazing part of that was that i never did touch his site.
in fact i have never tried to break or crack into any box in my
entire life. just not interesting to me.
Click to expand...

Me neither. In robin's case, he had posted his code on his web site, and
asked for comments. Then he accused me of hacking his site when I
downloaded the code using the link he had provided, and commented on it.

Sinan
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

error running a perl TK programme 1
Windows Perl/Tk Sirius App 0
Translater + module + tkinter 1
Entry Widget - Perl/Tk 3
How to Create a random password generator in a separate window 4
Index Value of a Button Widget in Perl/Tk 0
How to use PDF-lib and how to center each line of texts on the page? 1
Per/Tk - text widget does not get updated 3

Members online

Total: 74 (members: 2, guests: 72)
Robots: 330

Forum statistics

Threads
473,982
Messages
2,570,189
Members
46,735
Latest member
HikmatRamazanov

Latest Threads

Top