#!/usr/local/bin/perl -w

eval 'exec /usr/local/bin/perl -w -S $0 ${1+"$@"}'
    if 0; # not running under some shell
use strict;
use IO::Socket;
use Cwd;

use vars qw($VERSION $portfile);
$VERSION = '3.006'; # $Id: //depot/Tk8/ptked#10$

BEGIN 
 {
  my $home = $ENV{'HOME'};
  $portfile = "$home/.ptkedsn";
  my $port = $ENV{'PTKEDPORT'};
  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(Sun);
use Tk::DragDrop qw(Sun);
use Tk::widgets qw(TextUndo Scrollbar);
# use Tk::ErrorDialog;

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";

my $top = MainWindow->new();                    

Event::HandleSignals();

$SIG{'INT'} = sub { $top->destroy };

$top->withdraw;
$top->fileevent($sock,'readable',\&ConnectRequest);
$top->optionAdd('*TextUndo.Background' => '#fff5e1');

foreach my $file (@ARGV)
 {
  Create_Edit($file);
 }

sub ConnectRequest
{       
 print "accepting $sock\n"; 
 my $client = $sock->accept;
 if (defined $client)
  {     
   binmode($client);
   print "Connection $client\n";
   $top->fileevent($client,'readable',[\&EditRequest,$client]);
  }
}

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;
 my $t = $ed->Scrolled('TextUndo', -wrap => 'none', -scrollbars => 'osre');
 if (-e $path)
  {
   $t->Load($path);
  }
 else
  {
   $t->FileName($path);
  }
 my $menu = $t->GetMenu;
 $menu->cascade(-label => '~Help', -menuitems => [
                [Button => '~About...', -command => [\&About,$ed]],  
               ]);
 $ed->configure(-menu => $menu);
 my $dd = $t->DragDrop(-event => '<Meta-B1-Motion>');
 $dd->configure(-startcommand => 
                sub
                 {
                  return 1 unless (eval { $t->tagNextrange(sel => '1.0','end')});
                  $dd->configure(-text => $t->get('sel.first','sel.last')); 
                 });
                
 $t->DropSite(-motioncommand => 
               sub 
                { my ($x,$y) = @_;
                  $t->markSet(insert => "\@$x,$y");
                },
               -dropcommand => 
               sub 
                { my ($seln,$x,$y) = @_;
                  $t->markSet(insert => "\@$x,$y");
                  $t->insert(insert => $t->SelectionGet(-selection => $seln));
                }
              );
 
 $t->pack(-expand => 1, -fill => 'both');
 
 $ed->protocol('WM_DELETE_WINDOW',[ConfirmExit => $t]);
 $t->bind('<F3>',\&DoFind);

 $ed->idletasks;
 $ed->deiconify;
 $t->update;
 $t->focus;
}


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', -popanchor => '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-1999 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 




