#!/usr/bin/perl -w

eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
    if 0; # not running under some shell

use Tk;
use Tk::DropSite qw(Sun);
use Tk::DragDrop qw(Sun);
require Tk::TextUndo;
require Tk::FileSelect;
require Tk::Menubar;
use Tk::ErrorDialog;

my $top = MainWindow->new();

$top->bind('Tk::TextUndo','<Alt-KeyPress>','NoOp');
$top->bind('Tk::TextUndo','<Escape>',['tag','remove','sel','1.0','end'
+]);

my $mb = $top->Menubar;

$top->optionAdd('*TextUndo.Background' => '#fff5e1');

my $fs  = $top->Component(FileSelect => 'fs',-width => 25, -height => 
+8,
                       '-accept'   => sub 
                                     { my $file = shift ; 
                                       return 0 if (-s $file && !(stat
+(_))[12]);
                                       return 1 unless -e $file;
                                       return (-r $file) && (-T $file)
+;  
                                     },
                       Name => 'fs', -filter => '*');

my $t = $top->Scrolled(TextUndo, -wrap => 'none', -scrollbars => 'osre
+');

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));
               }
             );

$mb->Menubutton(-text => '~File', -menuitems => 
                  [[Button => '~Open',
                   -command => sub { my $file = $fs->Show(-popover => 
+$top, -create => 0, -verify => ['-r']);
                                      $t->Load($file) if (defined $fil
+e);
                                   }]]);

$mb->Menubutton(-text => '~File', -menuitems => 
                 [['Button' => '~Save', -command => [ $t , 'Save' ]],
                  ['Button' => 'Save ~As', -command =>
                      sub { 
                           my $file = $fs->Show(-popover => $top, -cre
+ate => 1, -verify => ['-w']);
                           $t->Save($file) if (defined $file);
                          }],
                  ['Button' => '~Empty', -command => [ $t,'delete','1.
+0','end']],
                  '',['Button' => 'E~xit', -command => [ \&CheckSave, 
+$t ]],
                 ]);

$mb->Menubutton(-text => '~Edit', -menuitems =>
                [
                 ['Button' => '~Undo',  -command => [$t, 'undo']],'',
                 ['Button' => '~Copy',  -command => [$t, 'clipboardCop
+y']],
                 ['Button' => 'Cu~t',   -command => [$t, 'clipboardCut
+']],
                 ['Button' => '~Paste', -command => [$t, 'clipboardPas
+te']],
                 '',['Button' => 'Select All', -command => [$t, 'selec
+tAll']],
                ]);

$mb->Menubutton(-text => '~Search', -menuitems =>
                [
                 ['Button' => '~Find', -command => [\&AskFind, $t]],
                 ['Button' => '~Replace', -command => [\&AskReplace, $
+t]],
                ]);

$mb->Menubutton(-text => '~View', -menuitems =>
                [
                 ['Button' => '~Line...', -command => [\&AskLine,$t]],
                ]);

$mb->Menubutton(-text => '~Help', -side => 'right');


$t->pack(-expand => 1, -fill => 'both');

$top->protocol('WM_DELETE_WINDOW',[\&CheckSave,$t]);

if (@ARGV) {
    if (! -e $ARGV[0]) {
        open(FILE,">$ARGV[0]") or die "Could not open $ARGV[0]: $!";
        close(FILE) or die "There was trouble with $ARGV[0]: $!";
    }
    $t->Load($ARGV[0]);
}

$t->bind('<F3>',\&DoFind);

$t->update;
$t->focus;

MainLoop;

sub CheckSave
{
 my $t = shift;
 if ($t->numberChanges)
  {
   my $d = $t->toplevel->Dialog(-text => $t->FileName."\nFile has Chan
+ged\nSave Edits ?",
                                -buttons => ['Yes','No','Cancel'], -po
+pover => $t);
   my $rep = $d->Show;
   return if $rep eq 'Cancel';
   if ($rep eq 'Yes')
    {
     $t->Save or return;  
    }
  }
 $t->toplevel->destroy;
}

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 AskLine
{
 my ($t) = @_;
 unless (exists $t->{'AskLine'})
  {
   my $d = $t->{'AskLine'} = $t->Toplevel(-popover => 'cursor', -popan
+chor => 'nw');
   $d->title('Goto Line ...');
   $d->withdraw;
   $d->transient($t->toplevel);
   my $e = $d->Entry->pack;
   $e->bind('<Return>', 
     sub 
      {
       my $e = shift;
       $d->withdraw;
       my $posn = $e->get.'.0';
       $t->SetCursor($posn);
       $t->focus;
      });
   $d->protocol(WM_DELETE_WINDOW =>[withdraw => $d]);
  }
 $t->{'AskLine'}->Popup;
 $t->update;
 $t->{'AskLine'}->focusNext;

}
__END__
[download]

cheers,
rass