# strip everything before this
# cd to your version of Tk-804.025_beta16
# and feed this file to /bin/sh
#
#
rm -f DragDrop/DragDrop/KDEDrop.pm
rm -f DragDrop/DragDrop/KDESite.pm
rm -f pTk/patchlevel.h
patch -p1 -N <<'__END_OF_PATCH__'

Index: Change.log
--- Tk-804.025_beta16/Change.log	2004-03-07 20:22:24.000000000 +0000
+++ Tk-804.026/Change.log	2004-03-18 21:44:26.000000000 +0000
@@ -1,3 +1,121 @@
+Change 3214 on 2004/03/18 by nick@llama
+
+	Bump version to Tk804.026
+
+Change 3213 on 2004/03/18 by nick@dromedary
+
+	Heisenbug hunting in entry.t
+
+Change 3212 on 2004/03/18 by nick@camel
+
+	WinNT getOpenFile/getSaveFile uses non-dstring encode call
+	which did not have code to append a wide NUL to end 
+	of string.
+
+Change 3210 on 2004/03/18 by nick@llama
+
+	Loose patchlevel.h as it causes warnings with Tk-TableMatrix
+
+Change 3208 on 2004/03/18 by nick@llama
+
+	Spinbox validate fix
+	from (Roderich Schupp) forwared from newsgroub by Steve
+
+Change 3207 on 2004/03/18 by nick@llama
+
+	Spinbox bbox should return list
+
+Change 3206 on 2004/03/17 by nick@llama
+
+	Mark cause of POE callback issue, pending confirmation.
+
+Change 3205 on 2004/03/17 by nick@llama
+
+	Re-factor DragDrop:: Rect and SunDrop so latter works again
+	while keeping the fix to local and XDND protocols.
+	Remove KDEDrop and KDESite (a weak ad hoc protocol used by KDE 2).
+
+Change 3204 on 2004/03/17 by nick@llama
+
+	Copyright dates
+
+Change 3203 on 2004/03/17 by nick@llama
+
+	When calling C code with perl args on stack as "objv"
+	swap perl stack so if C calls back into perl it gets
+	a private stack to mess with.
+	(t/leak.t needs minor tuning as a result of above.)
+
+Change 3202 on 2004/03/17 by nick@llama
+
+	Slaven's best-guess patch to get <6> and <7> working
+	for multi-wheel mice.
+
+Change 3201 on 2004/03/17 by nick@llama
+
+	"Michael Krause" <VKrauseM@web.de> reports that
+	EnterFocus sometimes doesn't have widget defined
+	and suggests this workround.
+
+Change 3200 on 2004/03/17 by nick@llama
+
+	Give TextUndo a PerlIO_layers hook
+	Use it to make ptked do encodings.
+
+Change 3199 on 2004/03/17 by nick@llama
+
+	Set SystemEncoding from locale via nl_langinfo if available.
+	Make Tk::SystemEncoding return corresponding Encode object.
+
+Change 3198 on 2004/03/17 by nick@llama
+
+	Cannot use "->containing" for DND's Over has it doesn't return
+	our window if cursor is in toplevel belonging to another app
+	(e.g. a drag token). So do our own search using PointToWindow.
+
+Change 3197 on 2004/03/16 by nick@llama
+
+	Revised fix for RT ticket #5678 - Drag&Drop bug.
+	Site is only valid if its widget is viewable and
+	it "contains" the drop point.
+
+Change 3196 on 2004/03/16 by nick@llama
+
+	Revert change 3195 to DragDrop/Rect.pm
+	It isn't right and breaks Konqueror Xdnd drops on pTk sites.
+
+Change 3195 on 2004/03/16 by nick@llama
+
+	Slaven's patch for Drag&Drop from
+	https://rt.cpan.org/Ticket/Display.html?id=5678
+
+Change 3179 on 2004/03/10 by nick@llama
+
+	Fallout of post-destroy call to After object means
+	that Tk::After::Cancelled needs a method.
+
+Change 3178 on 2004/03/10 by nick@llama
+
+	POD markup glitches
+
+Change 3177 on 2004/03/09 by nick@llama
+
+	HPUX build fix from chris.seip@hp.com
+
+Change 3176 on 2004/03/08 by nick@nickwork
+
+	Detect and warn RedHat UTF-8 (But RedHat9.0 seems to build ok now.)
+	Update README
+
+Change 3175 on 2004/03/08 by nick@nickwork
+
+	Fix die-after-exit for t/browseentry.t (at least as occurs with
+	threaded official perl5.8.0 on RedHat 9).
+
+Change 3174 on 2004/03/07 by nick@llama
+
+	Tk-804.025_beta16 Release Preparation
+
 Change 3173 on 2004/03/07 by nick@llama
 
 	Work round LVs (e.g. substr) not upgrading to UTF-8

Index: Compound/Compound.xs
--- Tk-804.025_beta16/Compound/Compound.xs	2004-02-29 13:17:02.000000000 +0000
+++ Tk-804.026/Compound/Compound.xs	2004-03-17 15:38:22.000000000 +0000
@@ -1,5 +1,5 @@
 /*
-  Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved.
+  Copyright (c) 1995-2004 Nick Ing-Simmons. All rights reserved.
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */

Index: DragDrop/DragDrop/Rect.pm
--- Tk-804.025_beta16/DragDrop/DragDrop/Rect.pm	2003-12-14 19:44:50.000000000 +0000
+++ Tk-804.026/DragDrop/DragDrop/Rect.pm	2004-03-17 21:30:03.000000000 +0000
@@ -1,22 +1,52 @@
 package Tk::DragDrop::Rect;
+use strict;
 use Carp;
 
 # Proxy class which represents sites to the dropping side
 
 use vars qw($VERSION);
-$VERSION = sprintf '4.%03d', q$Revision: #6 $ =~ /\D(\d+)\s*$/;
+$VERSION = sprintf '4.%03d', q$Revision: #11 $ =~ /\D(\d+)\s*$/;
+
+# Some default methods when called site side
+# XIDs and viewable-ness from widget
+
+# XID of ancestor
+sub ancestor { ${shift->widget->toplevel->WindowId} }
+
+# XID of site window
+sub win      { ${shift->widget->WindowId} }
+
+# Is site window mapped
+sub viewable { shift->widget->viewable }
 
 sub Over
 {
  my ($site,$X,$Y) = @_;
+
  my $x = $site->X;
  my $y = $site->Y;
  my $w = $site->width;
  my $h = $site->height;
-
  my $val = ($X >= $x && $X < ($x + $w) && $Y >= $y && $Y < ($y + $h));
- # print "Over ",$site->Show," $X,$Y => $val\n";
- return $val;
+
+ return 0 unless $val;
+
+ my $widget = $site->widget;
+
+ # Now XTranslateCoords from root window to site window's
+ # ancestor. Ancestors final descendant should be the site window.
+ # Like $win->containing but avoids a problem that dropper's "token"
+ # window may be the toplevel (child of root) that contains X,Y
+ # so if that is in another application ->containing does not
+ # give us a window.
+ my $id = $site->ancestor;
+ while (1)
+  {
+   my $cid = $widget->PointToWindow($X,$Y,$id);
+   last unless $cid;
+   $id = $cid;
+  }
+ return ($id == $site->win);
 }
 
 sub FindSite
@@ -24,7 +54,7 @@
  my ($class,$widget,$X,$Y) = @_;
  foreach my $site ($class->SiteList($widget))
   {
-   return $site if ($site->Over($X,$Y));
+   return $site if ($site->viewable && $site->Over($X,$Y));
   }
  return undef;
 }

Index: DragDrop/DragDrop/SunDrop.pm
--- Tk-804.025_beta16/DragDrop/DragDrop/SunDrop.pm	2003-07-20 18:43:27.000000000 +0100
+++ Tk-804.026/DragDrop/DragDrop/SunDrop.pm	2004-03-17 21:30:03.000000000 +0000
@@ -2,7 +2,7 @@
 require  Tk::DragDrop::Rect;
 
 use vars qw($VERSION);
-$VERSION = '4.004'; # $Id: //depot/Tkutf8/DragDrop/DragDrop/SunDrop.pm#4 $
+$VERSION = sprintf '4.%03d', q$Revision: #5 $ =~ /\D(\d+)\s*$/;
 
 use base  qw(Tk::DragDrop::Rect);
 use strict;
@@ -12,7 +12,8 @@
 
 BEGIN
  {
-  my @fields = qw(name win X Y width height flags);
+  # Define the Rect API as members of the array
+  my @fields = qw(name win X Y width height flags ancestor widget);
   my $i = 0;
   no strict 'refs';
   for ($i=0; $i < @fields; $i++)
@@ -22,6 +23,7 @@
    }
  }
 
+
 sub Preview
 {
  my ($site,$token,$e,$kind,$flags) = (@_);
@@ -90,7 +92,6 @@
  $w->SendClientMessage('_SUN_DRAGDROP_TRIGGER',$site->win,32,$data);
 }
 
-
 sub FindSite
 {
  my ($class,$token,$X,$Y) = @_;
@@ -105,6 +106,7 @@
      Tk::catch { @prop = $token->property('get','_SUN_DRAGDROP_INTEREST', $id) };
      if (!$@ && shift(@prop) eq '_SUN_DRAGDROP_INTEREST' && shift(@prop) == 0)
       {
+       # This is a "toplevel" which has some sites associated with it.
        my ($bx,$by) = $token->WindowXY($id);
        $token->{'SunDDSeen'} = {} unless exists $token->{'SunDDSeen'};
        return $site if $token->{'SunDDSeen'}{$id};
@@ -122,7 +124,7 @@
          while (@prop >= 4 && $n-- > 0)
           {
            my ($x,$y,$w,$h) = splice(@prop,0,4);
-           push(@$sites,bless [$sn,$xid,$x+$bx,$y+$by,$w,$h,$flags],$class);
+           push(@$sites,bless [$sn,$xid,$x+$bx,$y+$by,$w,$h,$flags,$id,$token],$class);
           }
         }
        return $class->SUPER::FindSite($token,$X,$Y);
@@ -145,8 +147,22 @@
 sub SiteList
 {
  my ($class,$token) = @_;
- # this code is obsolete now that we look at properties ourselves
- # which means we don't need dropsite manager running
+ return @{$token->{'SunDD'}};
+}
+
+1;
+__END__
+
+# this code is obsolete now that we look at properties ourselves
+# which means we don't need dropsite manager running
+# On Sun's running OpenLook the window manager or dropsite mananger
+# watches for and caches site info in a special selection
+# This code got sites from that
+#
+
+sub SiteList
+{
+ my ($class,$token) = @_;
  unless (1 || $busy || exists $token->{'SunDD'})
   {
    Carp::confess('Already doing it!') if ($busy++);
@@ -181,4 +197,4 @@
 }
 
 1;
-__END__
+

Index: DragDrop/site_test
--- Tk-804.025_beta16/DragDrop/site_test	2003-08-17 19:51:22.000000000 +0100
+++ Tk-804.026/DragDrop/site_test	2004-03-17 21:15:39.000000000 +0000
@@ -9,7 +9,7 @@
 BEGIN
 {
  $kind = ($^O eq 'MSWin32' or ($^O eq 'cygwin' and $Tk::platform eq 'MSWin32'))?
-          ['Win32'] : ['Sun','XDND','KDE']
+          ['Win32'] : ['Sun','XDND']
 }
 use Tk::DropSite @$kind;
 use Tk::DragDrop @$kind;
@@ -18,7 +18,7 @@
 $SIG{__WARN__} = sub {
 local ($_) = @_;
 warn "$_";
-if (/Malformed UTF-8 character|Attempt to free unreferenced/)
+if (/Malformed UTF-8 character|Attempt to free unreferenced|Use of uninitialized/)
  {
   Tk::abort();
  }
@@ -51,16 +51,13 @@
 my $src = $top->Frame->pack;
 foreach my $k ('Local',@$kind,'Any')
  {
-  # next if $k eq 'KDE';
   my $thing = $src->Message('-text' => "$k Source")->pack(-side => 'left');
   my @list;
   @list = (-sitetypes => $k) unless $k eq 'Any';
   $thing->DragDrop(-event => '<B1-Motion>', @list,
                  -handlers => [
                    [-type => 'text/plain',[\&string_handler,"This is text/plain"]],
-#                  [-type => 'FILE_NAME',[\&string_handler,$filename]],
                    [-type => 'text/uri-list',[\&string_handler,$uri]],
-#                  [[\&string_handler,"This is STRING"]]
                  ]);
  }
 

Index: Event/Event.pm
--- Tk-804.025_beta16/Event/Event.pm	2003-08-05 23:48:13.000000000 +0100
+++ Tk-804.026/Event/Event.pm	2004-03-18 21:15:30.000000000 +0000
@@ -1,8 +1,8 @@
 package Tk::Event;
 use vars qw($VERSION $XS_VERSION @EXPORT_OK);
 END { CleanupGlue() }
-$VERSION = sprintf '4.%03d', q$Revision: #13 $ =~ /\D(\d+)\s*$/;
-$XS_VERSION = '804.025';
+$VERSION = sprintf '4.%03d', q$Revision: #14 $ =~ /\D(\d+)\s*$/;
+$XS_VERSION = '804.026';
 use base  qw(Exporter);
 use XSLoader;
 @EXPORT_OK = qw($XS_VERSION DONT_WAIT WINDOW_EVENTS  FILE_EVENTS

Index: Event/Event.xs
--- Tk-804.025_beta16/Event/Event.xs	2004-03-07 18:51:17.000000000 +0000
+++ Tk-804.026/Event/Event.xs	2004-03-17 15:38:21.000000000 +0000
@@ -1,5 +1,5 @@
 /*
-  Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved.
+  Copyright (c) 1995-2004 Nick Ing-Simmons. All rights reserved.
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */

Index: Event/pTkCallback.c
--- Tk-804.025_beta16/Event/pTkCallback.c	2003-12-07 13:28:21.000000000 +0000
+++ Tk-804.026/Event/pTkCallback.c	2004-03-17 20:31:38.000000000 +0000
@@ -1,5 +1,5 @@
 /*
-  Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved.
+  Copyright (c) 1995-2004 Nick Ing-Simmons. All rights reserved.
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */

Index: HList/HList.xs
--- Tk-804.025_beta16/HList/HList.xs	2004-02-29 13:17:41.000000000 +0000
+++ Tk-804.026/HList/HList.xs	2004-03-17 15:38:21.000000000 +0000
@@ -1,5 +1,5 @@
 /*
-  Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved.
+  Copyright (c) 1995-2004 Nick Ing-Simmons. All rights reserved.
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */

Index: IO/IO.xs
--- Tk-804.025_beta16/IO/IO.xs	2004-02-29 13:09:24.000000000 +0000
+++ Tk-804.026/IO/IO.xs	2004-03-17 15:38:01.000000000 +0000
@@ -1,5 +1,5 @@
 /*
-  Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved.
+  Copyright (c) 1995-2004 Nick Ing-Simmons. All rights reserved.
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */

Index: InputO/InputO.xs
--- Tk-804.025_beta16/InputO/InputO.xs	2004-02-29 13:22:43.000000000 +0000
+++ Tk-804.026/InputO/InputO.xs	2004-03-17 15:38:21.000000000 +0000
@@ -1,5 +1,5 @@
 /*
-  Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved.
+  Copyright (c) 1995-2004 Nick Ing-Simmons. All rights reserved.
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */

Index: JPEG/JPEG.xs
--- Tk-804.025_beta16/JPEG/JPEG.xs	2004-02-29 13:05:24.000000000 +0000
+++ Tk-804.026/JPEG/JPEG.xs	2004-03-17 15:38:14.000000000 +0000
@@ -1,5 +1,5 @@
 /*
-  Copyright (c) 1995 Nick Ing-Simmons. All rights reserved.
+  Copyright (c) 1995-2004 Nick Ing-Simmons. All rights reserved.
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */

Index: MANIFEST
--- Tk-804.025_beta16/MANIFEST	2004-03-06 13:30:05.000000000 +0000
+++ Tk-804.026/MANIFEST	2004-03-18 13:55:42.000000000 +0000
@@ -194,8 +194,6 @@
 DragDrop/drag_test
 DragDrop/DragDrop.pm
 DragDrop/DragDrop/Common.pm
-DragDrop/DragDrop/KDEDrop.pm
-DragDrop/DragDrop/KDESite.pm
 DragDrop/DragDrop/LocalDrop.pm
 DragDrop/DragDrop/Rect.pm
 DragDrop/DragDrop/SunConst.pm
@@ -1689,7 +1687,6 @@
 pTk/mTk/xlib/ximage.c
 pTk/mTk/xlib/xutil.c
 pTk/p4e
-pTk/patchlevel.h
 pTk/pned
 pTk/process_object
 pTk/prune_vtab

Index: META.yml
--- Tk-804.025_beta16/META.yml	2003-09-08 18:53:53.000000000 +0100
+++ Tk-804.026/META.yml	2004-03-18 21:19:02.000000000 +0000
@@ -1,10 +1,10 @@
 # http://module-build.sourceforge.net/META-spec.html
 #XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
 name:         Tk
-version:      804.025
+version:      804.026
 version_from: 
 installdirs:  site
 requires:
 
 distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.16
+generated_by: ExtUtils::MakeMaker version 6.17

Index: Makefile.PL
--- Tk-804.025_beta16/Makefile.PL	2004-01-10 17:48:50.000000000 +0000
+++ Tk-804.026/Makefile.PL	2004-03-08 10:15:17.000000000 +0000
@@ -8,6 +8,10 @@
   $IsWin32 = ($^O eq 'MSWin32' || $Config{'ccflags'} =~ /-D_?WIN32_?/);
   $xtra = "";
 
+  if ($Config{myuname} =~ /\bredhat\.com\b/ && $ENV{LANG} =~ /\.UTF-8/)
+   {
+    warn "RedHat perl in UTF-8 locale may not build Tk\n";
+   }
   open(M, "Tk.pm") or die "Can't open Tk.pm for reading VERSION: $!";
   while(<M>)
    {

Index: Mwm/Mwm.xs
--- Tk-804.025_beta16/Mwm/Mwm.xs	2004-02-29 13:18:31.000000000 +0000
+++ Tk-804.026/Mwm/Mwm.xs	2004-03-17 15:38:02.000000000 +0000
@@ -1,5 +1,5 @@
 /*
-  Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved.
+  Copyright (c) 1995-2004 Nick Ing-Simmons. All rights reserved.
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */

Index: NBFrame/NBFrame.xs
--- Tk-804.025_beta16/NBFrame/NBFrame.xs	2004-02-29 13:04:08.000000000 +0000
+++ Tk-804.026/NBFrame/NBFrame.xs	2004-03-17 15:38:23.000000000 +0000
@@ -1,5 +1,5 @@
 /*
-  Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved.
+  Copyright (c) 1995-2004 Nick Ing-Simmons. All rights reserved.
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */

Index: PNG/PNG.xs
--- Tk-804.025_beta16/PNG/PNG.xs	2004-02-29 13:31:00.000000000 +0000
+++ Tk-804.026/PNG/PNG.xs	2004-03-17 15:38:01.000000000 +0000
@@ -1,5 +1,5 @@
 /*
-  Copyright (c) 1995 Nick Ing-Simmons. All rights reserved.
+  Copyright (c) 1995-2004 Nick Ing-Simmons. All rights reserved.
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */

Index: PNG/libpng/scripts/makefile.hpux
--- Tk-804.025_beta16/PNG/libpng/scripts/makefile.hpux	2003-11-29 11:39:32.000000000 +0000
+++ Tk-804.026/PNG/libpng/scripts/makefile.hpux	2004-03-09 08:59:55.000000000 +0000
@@ -5,8 +5,8 @@
 # For conditions of distribution and use, see copyright notice in png.h
 
 # Where the zlib library and include files are located
-ZLIBLIB=/opt/zlib/lib
-ZLIBINC=/opt/zlib/include
+ZLIBLIB=../zlib
+ZLIBINC=../zlib
 
 # Note that if you plan to build a libpng shared library, zlib must also
 # be a shared library, which zlib's configure does not do.  After running

Index: README
--- Tk-804.025_beta16/README	2004-01-12 21:38:31.000000000 +0000
+++ Tk-804.026/README	2004-03-08 10:15:17.000000000 +0000
@@ -7,37 +7,88 @@
 derived from those of the orignal Tix4.1.3 or Tk8.4.* sources.
 See doc/license.html for details of this license.
 
-Tk804.025 is beta level.
+Tk804.026 is now considered production worthy.
 (Previous stable release being Tk800.025.)
-The code itself is probably at least as solid as Tk800 series, but
-build process/tests need shaking down on non/Linux.
 
 This a re-port of a perl interface to Tk8.4.
 C code is derived from Tcl/Tk8.4.5.
+It also includes all the C code parts of Tix8.1.4 from SourceForge.
+The perl code corresponding to Tix's Tcl code is not fully implemented.
 
-Perl API is essentially the same as Tk800.025 but has not
-been verified as compliant.
+Perl API is essentially the same as Tk800 series Tk800.025 but has not
+been verified as compliant. There ARE differences see pod/804delta.pod.
 
 The goal of this release is Unicode support via perl's and
 core-tk's use of UTF-8.
+Tk804.026 builds and loads into a threaded perl but is NOT
+yet thread safe.
 
-It also includes all the C code parts of Tix8.1.4 from SourceForge.
-The perl code corresponding to Tix's Tcl code is not fully implemented.
-
-This Tk804 is only likely to work with perl5.8+
-Perl's UTF-8 support has improved since int was introduced in perl5.6.0.
+This Tk804 is only likely to work with perl5.8.0 or later.
+Perl's UTF-8 support has improved since it was introduced in perl5.6.0.
 Some functions (regular expression match in Text widgets) are known
 to only work with perl5.8.1 and later
 
+There are a lot more tests in Tk804. Some notably t/entry.t and
+t/listbox.t very dependant on the available fonts and to a lesser
+extent the window manager used. (See below for a list of fails
+which can be "expected" even if nothing is really wrong.)
+
+Others t/JP.t and t/KR.t need oriental fonts and can take a long time to
+run on a machine with a lot of fonts but which lacks the glyphs tests are
+looking for.
+
+An experimental implementation of client side fonts via
+freetype2, fontconfig and Xft is provided for Unix.
+This is strongly recommened if you are planning to make use
+of Unicode rendering capabilities of Tk. It also gives anti-aliased
+fonts for regular text (if you have TrueType or Type1 fonts and
+they are in your fontconfig config file).
+
+To try this install do
+
+  perl Makefile.PL XFT=1
+
+See http://fontconfig.org
+
+The author has installed
+  http://fontconfig.org/release/xrender-0.8.3.tar.gz
+  http://fontconfig.org/release/xft-2.1.2.tar.gz
+  http://fontconfig.org/release/fontconfig-2.2.0.tar.gz
+
+but it also works with versions in SuSE8.2 and SuSE9.0.
+
+RedHat 9 builds and runs, but has different fonts installed
+so fails the listbox.t and entry.t in a manner which shows
+those tests fragility:
+
+Failed Test Stat Wstat Total Fail  Failed  List of Failed
+-------------------------------------------------------------------------------
+t/entry.t                336   12   3.57%  93 152 154 157 160-161 167 201 203
+                                           205 207 280
+t/listbox.t              437   46  10.53%  89 92-93 95-97 99-101 186 234 237-
+                                           241 280 282-284 286 288 301-304 336-
+                                           337 339 343 348 365 383-384 386-389
+                                           391 393 395-396 399 401 406 432
+ (3 subtests UNEXPECTEDLY SUCCEEDED), 35 subtests skipped.
+Failed 2/46 test scripts, 95.65% okay. 58/2618 subtests failed, 97.78% okay.
+
+----------------------------
+
 Author has built against:
 
   Perl5.8.0
-   Earlier versions worked with this - but it has Unicode mis-features.
-   Not tried it recently.
-
-   Note that on RedHat Linux in particular the build process must be
-   done in a non UTF-8 locale i.e. LANG=en_GB not LANG=en_GB.utf8
-   (This is due to bugs in perl5.8.0 as shipped by RedHat.)
+   Has Unicode mis-features and is not recommended.
+   Author has tested against official perl5.8.0 and
+   the version shipped with RedHat 9.0.
+   (This latter's perl -V shows it to have MAINT18379 applied as
+    a local patch.)
+
+   SuSE's perl5.8.0 was fine, and they now distribute a 5.8.1
+
+   Note that on RedHat Linux in particular the build process may
+   need to be done in a non UTF-8 locale i.e. LANG=en_GB
+   not LANG=en_GB.UTF-8
+   (This is due to bugs in some perl5.8.0's as shipped by RedHat.)
 
   Perl5.8.1
    Pentium Suse Linux-8.2 gcc-3.3
@@ -50,24 +101,11 @@
    Pentium Suse Linux-8.2/9.0 gcc-3.3
    Visual C++ 6.0, Windows-XP, dmake/nmake
 
+  Perl5.8.3
+   Pentium Suse Linux-9.0 gcc-3.3
+   Visual C++ 6.0, Windows-XP, dmake/nmake
+
 For questions on this package try news:comp.lang.perl.tk or e-mail
 to <ptk@lists.stanford.edu> or <nick@ing-simmons.net>
 
-An experimental implementation of client side fonts via
-freetype2, fontconfig and Xft is provided for Unix.
-This is strongly recommened if you are planning to make use
-of Unicode rendering capabilities of Tk. It also gives anti-aliased
-fonts for regular text (if you have TrueType or Type1 fonts and
-they are in your fontconfig config file).
-
-See http://fontconfig.org
 
-The author has installed
-  http://fontconfig.org/release/xrender-0.8.3.tar.gz
-  http://fontconfig.org/release/xft-2.1.2.tar.gz
-  http://fontconfig.org/release/fontconfig-2.2.0.tar.gz
-
-but it also works with versions in SuSE8.2
-
-To try this install those libraries (or later ones?) and then do
-  perl Makefile.PL XFT=1

Index: README.linux
--- Tk-804.025_beta16/README.linux	2003-07-19 09:39:00.000000000 +0100
+++ Tk-804.026/README.linux	2004-03-18 21:05:35.000000000 +0000
@@ -1,70 +1,57 @@
-This is written by Nick - who never tried linux...
 
-There are several ways to build Tk-b* for linux.
+These days perl/Tk is developed on Linux so things should work.
+Nick uses SuSE Distributions, currently using SuSE 9.0.
+All SuSE's /usr/bin/perl (perl >= perl5.8.0) should work.
+SuSE's fontconfig is fine for building with XFT=1, but
+there are some dodgy TrueType fonts in its set.
 
-1. Build it static - should work on *any* platform, but will be
-   larger than dynamic load version.
-   Hassle here is all the demos etc. really need the #! line
-   changing to point at 'tkperl' rather than 'perl'.
-
-2. Use a.out and dld
-     - you need dld-3.2.6
-     - You also need the "right" 'bash'.
-     - " Fall 1994 Yggdrasil Linux" + above dld has been known to work
-     - you may need to run ranlib on libX11.*
-
-On Wed, 30 Aug 95 12:04:19 EDT
-Adam Wasserman <awasser@hermes.sgc.com> writes:
->
->Let me state for the record that I'm using Linux 1.2.1 (Infomagic Mar '95
->Slackware), with gcc 2.6.3, dld 3.2.6, Tk-b6 and perl5.001m, and it
->all compiled and worked with dynamic loading with little effort or
->problem under /usr/local (besides the Pretty.pm stuff).  I DID have to
->do "ranlib libX11.a" and get the updated dld.  I don't believe my system
->is configured for ELF.
-
-
-3. Use ELF, either distributed that way, or by building yourself.
-     - I believe ELF versions are 'new enough' to have 'right' bash
-     - Make sure *perl* is configured to use dl_dlopen rather than dld
-       as the load method. Or you get this symptom:
-
-> Can't load './blib/auto/Tk/Tk.so' for module Tk: File not found at
-> /usr/lib/perl5/DynaLoader.pm line 450.
->
-> at blib/Tk.pm line 31
-> BEGIN failed--compilation aborted at ./basic_demo line 5.
-
-
-Chris. (stoner@cs.buffalo.edu)  http://www.cs.buffalo.edu/~stoner
-Says:
-
-I had the same problem, I had to reconfigure perl to get it to work. Here is a
-summary of my perl configuration that works:
-
-Summary of my perl5 (patchlevel 1) configuration:
-  Platform:
-    osname=linux, osver=1, archname=i486-linux
-    uname='linux valhalla 1.2.8 #6 sun aug 20 16:49:00 edt 1995 i486 '
-    hint=recommended
-  Compiler:
-    cc='cc', optimize='-O2', ld='cc'
-    cppflags='-D__USE_BSD_SIGNAL -Dbool=char -DHAS_BOOL'
-    ccflags ='-D__USE_BSD_SIGNAL -Dbool=char -DHAS_BOOL'
-    ldflags =''
-    stdchar='char', d_stdstdio=define, usevfork=false
-    voidflags=15, castflags=0, d_casti32=undef, d_castneg=define
-    intsize=4, alignbytes=4, usemymalloc=n, randbits=31
-  Libraries:
-    so=so
-    libpth=/lib /usr/lib /usr/local/lib
-    libs=-lgdbm -ldbm -ldb -ldl -lm -lc -lbsd
-    libc=/usr/lib/libc.a
-  Dynamic Linking:
-    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef
-    cccdlflags='-fpic', ccdlflags='-rdynamic', lddlflags='-shared'
+RedHat is more variable. Nick uses this version under RedHat7.* and
+RedHat9.0 at work. RedHat9.0 will build with XFT=1 but scalable
+fonts installed by default are limited.
 
-You can get this output with the myconfig script that comes with the perl5
-distribution. I think it was using dl_dlopen that fixed the problem for me.
+Main snag on RedHat is that /usr/bin/perl tends to be a RedHat
+patched version rather than an approved perl release. Its 5.8.0 has
+bugs which mean that it is worse that official perl5.8.0 in UTF-8
+locales - but UTF-8 locales are default on RedHat :-(
 
+Nick has installed this version with RedHat's perl on RedHat9.
+BUT there are a lot of reports that it doesn't work. If the problem
+hits you try this:
 
+1. Delete the unpacked version that had trouble - the bug mangles
+   some files.
+
+2. Change to a non UTF-8 locale. i.e.
+   echo $LANG            # find out what your locale is
+   export LANG=en_GB     # what above printed but without UTF-8 bit
+
+3. tar xzf Tk804.026.tar.gz  # re-extract
+   cd Tk804.026
+
+4. perl Makefile.PL          # normal build
+   make
+   make test
+
+   (Steps 3 & 4 can be done using CPAN module provided you stay
+    in non-UTF-8 locale.)
+
+5. Optionally:
+   export LANG=en_GB.UTF-8 # or original from step 2
+   make test               # prove it works in the locale
+
+6. make install
+
+Or just get perl5.8.3 kit from CPAN and build a real perl.
+
+
+Other issues are that distributions vary in the fonts they come
+with and window managers vary by user AND distribution.
+So a t/entry.t and t/listbox.t in particular (which are new tests
+compared to Tk800 series) sometimes fail a few subtests.
+Sometimes when run like:
+
+  perl -Mblib t/entry.t
+
+they will pass :-(
+
+Nick Ing-Simmons 2004/03/18

Index: TList/TList.xs
--- Tk-804.025_beta16/TList/TList.xs	2004-02-29 13:23:23.000000000 +0000
+++ Tk-804.026/TList/TList.xs	2004-03-17 15:38:21.000000000 +0000
@@ -1,5 +1,5 @@
 /*
-  Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved.
+  Copyright (c) 1995-2004 Nick Ing-Simmons. All rights reserved.
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */

Index: Text/Text.pm
--- Tk-804.025_beta16/Text/Text.pm	2004-02-01 19:45:12.000000000 +0000
+++ Tk-804.026/Text/Text.pm	2004-03-17 20:33:56.000000000 +0000
@@ -7,7 +7,7 @@
 # Copyright (c) 1992-1994 The Regents of the University of California.
 # Copyright (c) 1994 Sun Microsystems, Inc.
 # perl/Tk version:
-# Copyright (c) 1995-2003 Nick Ing-Simmons
+# Copyright (c) 1995-2004 Nick Ing-Simmons
 # Copyright (c) 1999 Greg London
 #
 # See the file "license.terms" for information on usage and redistribution
@@ -20,7 +20,7 @@
 use Text::Tabs;
 
 use vars qw($VERSION);
-$VERSION = sprintf '4.%03d', q$Revision: #23 $ =~ /\D(\d+)\s*$/;
+$VERSION = sprintf '4.%03d', q$Revision: #24 $ =~ /\D(\d+)\s*$/;
 
 use Tk qw(Ev $XS_VERSION);
 use base  qw(Tk::Clipboard Tk::Widget);

Index: TixGrid/TixGrid.xs
--- Tk-804.025_beta16/TixGrid/TixGrid.xs	2004-02-29 13:10:41.000000000 +0000
+++ Tk-804.026/TixGrid/TixGrid.xs	2004-03-17 15:38:23.000000000 +0000
@@ -1,5 +1,5 @@
 /*
-  Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved.
+  Copyright (c) 1995-2004 Nick Ing-Simmons. All rights reserved.
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */

Index: TixPixmap/Pixmap.xs
--- Tk-804.025_beta16/TixPixmap/Pixmap.xs	2004-02-29 13:39:53.000000000 +0000
+++ Tk-804.026/TixPixmap/Pixmap.xs	2004-03-17 15:38:22.000000000 +0000
@@ -1,5 +1,5 @@
 /*
-  Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved.
+  Copyright (c) 1995-2004 Nick Ing-Simmons. All rights reserved.
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */

Index: Tk.pm
--- Tk-804.025_beta16/Tk.pm	2004-03-07 20:22:25.000000000 +0000
+++ Tk-804.026/Tk.pm	2004-03-18 21:44:27.000000000 +0000
@@ -62,13 +62,13 @@
 use Carp;
 
 # Record author's perforce depot record
-$Tk::CHANGE      = q$Change: 3174 $;
+$Tk::CHANGE      = q$Change: 3215 $;
 
 # $tk_version and $tk_patchLevel are reset by pTk when a mainwindow
 # is created, $VERSION is checked by bootstrap
 $Tk::version     = '8.4';
 $Tk::patchLevel  = '8.4';
-$Tk::VERSION     = '804.025';
+$Tk::VERSION     = '804.026';
 $Tk::XS_VERSION  = $Tk::VERSION;
 $Tk::strictMotif = 0;
 
@@ -667,6 +667,7 @@
 sub EnterFocus
 {
  my $w  = shift;
+ return unless $w;
  my $Ev = $w->XEvent;
  my $d  = $Ev->d;
  $w->Tk::focus() if ($d eq 'NotifyAncestor' ||  $d eq 'NotifyNonlinear' ||  $d eq 'NotifyInferior');

Index: Tk.xs
--- Tk-804.025_beta16/Tk.xs	2003-12-09 22:02:41.000000000 +0000
+++ Tk-804.026/Tk.xs	2004-03-17 15:38:01.000000000 +0000
@@ -1,5 +1,5 @@
 /*
-  Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved.
+  Copyright (c) 1995-2004 Nick Ing-Simmons. All rights reserved.
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */
@@ -1056,9 +1056,15 @@
 OUTPUT:
 	name
 
+MODULE = Tk	PACKAGE = Tk	PREFIX = Lang_
+
+SV *
+Lang_SystemEncoding()
 
 MODULE = Tk	PACKAGE = Tk	PREFIX = Tk_
 
+
+
 void
 abort()
 

Index: Tk/After.pm
--- Tk-804.025_beta16/Tk/After.pm	2003-09-27 11:30:18.000000000 +0100
+++ Tk-804.026/Tk/After.pm	2004-03-17 20:33:56.000000000 +0000
@@ -1,11 +1,11 @@
-# Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved.
+# Copyright (c) 1995-2004 Nick Ing-Simmons. All rights reserved.
 # This program is free software; you can redistribute it and/or
 # modify it under the same terms as Perl itself.
 package Tk::After;
 use Carp;
 
 use vars qw($VERSION);
-$VERSION = '4.007'; # $Id: //depot/Tkutf8/Tk/After.pm#7 $
+$VERSION = '4.007'; # $Id: //depot/Tkutf8/Tk/After.pm#10 $
 
 sub _cancelAll
 {
@@ -15,9 +15,12 @@
   {
    # carp "Auto cancel ".$obj->[1]." for ".$obj->[0]->PathName;
    $obj->cancel;
+   bless $obj,"Tk::After::Cancelled";
   }
 }
 
+sub Tk::After::Cancelled::once { }
+
 sub submit
 {
  my $obj     = shift;
@@ -40,7 +43,9 @@
 sub DESTROY
 {
  my $obj = shift;
- @{$obj} = ();
+ $obj->cancel;
+ undef $obj->[0];
+ undef $obj->[4];
 }
 
 sub new
@@ -58,7 +63,7 @@
  my $w   = $obj->[0];
  if ($id)
   {
-   $w->Tk::after('cancel'=> $id);
+   $w->Tk::after('cancel'=> $id) if Tk::Exists($w);
    delete $w->{_After_}{$id} if exists $w->{_After_};
    $obj->[1] = undef;
   }

Index: Tk/TextUndo.pm
--- Tk-804.025_beta16/Tk/TextUndo.pm	2003-08-24 09:50:05.000000000 +0100
+++ Tk-804.026/Tk/TextUndo.pm	2004-03-17 20:33:56.000000000 +0000
@@ -1,4 +1,4 @@
-# Copyright (c) 1995-2003 Nick Ing-Simmons.
+# Copyright (c) 1995-2004 Nick Ing-Simmons.
 # Copyright (c) 1999 Greg London.
 # All rights reserved.
 # This program is free software; you can redistribute it and/or
@@ -6,7 +6,7 @@
 package Tk::TextUndo;
 
 use vars qw($VERSION $DoDebug);
-$VERSION = '4.013'; # $Id: //depot/Tkutf8/Tk/TextUndo.pm#13 $
+$VERSION = '4.013'; # $Id: //depot/Tkutf8/Tk/TextUndo.pm#15 $
 $DoDebug = 0;
 
 use Tk qw (Ev);
@@ -653,6 +653,13 @@
  return $w->{'FILENAME'};
 }
 
+sub PerlIO_layers
+{
+ my ($w,$layers) = @_;
+ $w->{PERLIO_LAYERS} = $layers if @_ > 1;
+ return $w->{PERLIO_LAYERS} || '' ;
+}
+
 sub ConfirmDiscard
 {
  my ($w)=@_;
@@ -703,8 +710,8 @@
  my ($w,$filename) = @_;
  $filename = $w->FileName unless defined $filename;
  return $w->FileSaveAsPopup unless defined $filename;
- local *FILE;
- if (open(FILE,">$filename"))
+ my $layers = $w->PerlIO_layers;
+ if (open(my $file,">$layers",$filename))
   {
    my $status;
    my $count=0;
@@ -715,7 +722,7 @@
     {
 #    my $end = $w->index("$index + 1024 chars");
      my $end = $w->index("$index  lineend +1c");
-     print FILE $w->get($index,$end);
+     print $file $w->get($index,$end);
      $index = $end;
      if (($count++%1000) == 0)
       {
@@ -723,7 +730,7 @@
       }
     }
    $progress->withdraw if defined $progress;
-   if (close(FILE))
+   if (close($file))
     {
      $w->ResetUndo;
      $w->FileName($filename);
@@ -742,22 +749,23 @@
  my ($w,$filename) = @_;
  $filename = $w->FileName unless (defined($filename));
  return 0 unless defined $filename;
- local *FILE;
- if (open(FILE,"<$filename"))
+ my $layers = $w->PerlIO_layers;
+ if (open(my $file,"<$layers",$filename))
   {
    $w->MainWindow->Busy;
    $w->EmptyDocument;
    my $count=1;
    my $progress;
-   while (<FILE>)
+   while (<$file>)
     {
      $w->SUPER::insert('end',$_);
      if (($count++%1000) == 0)
       {
-       $progress = $w->TextUndoFileProgress (Loading => $filename,$count,tell(FILE),-s $filename);
+       $progress = $w->TextUndoFileProgress (Loading => $filename,
+                         $count,tell($file),-s $filename);
       }
     }
-   close(FILE);
+   close($file);
    $progress->withdraw if defined $progress;
    $w->markSet('insert' => '1.0');
    $w->FileName($filename);
@@ -774,23 +782,25 @@
  my ($w,$filename) = @_;
  unless (defined($filename))
   {$w->BackTrace("filename not specified"); return;}
- if (open(FILE,"<$filename"))
+ my $layers = $w->PerlIO_layers;
+ if (open(my $file,"<$layers",$filename))
   {
    $w->Busy;
    my $count=1;
    $w->addGlobStart;
    my $progress;
-   while (<FILE>)
+   while (<$file>)
     {
      $w->insert('insert',$_);
      if (($count++%1000) == 0)
       {
-       $progress = $w->TextUndoFileProgress(Including => $filename,$count,tell(FILE),-s $filename);
+       $progress = $w->TextUndoFileProgress(Including => $filename,
+                        $count,tell($file),-s $filename);
       }
     }
    $progress->withdraw if defined $progress;
    $w->addGlobEnd;
-   close(FILE);
+   close($file);
    $w->Unbusy;
   }
  else

Index: Tk/Tiler.pm
--- Tk-804.025_beta16/Tk/Tiler.pm	2004-02-28 16:32:50.000000000 +0000
+++ Tk-804.026/Tk/Tiler.pm	2004-03-17 20:33:56.000000000 +0000
@@ -1,4 +1,4 @@
-# Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved.
+# Copyright (c) 1995-2004 Nick Ing-Simmons. All rights reserved.
 # This program is free software; you can redistribute it and/or
 # modify it under the same terms as Perl itself.
 # An example of a geometry manager "widget" in perl
@@ -7,7 +7,7 @@
 require Tk::Frame;
 
 use vars qw($VERSION);
-$VERSION = sprintf '4.%03d', q$Revision: #11 $ =~ /\D(\d+)\s*$/;
+$VERSION = sprintf '4.%03d', q$Revision: #12 $ =~ /\D(\d+)\s*$/;
 
 use base  qw(Tk::Frame);
 

Index: Tk/Widget.pm
--- Tk-804.025_beta16/Tk/Widget.pm	2004-01-25 12:58:40.000000000 +0000
+++ Tk-804.026/Tk/Widget.pm	2004-03-17 16:00:32.000000000 +0000
@@ -1,9 +1,9 @@
-# Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved.
+# Copyright (c) 1995-2004 Nick Ing-Simmons. All rights reserved.
 # This program is free software; you can redistribute it and/or
 # modify it under the same terms as Perl itself.
 package Tk::Widget;
 use vars qw($VERSION @DefaultMenuLabels);
-$VERSION = sprintf '4.%03d', q$Revision: #29 $ =~ /\D(\d+)\s*$/;
+$VERSION = sprintf '4.%03d', q$Revision: #30 $ =~ /\D(\d+)\s*$/;
 
 require Tk;
 use AutoLoader;
@@ -994,6 +994,8 @@
  # <4> and <5> are how mousewheel looks on X
  $mw->bind($class,'<Shift-4>',      ['xview','scroll',-1,'units']);
  $mw->bind($class,'<Shift-5>',      ['xview','scroll',1,'units']);
+ $mw->bind($class,'<Button-6>',     ['xview','scroll',-1,'units']);
+ $mw->bind($class,'<Button-7>',     ['xview','scroll',1,'units']);
 }
 
 sub YMouseWheelBind

Index: WinPhoto/WinPhoto.xs
--- Tk-804.025_beta16/WinPhoto/WinPhoto.xs	2004-02-29 13:31:10.000000000 +0000
+++ Tk-804.026/WinPhoto/WinPhoto.xs	2004-03-17 15:38:22.000000000 +0000
@@ -1,5 +1,5 @@
 /*
-  Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved.
+  Copyright (c) 1995-2004 Nick Ing-Simmons. All rights reserved.
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */

Index: encGlue.c
--- Tk-804.025_beta16/encGlue.c	2003-12-01 19:07:04.000000000 +0000
+++ Tk-804.026/encGlue.c	2004-03-18 20:34:01.000000000 +0000
@@ -1,5 +1,5 @@
 /*
-  Copyright (c) 2000-2003 Nick Ing-Simmons. All rights reserved.
+  Copyright (c) 2000-2004 Nick Ing-Simmons. All rights reserved.
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */
@@ -8,6 +8,11 @@
 #include <EXTERN.h>
 #include <perl.h>
 #include <XSUB.h>
+
+#ifdef HAS_NL_LANGINFO
+#include <langinfo.h>
+#endif
+
 #define U8 U8
 #include "tkGlue.def"
 
@@ -536,13 +541,24 @@
 {
  if (!system_encoding)
   {
-   system_encoding = Tcl_GetEncoding(NULL,"iso8859-1");
+   char *codeset = "iso8859-1";
+/* This assumes perl's Configure probe stuff is #include-d above */
+#if defined(HAS_NL_LANGINFO) && defined(CODESET)
+   codeset = nl_langinfo(CODESET);
+#endif
+   system_encoding = Tcl_GetEncoding(NULL,codeset);
   }
  return system_encoding;
 }
 
 #define PerlEncObj(enc) (HeVAL((HE *) (enc)))
 
+SV *
+Lang_SystemEncoding(void)
+{
+ return PerlEncObj(GetSystemEncoding());
+}
+
 Tcl_Encoding
 Tcl_GetEncoding (Tcl_Interp * interp, CONST char * name)
 {
@@ -673,7 +689,7 @@
  if (srcLen < 0)
   srcLen = strlen(src);
  send = s+srcLen;
- dstLen--;
+ dstLen -= 2;
  dend = d + dstLen;
  stmp = newSV(srcLen);
  while (s < send)
@@ -751,7 +767,10 @@
  SvREFCNT_dec(stmp);
  *srcReadPtr  = (s - (U8 *)src);
  *dstCharsPtr = chars;
- dst[dstLen]  = '\0';
+ dst[dstLen]   = '\0';
+ dst[dstLen+1]   = '\0';
+ /* If dest is wide single '\0' may not be enough */
+ Zero(d,dend-d,char);
  *dstWrotePtr = (d- (U8 *)dst);
  return code;
 }

Index: objGlue.c
--- Tk-804.025_beta16/objGlue.c	2004-03-07 19:54:07.000000000 +0000
+++ Tk-804.026/objGlue.c	2004-03-17 15:38:01.000000000 +0000
@@ -1,5 +1,5 @@
 /*
-  Copyright (c) 1997-2003 Nick Ing-Simmons. All rights reserved.
+  Copyright (c) 1997-2004 Nick Ing-Simmons. All rights reserved.
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */

Index: pTk/mTk/generic/tkBind.c
--- Tk-804.025_beta16/pTk/mTk/generic/tkBind.c	2004-02-28 16:39:44.000000000 +0000
+++ Tk-804.026/pTk/mTk/generic/tkBind.c	2004-03-17 15:59:05.000000000 +0000
@@ -4775,10 +4775,14 @@
 	p = GetField(p, field, FIELD_SIZE);
     }
     if (*field != '\0') {
-	if ((*field >= '1') && (*field <= '5') && (field[1] == '\0')) {
+	if ((*field >= '1') && (*field <= '7') && (field[1] == '\0')) {
 	    if (eventFlags == 0) {
-		patPtr->eventType = ButtonPress;
-		eventMask = ButtonPressMask;
+	        if (*field <= '5') {
+		    patPtr->eventType = ButtonPress;
+		    eventMask = ButtonPressMask;
+		} else {
+		    goto getKeysym;
+		}
 	    } else if (eventFlags & KEY) {
 		goto getKeysym;
 	    } else if ((eventFlags & BUTTON) == 0) {

Index: pTk/mTk/generic/tkEntry.c
--- Tk-804.025_beta16/pTk/mTk/generic/tkEntry.c	2003-12-19 11:54:52.000000000 +0000
+++ Tk-804.026/pTk/mTk/generic/tkEntry.c	2004-03-18 08:49:07.000000000 +0000
@@ -3946,9 +3946,9 @@
 	    }
 	    Tk_CharBbox(entryPtr->textLayout, index, &x, &y,
 		    &width, &height);
-	    sprintf(buf, "%d %d %d %d", x + entryPtr->layoutX,
+	    Tcl_IntResults(interp, 4, 0,
+		    x + entryPtr->layoutX,
 		    y + entryPtr->layoutY, width, height);
-	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
 	    break;
 	}
 
@@ -4587,7 +4587,8 @@
 		TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
 	Tcl_DStringFree(&script);
 #else
-	code = LangDoCallback(entryPtr->interp, sbPtr->command, 1, 1, "%d", type);
+	code = LangDoCallback(entryPtr->interp, sbPtr->command, 1, 2,
+		              " %s %s", entryPtr->string, type);
 #endif
 
 	if (code != TCL_OK) {

Index: pod/Listbox.pod
--- Tk-804.025_beta16/pod/Listbox.pod	2004-02-28 16:35:35.000000000 +0000
+++ Tk-804.026/pod/Listbox.pod	2004-03-10 08:36:15.000000000 +0000
@@ -468,7 +468,7 @@
 element in the listbox, 0.33 indicates the element one-third the
 way through the listbox, and so on.
 
-=item I<$listbox>-E<gt>B<yviewScroll( I<number, what> );
+=item I<$listbox>-E<gt>B<yviewScroll>( I<number, what> );
 
 This command adjusts the view in the window up or down according to
 I<number> and I<what>.

Index: pod/Text.pod
--- Tk-804.025_beta16/pod/Text.pod	2004-03-06 13:34:08.000000000 +0000
+++ Tk-804.026/pod/Text.pod	2004-03-10 08:38:08.000000000 +0000
@@ -830,14 +830,13 @@
 this point whenever the text widget has the input focus.
 
 =head1 THE MODIFIED FLAG
-       
+
 The text widget can keep track of changes to the content of the  widget
 by means of the modified flag. Inserting or deleting text will set this
 flag. The flag can be queried, set and cleared programatically as well.
 Whenever  the flag changes state a B<<<Modified>>> virtual event is gener-
 ated. See the edit modified widget command for more details.
 
-=back
 
 =head1 WIDGET METHODS
 
@@ -1034,7 +1033,7 @@
 
 =item B<-window>
 
-=back 
+=back
 
 Include information about embedded windows in the dump results.
 The value of a window is its Tk pathname, unless the window
@@ -1047,7 +1046,7 @@
 This  command controls the undo mechanism and the modified flag.
 The exact behavior of the command depends on the option argument
 that follows the edit argument.  The following forms of the command
-are currently supported:                                   
+are currently supported:
 
 =over 4
 
@@ -1057,7 +1056,7 @@
 the widget. The insert, delete, edit undo and  edit  redo
 commands  or the user can set or clear the modified flag.
 If boolean is specified, sets the modified  flag  of  the
-widget to boolean.                                       
+widget to boolean.
 
 =item I<$text>-E<gt>B<editRedo>;
 
@@ -2128,7 +2127,7 @@
 Does nothing otherwise.
 
 =item [33]
-     
+
 Control-Z (or Control-y on Windows) reapplies the last undone edit
 action if the -undo option is true. Does nothing otherwise.
 
@@ -2142,7 +2141,6 @@
 The behavior of texts can be changed by defining new bindings for
 individual widgets or by redefining the class bindings.
 
-=back
 
 =head1 TIED INTERFACE
 
@@ -2168,7 +2166,6 @@
 
  MainLoop;
 
-=back
 
 =head1 PERFORMANCE ISSUES
 

Index: pod/Widget.pod
--- Tk-804.025_beta16/pod/Widget.pod	2004-02-28 16:35:45.000000000 +0000
+++ Tk-804.026/pod/Widget.pod	2004-03-10 08:35:40.000000000 +0000
@@ -98,7 +98,7 @@
 The state of the widgets and the grab is restored by a call to
 I<$widget>-E<gt>B<Unbusy>.
 
-=item I<$widget>-E<gt>B<caret>( I<?-x x?, ?-y y?, ?-height height? );
+=item I<$widget>-E<gt>B<caret>( I<?-x x?, ?-y y?, ?-height height?> );
 
 Sets and queries the caret location for the display of the specified
 Tk window window.  The caret is the per-display cursor location used
@@ -137,8 +137,8 @@
 failed allocation.
 
 =item I<$widget>-E<gt>B<ConfigSpecs>
- 
-Used to perform delegated option configuration for a mega-widget.    
+
+Used to perform delegated option configuration for a mega-widget.
 Returns, in Tk::Derived::ConfigSpecs notation (see L<Tk::ConfigSpecs>),
 all possible options for a widget. For example,
 
@@ -632,7 +632,7 @@
 special input devices.  This feature is only significant  on  X.
 If  XIM support is not available, this will always return 0.
 If  the  boolean  argument  is  omitted,  the  current  state is
-returned.  This is turned on by default for the main display.   
+returned.  This is turned on by default for the main display.
 
 =item I<$widget>-E<gt>B<windowingsystem>;
 

Index: ptked
--- Tk-804.025_beta16/ptked	2004-02-01 19:45:12.000000000 +0000
+++ Tk-804.026/ptked	2004-03-17 21:30:03.000000000 +0000
@@ -3,9 +3,10 @@
 use Socket;
 use IO::Socket;
 use Cwd;
+use Getopt::Long;
 
 use vars qw($VERSION $portfile);
-$VERSION = '3.006'; # $Id: //depot/Tkutf8/ptked#7 $
+$VERSION = sprintf '4.%03d', q$Revision: #29 $ =~ /\D(\d+)\s*$/;
 
 my %opt;
 INIT
@@ -14,7 +15,7 @@
   $portfile = "$home/.ptkedsn";
   my $port = $ENV{'PTKEDPORT'};
   return if $^C;
-  getopts("s",\%opt);
+  GetOptions(\%opt,qw(server! encoding=s));
   unless (defined $port)
    {
     if (open(SN,"$portfile"))
@@ -50,31 +51,59 @@
  }
 
 use Tk;
-use Tk::DropSite qw(XDND KDE Sun);
-use Tk::DragDrop qw(XDND KDE Sun);
+use Tk::DropSite qw(XDND Sun);
+use Tk::DragDrop qw(XDND Sun);
 use Tk::widgets qw(TextUndo Scrollbar Menu Dialog);
-use Getopt::Std;
 # 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::SystemEncoding()->name ]],
+           [ command => 'UTF-8',  -command => [ $w, Encoding => 'UTF-8'] ],
+           [ command => 'iso-8859-1', -command => [ $w, Encoding => 'iso8859-1'] ],
+           [ command => 'iso-8859-15', -command => [ $w, Encoding => 'iso8859-15'] ],
+         ];
+
+ }
+
 }
 
 my $top = MainWindow->new();
 
-if ($opt{'s'})
+if ($opt{'server'})
  {
   my $sock = IO::Socket::INET->new(Listen => 5, Proto => 'tcp');
   die "Cannot open listen socket:$!" unless defined $sock;
@@ -147,6 +176,9 @@
          );
  $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]],
@@ -283,7 +315,7 @@
 $0 version $VERSION
 perl$]/Tk$Tk::VERSION
 
-Copyright © 1995-2003 Nick Ing-Simmons. All rights reserved.
+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

Index: t/entry.t
--- Tk-804.025_beta16/t/entry.t	2003-12-23 11:24:41.000000000 +0000
+++ Tk-804.026/t/entry.t	2004-03-18 20:34:01.000000000 +0000
@@ -31,7 +31,13 @@
     }
 }
 
-BEGIN { plan tests => 336 }
+BEGIN {
+        # these fail (sometimes) under 'make test'
+        my @fragile = qw(160 161 167 191 193 195);
+        @fragile = () ; # unless $ENV{PERL_DL_NONLAZY};
+        plan tests => 336,
+        todo => \@fragile
+      }
 
 my $mw = Tk::MainWindow->new();
 $mw->geometry('+10+10');

Index: t/leak.t
--- Tk-804.025_beta16/t/leak.t	2003-12-13 12:10:26.000000000 +0000
+++ Tk-804.026/t/leak.t	2004-03-17 17:33:54.000000000 +0000
@@ -59,6 +59,8 @@
 # Tests for leaking subroutine set
 
 # first binding always creates some SVs
+my $N = 100;
+
 $mw->bind("<Motion>" => [sub { warn }]);
 
 $c1 = Devel::Leak::NoteSV($handle);
@@ -66,7 +68,7 @@
     $mw->bind("<Motion>" => [sub { warn }]);
 }
 $c2 = Devel::Leak::NoteSV($handle);
-ok($c2, $c1);
+ok($c2-$c1 <= 1, 1);
 
 
 $c1 = Devel::Leak::NoteSV($handle);
@@ -145,7 +147,6 @@
 $mw->update;
 my $count = 0;
 Tk->after(cancel => Tk->after(10,sub { $count-- }));
-my $N = 100;
 $c1 = Devel::Leak::NoteSV($handle);
 for (1..$N)
 {

Index: tkGlue.c
--- Tk-804.025_beta16/tkGlue.c	2004-02-29 13:33:12.000000000 +0000
+++ Tk-804.026/tkGlue.c	2004-03-17 23:01:13.000000000 +0000
@@ -1,5 +1,5 @@
 /*
-  Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved.
+  Copyright (c) 1995-2004 Nick Ing-Simmons. All rights reserved.
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */
@@ -1633,6 +1633,7 @@
    if (SvROK(sv) && SvTYPE(SvRV(sv)) != SVt_PVCV)
     sv = SvRV(sv);
   }
+
  PUSHMARK(sp);
  if (SvTYPE(sv) == SVt_PVAV)
   {
@@ -1647,6 +1648,15 @@
       {
        croak("Callback slot 0 tainted %_",sv);
       }
+     /* FIXME:
+        POE would like window passed to its callback objects
+        Pending suggestion is:
+         if ($object->can('_Tk_passWidget') &&
+             $object->_Tk_passWidget($widget)
+          {
+           # proceed as if it wasn't an object
+          }
+      */
      if (!sv_isobject(sv))
       {
        if (obj && obj->window) {
@@ -2233,18 +2243,12 @@
         stack moves as a result of the call
       */
      int offset = args - sp;
-     /* BEWARE - FIXME ? if Tk code does a callback to perl and perl grows the
-        stack then args that Tk code has will still point at old stack.
-        Thus if Tk tests args[i] *after* the callback it will get junk.
-        Only solid fix that occurs to me at present is to take a copy
-        of args here - but that seems expensive.
-        (Note it is only vector that is at risk, SVs themselves will stay put.)
-        Possible alternate fix is for (all the) Lang_*Callback() to be passed &args,
-        and fix it if stack moves.
-      */
      int code;
+     SV **our_sp = sp;
+
      Tcl_ObjCmdProc *proc = info->Tk.objProc;
      ClientData cd = info->Tk.objClientData;
+
      if (!proc)
       {
        proc = (Tcl_ObjCmdProc *) (info->Tk.proc);
@@ -2259,9 +2263,35 @@
        if (SvPOK(args[i]))
         Tcl_GetString(args[i]);
       }
+
      Tcl_Preserve(interp);
+
+     /* BEWARE if Tk code does a callback to perl and perl grows the
+        stack then args that Tk code has will still point at old stack.
+        Thus if Tk tests args[i] *after* the callback it will get junk.
+        (Note it is only vector that is at risk, SVs themselves will stay put.)
+
+        So we pre-emptively swap perl stack so any callbacks
+        which grow their stack don't move our "args"
+      */
+     ENTER;
+     SAVETMPS;
+     SPAGAIN;
+     PUSHSTACK;
+     PUTBACK;
+
      code = (*proc) (cd, interp, items, args);
+
+     POPSTACK;
+     SPAGAIN;
+     FREETMPS;
+     LEAVE;
+
+     if (sp != our_sp)
+      abort();
+
      Tcl_Release(interp);
+
      /* info stucture may have been free'ed now ... */
 #ifdef WIN32
      if (DCcount)

Index: tkGlue.h
--- Tk-804.025_beta16/tkGlue.h	2003-08-08 09:56:49.000000000 +0100
+++ Tk-804.026/tkGlue.h	2004-03-17 10:48:21.000000000 +0000
@@ -64,6 +64,7 @@
 
 extern int	has_highbit(CONST char *s,int l);
 extern SV *	sv_maybe_utf8(SV *sv);
+extern SV *	Lang_SystemEncoding(void);
 
 #ifndef WIN32
 #define HWND void *
__END_OF_PATCH__