Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Undesired window in ptked.pl

by jdtoronto (Prior)
on Jan 25, 2007 at 16:47 UTC ( #596543=perlquestion: print w/ replies, xml ) Need Help??
jdtoronto has asked for the wisdom of the Perl Monks concerning the following question:

Esteemed monks,

Our much missed contributor, Nick Ing-Simmons, contributed a rather nice little text editor in Perl/Tk. I found it in c:\perl\bin and the file is ptked.pl.

When I use it I found it creates a MainWindow (at line 104) which is iconified at line 135. This process leaves a toolbar icon present on Win32 machines. A search through the code did not reveal any place where the $top (MainWindow) is de-iconified, so I decided to try withdrawing the $top:

$top->iconify; $top->withdraw;
Now, I don't see any problems, but maybe someone more expert in Perl/Tk might take issue with what I have done and be prepared to tell me if this is appropriate.

Here is the complete code:

#!/usr/local/bin/perl -w use strict; use Socket; use IO::Socket; use Cwd; use Getopt::Long; use vars qw($VERSION $portfile); $VERSION = sprintf '4.%03d', q$Revision: #29 $ =~ /\D(\d+)\s*$/; my %opt; INIT { my $home = $ENV{'HOME'} || $ENV{'HOMEDRIVE'}.$ENV{'HOMEPATH'}; $portfile = "$home/.ptkedsn"; my $port = $ENV{'PTKEDPORT'}; return if $^C; GetOptions(\%opt,qw(server! encoding=s)); unless (defined $port) { if (open(SN,"$portfile")) { $port = <SN>; close(SN); } } if (defined $port) { my $sock = IO::Socket::INET->new(PeerAddr => 'localhost', PeerPort => $port, Proto => 'tcp'); if ($sock) { binmode($sock); $sock->autoflush; foreach my $file (@ARGV) { unless (print $sock "$file\n") { die "Cannot print $file to socket:$!"; } print "Requested '$file'\n"; } $sock->close || die "Cannot close socket:$!"; exit(0); } else { warn "Cannot connect to server on $port:$!"; } } } use Tk; use Tk::DropSite qw(XDND Sun); use Tk::DragDrop qw(XDND Sun); use Tk::widgets qw(TextUndo Scrollbar Menu Dialog); # use Tk::ErrorDialog; { package Tk::TextUndoPtked; @Tk::TextUndoPtked::ISA = qw(Tk::TextUndo); Construct Tk::Widget 'TextUndoPtked'; sub Save { my $w = shift; $w->SUPER::Save(@_); $w->toplevel->title($w->FileName); } sub Load { my $w = shift; $w->SUPER::Load(@_); $w->toplevel->title($w->FileName); } sub MenuLabels { shift->SUPER::MenuLabels, 'Encoding' } sub Encoding { my ($w,$enc) = @_; if (@_ > 1) { $enc = $w->getEncoding($enc) unless ref($enc); $w->{ENCODING} = $enc; $enc = $enc->name; $w->PerlIO_layers(":encoding($enc)"); } return $w->{ENCODING}; } sub EncodingMenuItems { my ($w) = @_; return [ [ command => 'System', -command => [ $w, Encoding => Tk::Sy +stemEncoding()->name ]], [ command => 'UTF-8', -command => [ $w, Encoding => 'UTF-8 +'] ], [ command => 'iso-8859-1', -command => [ $w, Encoding => 'i +so8859-1'] ], [ command => 'iso-8859-15', -command => [ $w, Encoding => ' +iso8859-15'] ], ]; } } my $top = MainWindow->new(); if ($opt{'server'}) { my $sock = IO::Socket::INET->new(Listen => 5, Proto => 'tcp'); die "Cannot open listen socket:$!" unless defined $sock; binmode($sock); my $port = $sock->sockport; $ENV{'PTKEDPORT'} = $port; open(SN,">$portfile") || die "Cannot open $portfile:$!"; print SN $port; close(SN); print "Accepting connections on $port\n"; $top->fileevent($sock,'readable', sub { print "accepting $sock\n"; my $client = $sock->accept; if (defined $client) { binmode($client); print "Connection $client\n"; $top->fileevent($client,'readable',[\&EditRequest,$client]); } }); } Tk::Event::HandleSignals(); $SIG{'INT'} = sub { $top->WmDeleteWindow }; $top->iconify; $top->withdraw; $top->optionAdd('*TextUndoPtked.Background' => '#fff5e1'); $top->fontCreate('ptked',-family => 'courier', -size => ($^O eq 'MSWin +32' ? 11 : -12), -weight => 'normal', -slant => 'roman'); $top->optionAdd('*TextUndoPtked.Font' => 'ptked'); foreach my $file (@ARGV) { Create_Edit($file); } sub EditRequest { my ($client) = @_; local $_; while (<$client>) { chomp($_); print "'$_'\n", Create_Edit($_); } warn "Odd $!" unless eof($client); $top->fileevent($client,'readable',''); print "Close $client\n"; $client->close; } MainLoop; unlink("$portfile"); exit(0); sub Create_Edit { my $path = shift; my $ed = $top->Toplevel(-title => $path); $ed->withdraw; $top->{'Edits'}++; $ed->OnDestroy([\&RemoveEdit,$top]); my $t = $ed->Scrolled('TextUndoPtked', -wrap => 'none', -scrollbars => 'se', # both required till optional fixed! ); $t->pack(-expand => 1, -fill => 'both'); $t = $t->Subwidget('scrolled'); $t->Encoding($opt{encoding}) if $opt{encoding}; my $menu = $t->menu; $menu->cascade(-label => '~Help', -menuitems => [ [Button => '~About...', -command => [\&About,$ed]], ]); $ed->configure(-menu => $menu); my $dd = $t->DragDrop(-event => '<Meta-B1-Motion>'); $t->bind(ref($t),'<Meta-B1-Motion>',\&Ouch); $t->bind(ref($t),'<Meta-ButtonPress>',\&Ouch); $t->bind(ref($t),'<Meta-ButtonRelease>',\&Ouch); $dd->configure(-startcommand => sub { return 1 unless (eval { $t->tagNextrange(sel => '1.0 +','end')}); $dd->configure(-text => $t->get('sel.first','sel.las +t')); }); $t->DropSite(-motioncommand => sub { my ($x,$y) = @_; $t->markSet(insert => "\@$x,$y"); }, -dropcommand => [\&HandleDrop,$t], ); $ed->protocol('WM_DELETE_WINDOW',[ConfirmExit => $t]); $t->bind('<F3>',\&DoFind); $ed->idletasks; if (-e $path) { $t->Load($path); } else { $t->FileName($path); } $ed->deiconify; $t->update; $t->focus; } sub Ouch { warn join(',','Ouch',@_); } sub RemoveEdit { my $top = shift; if (--$top->{'Edits'} == 0) { $top->destroy unless $opt{'s'}; } } sub HandleDrop {my ($t,$seln,$x,$y) = @_; # warn join(',',Drop => @_); my $string; Tk::catch { $string = $t->SelectionGet(-selection => $seln,'FILE_NAME +') }; if ($@) { Tk::catch { $string = $t->SelectionGet(-selection => $seln) }; if ($@) { my @targets = $t->SelectionGet(-selection => $seln, 'TARGETS'); $t->messageBox(-text => "Targets : ".join(' ',@targets)); } else { $t->markSet(insert => "\@$x,$y"); $t->insert(insert => $string); } } else { Create_Edit($string); } } my $str; sub DoFind { my $t = shift; $str = shift if (@_); my $posn = $t->index('insert+1c'); $t->tag('remove','sel','1.0','end'); local $_; while ($t->compare($posn,'<','end')) { my ($line,$col) = split(/\./,$posn); $_ = $t->get("$line.0","$posn lineend"); pos($_) = $col; if (/\G(.*)$str/g) { $col += length($1); $posn = "$line.$col"; $t->SetCursor($posn); $t->tag('add','sel',$posn,"$line.".pos($_)); $t->focus; return; } $posn = $t->index("$posn lineend + 1c"); } } sub AskFind { my ($t) = @_; unless (exists $t->{'AskFind'}) { my $d = $t->{'AskFind'} = $t->Toplevel(-popover => 'cursor', -popan +chor => 'nw'); $d->title('Find...'); $d->withdraw; $d->transient($t->toplevel); my $e = $d->Entry->pack; $e->bind('<Return>', sub { $d->withdraw; DoFind($t,$e->get); }); $d->protocol(WM_DELETE_WINDOW =>[withdraw => $d]); } $t->{'AskFind'}->Popup; $t->update; $t->{'AskFind'}->focusNext; } sub About { my $mw = shift; $mw->Dialog(-text => <<"END",-popover => $mw)->Show; $0 version $VERSION perl$]/Tk$Tk::VERSION Copyright 1995-2004 Nick Ing-Simmons. All rights reserved. This package is free software; you can redistribute it and/or modify it under the same terms as Perl itself. END } __END__ =head1 NAME ptked - an editor in Perl/Tk =head1 SYNOPSIS S< >B<ptked> [I<file-to-edit>] =head1 DESCRIPTION B<ptked> is a simple text editor based on perl/Tk's TextUndo widget. =cut
jdtoronto

Comment on Undesired window in ptked.pl
Select or Download Code
Re: Undesired window in ptked.pl
by zentara (Archbishop) on Jan 25, 2007 at 17:28 UTC
    I don't know what you are doing with it, nor have I dug into it's inner workings, but I just tried it on linux, and it does the same thing. If you start it without a file to edit as arg1, it just iconifies itself. Otherwise it opens the file for editing. So I'm guessing that the iconified window may have something to do with Drag'n'Drop? I have no clue what the socket setup is for, maybe send a file to be edited over the socket? How do you use it when it's iconified?

    P.S. Maybe the old-timers and experts on the newsgroup comp.lang.perl.tk would be familiar with it.


    I'm not really a human, but I play one on earth. Cogito ergo sum a bum

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://596543]
Approved by marto
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (8)
As of 2014-12-22 00:01 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (109 votes), past polls