# strip everything before this
# cd to your version of Tk-804.025_beta7
# and feed this file to /bin/sh
#
#
rm -f demos/demos/images/flower2.png
touch demos/demos/widget_lib/trace1.pl
chmod 0444 demos/demos/widget_lib/trace1.pl
touch PNG/libpng/scripts/makefile.mingw
chmod 0444 PNG/libpng/scripts/makefile.mingw
touch demos/demos/widget_lib/trace2.pl
chmod 0444 demos/demos/widget_lib/trace2.pl
touch demos/demos/widget_lib/choosedir.pl
chmod 0555 demos/demos/widget_lib/choosedir.pl
touch demos/demos/widget_lib/photo2.pl
chmod 0444 demos/demos/widget_lib/photo2.pl
patch -p1 -N <<'__END_OF_PATCH__'

Index: Change.log
--- Tk-804.025_beta7/Change.log	2003-12-02 20:57:12.000000000 +0000
+++ Tk-804.025_beta8/Change.log	2003-12-07 13:28:37.000000000 +0000
@@ -1,3 +1,51 @@
+Change 3019 on 2003/12/06 by nick@camel
+
+	MinGW libpng makefile was not checked in or in MANIFEST
+
+Change 3017 on 2003/12/06 by nick@camel
+
+	Win32 hangs if you display dialog which is transient
+	to a withdrawn window?
+
+Change 3016 on 2003/12/06 by nick@camel
+
+	dTHXs stuff fow Windows builds with PERL_NO_GET_CONTEXT
+
+Change 3015 on 2003/12/06 by nick@llama
+
+	"Loose some debug prints in Win32 Drag/Drop
+
+Change 3014 on 2003/12/06 by nick@llama
+
+	"Jack" <goodcall@telusplanet.net> - latest version of
+	Balloon.pm tweaks
+
+Change 3013 on 2003/12/06 by nick@llama
+
+	Patch for timestamp for WM_TAKE_FOCUS events.
+	from Scott Smedley <ss@aao.gov.au>
+	There is a bug in Perl/Tk that neglects to pass the timestamp associated
+	with a WM_TAKE_FOCUS event. This leads to focussing race conditions in
+	aplications that use a globally active focussing policy.
+	The correct functionality is documented in:
+	http://tronche.com/gui/x/icccm/sec-4.html#s-4.1.7
+
+Change 3012 on 2003/12/06 by nick@llama
+
+	Demos patch from Steve
+
+Change 3011 on 2003/12/06 by nick@llama
+
+	A number of patches from Slaven.
+
+Change 3010 on 2003/12/06 by nick@llama
+
+	Removed debug as suggested by Jim Winters <jim.winters@ccur.com>
+
+Change 3009 on 2003/12/02 by nick@llama
+
+	Change.log update for beta7
+
 Change 3008 on 2003/12/02 by nick@llama
 
 	Avoid 'nsv' as a variable after scare with encGlue.c in perl5.9

Index: DragDrop/Win32Site/Win32Site.pm
--- Tk-804.025_beta7/DragDrop/Win32Site/Win32Site.pm	2003-07-20 18:43:27.000000000 +0100
+++ Tk-804.025_beta8/DragDrop/Win32Site/Win32Site.pm	2003-12-06 14:38:02.000000000 +0000
@@ -1,7 +1,7 @@
 package Tk::DragDrop::Win32Site;
 
 use vars qw($VERSION);
-$VERSION = '4.004'; # $Id: //depot/Tkutf8/DragDrop/Win32Site/Win32Site.pm#4 $
+$VERSION = '4.004'; # $Id: //depot/Tkutf8/DragDrop/Win32Site/Win32Site.pm#5 $
 
 use Tk qw($XS_VERSION);
 require DynaLoader;
@@ -28,7 +28,7 @@
 
 sub Win32Drop
 {
- print join(',',@_),"\n";
+ # print join(',',@_),"\n";
  my ($w,$site,$msg,$wParam,$lParam) = @_;
  my ($x,$y,@files) = DropInfo($wParam);
  my $cb = $site->{'-dropcommand'};
@@ -36,7 +36,7 @@
   {
    foreach my $file (@files)
     {
-     print "$file @ $x,$y\n";
+     # print "$file @ $x,$y\n";
      $w->clipboardClear;
      $w->clipboardAppend('--',$file);
      $cb->Call('CLIPBOARD',$x,$y);

Index: Event/Event.xs
--- Tk-804.025_beta7/Event/Event.xs	2003-11-20 20:06:52.000000000 +0000
+++ Tk-804.025_beta8/Event/Event.xs	2003-12-07 13:28:21.000000000 +0000
@@ -292,6 +292,7 @@
 char *
 Tcl_Realloc(char *p, unsigned int size)
 {
+ dTHXs;
  if ((int) size < 0)
   abort();
  p = PerlMemShared_realloc(p,size*sizeof(char));
@@ -301,6 +302,7 @@
 char *
 Tcl_Alloc(unsigned int size)
 {
+ dTHXs;
  char *p;
  if ((int) size < 0)
   abort();
@@ -311,6 +313,7 @@
 void
 Tcl_Free(char *p)
 {
+ dTHXs;
  PerlMemShared_free(p);
 }
 

Index: Event/pTkCallback.c
--- Tk-804.025_beta7/Event/pTkCallback.c	2003-11-20 20:09:52.000000000 +0000
+++ Tk-804.025_beta8/Event/pTkCallback.c	2003-12-07 13:28:21.000000000 +0000
@@ -99,6 +99,7 @@
 LangCopyCallback(sv)
 SV *sv;
 {
+ dTHXs;
  if (sv)
   SvREFCNT_inc(sv);
  return sv;

Index: IO/IO.xs
--- Tk-804.025_beta7/IO/IO.xs	2003-11-20 19:39:44.000000000 +0000
+++ Tk-804.025_beta8/IO/IO.xs	2003-12-07 13:28:21.000000000 +0000
@@ -81,9 +81,6 @@
 #if defined(__WIN32__) && !defined(__CYGWIN__)
 static int
 make_nonblock (pTHX_ PerlIO *f,int *mode,int *newmode)
-PerlIO *f;
-int *mode;
-int *newmode;
 {
  croak("Cannot make nonblocking on Win32 yet");
  return -1;

Index: Listbox/Listbox.pm
--- Tk-804.025_beta7/Listbox/Listbox.pm	2003-07-20 18:43:28.000000000 +0100
+++ Tk-804.025_beta8/Listbox/Listbox.pm	2003-12-06 13:38:23.000000000 +0000
@@ -35,8 +35,9 @@
 
 package Tk::Listbox;
 
-use vars qw($VERSION);
-$VERSION = '4.012'; # $Id: //depot/Tkutf8/Listbox/Listbox.pm#12 $
+use vars qw($VERSION @Selection $Prev);
+use strict;
+$VERSION = '4.012'; # $Id: //depot/Tkutf8/Listbox/Listbox.pm#13 $
 
 use Tk qw(Ev $XS_VERSION);
 use Tk::Clipboard ();
@@ -94,7 +95,13 @@
  my ($class,$mw) = @_;
  $class->SUPER::ClassInit($mw);
  # Standard Motif bindings:
- $mw->bind($class,'<1>',['BeginSelect',Ev('index',Ev('@'))]);
+ $mw->bind($class,'<1>',[sub {
+			   my $w = shift;
+			   if (Tk::Exists($w)) {
+			     $w->BeginSelect(@_);
+			   }
+			 }, Ev('index',Ev('@'))]);
+ $mw->bind($class, '<Double-1>' => \&Tk::NoOp);
  $mw->bind($class,'<B1-Motion>',['Motion',Ev('index',Ev('@'))]);
  $mw->bind($class,'<ButtonRelease-1>','ButtonRelease_1');
  ;
@@ -109,23 +116,26 @@
  $mw->bind($class,'<Shift-Down>',['ExtendUpDown',1]);
 
  $mw->XscrollBind($class);
- $mw->bind($class,'<Next>',  sub {
+ $mw->bind($class,'<Prior>', sub {
 	       my $w = shift;
-	       $w->yview('scroll',1,'pages');
+	       $w->yview('scroll',-1,'pages');
 	       $w->activate('@0,0');
 	   });
- $mw->bind($class,'<Prior>', sub {
+ $mw->bind($class,'<Next>',  sub {
 	       my $w = shift;
-	       $w->yview('scroll',-1,'pages');
+	       $w->yview('scroll',1,'pages');
 	       $w->activate('@0,0');
 	   });
- $mw->MouseWheelBind($class);
+ $mw->bind($class,'<Control-Prior>', ['xview', 'scroll', -1, 'pages']);
+ $mw->bind($class,'<Control-Next>',  ['xview', 'scroll',  1, 'pages']);
+ # <Home> and <End> defined in XscrollBind
  $mw->bind($class,'<Control-Home>','Cntrl_Home');
  ;
  $mw->bind($class,'<Shift-Control-Home>',['DataExtend',0]);
  $mw->bind($class,'<Control-End>','Cntrl_End');
  ;
  $mw->bind($class,'<Shift-Control-End>',['DataExtend','end']);
+ # XXX What about <<Copy>>? Already handled in Tk::Clipboard?
  # $class->clipboardOperations($mw,'Copy');
  $mw->bind($class,'<space>',['BeginSelect',Ev('index','active')]);
  $mw->bind($class,'<Select>',['BeginSelect',Ev('index','active')]);
@@ -139,11 +149,13 @@
  $mw->bind($class,'<2>',['scan','mark',Ev('x'),Ev('y')]);
  $mw->bind($class,'<B2-Motion>',['scan','dragto',Ev('x'),Ev('y')]);
 
+ $mw->MouseWheelBind($class); # XXX Both needed?
  $mw->YMouseWheelBind($class);
  return $class;
 }
 
-
+1;
+__END__
 
 sub TIEARRAY {
   my ( $class, $obj, %options ) = @_;
@@ -437,9 +449,6 @@
 
 # ----
 
-1;
-__END__
-
 #
 # Bind --
 # This procedure is invoked the first time the mouse enters a listbox
@@ -475,7 +484,8 @@
  $w->activate(0);
  $w->see(0);
  $w->selectionClear(0,'end');
- $w->selectionSet(0)
+ $w->selectionSet(0);
+ $w->eventGenerate("<<ListboxSelect>>");
 }
 
 
@@ -486,7 +496,8 @@
  $w->activate('end');
  $w->see('end');
  $w->selectionClear(0,'end');
- $w->selectionSet('end')
+ $w->selectionSet('end');
+ $w->eventGenerate("<<ListboxSelect>>");
 }
 
 
@@ -497,6 +508,7 @@
  if ($w->cget('-selectmode') ne 'browse')
  {
  $w->selectionClear(0,'end');
+  $w->eventGenerate("<<ListboxSelect>>");
  }
 }
 
@@ -535,6 +547,7 @@
    $Prev = $el
   }
  $w->focus if ($w->cget('-takefocus'));
+ $w->eventGenerate("<<ListboxSelect>>");
 }
 # Motion --
 #
@@ -553,17 +566,23 @@
   {
    return;
   }
- $anchor = $w->index('anchor');
+ my $anchor = $w->index('anchor');
  my $mode = $w->cget('-selectmode');
  if ($mode eq 'browse')
   {
    $w->selectionClear(0,'end');
    $w->selectionSet($el);
    $Prev = $el;
+   $w->eventGenerate("<<ListboxSelect>>");
   }
  elsif ($mode eq 'extended')
   {
-   $i = $Prev;
+   my $i = $Prev;
+   if (!defined $i || $i eq '')
+    {
+     $i = $el;
+     $w->selectionSet($el);
+    }
    if ($w->selectionIncludes('anchor'))
     {
      $w->selectionClear($i,$el);
@@ -574,13 +593,17 @@
      $w->selectionClear($i,$el);
      $w->selectionClear('anchor',$el)
     }
+   if (!@Selection)
+    {
+     @Selection = $w->curselection;
+    }
    while ($i < $el && $i < $anchor)
     {
      if (Tk::lsearch(\@Selection,$i) >= 0)
       {
        $w->selectionSet($i)
       }
-     $i += 1
+     $i++
     }
    while ($i > $el && $i > $anchor)
     {
@@ -588,9 +611,10 @@
       {
        $w->selectionSet($i)
       }
-     $i += -1
+     $i--
     }
-   $Prev = $el
+   $Prev = $el;
+   $w->eventGenerate("<<ListboxSelect>>");
   }
 }
 # BeginExtend --
@@ -612,6 +636,11 @@
   {
    $w->Motion($el)
   }
+ else
+  {
+   # No selection yet; simulate the begin-select operation.
+   $w->BeginSelect($el);
+  }
 }
 # BeginToggle --
 #
@@ -641,6 +670,7 @@
     {
      $w->selectionSet($el)
     }
+   $w->eventGenerate("<<ListboxSelect>>");
   }
 }
 # AutoScan --
@@ -657,6 +687,7 @@
 sub AutoScan
 {
  my $w = shift;
+ return if !Tk::Exists($w);
  my $x = shift;
  my $y = shift;
  if ($y >= $w->height)
@@ -697,19 +728,21 @@
  my $amount = shift;
  $w->activate($w->index('active')+$amount);
  $w->see('active');
- $LNet__0 = $w->cget('-selectmode');
- if ($LNet__0 eq 'browse')
+ my $mode = $w->cget('-selectmode');
+ if ($mode eq 'browse')
   {
    $w->selectionClear(0,'end');
-   $w->selectionSet('active')
+   $w->selectionSet('active');
+   $w->eventGenerate("<<ListboxSelect>>");
   }
- elsif ($LNet__0 eq 'extended')
+ elsif ($mode eq 'extended')
   {
    $w->selectionClear(0,'end');
    $w->selectionSet('active');
    $w->selectionAnchor('active');
    $Prev = $w->index('active');
    @Selection = ();
+   $w->eventGenerate("<<ListboxSelect>>");
   }
 }
 # ExtendUpDown --
@@ -729,7 +762,13 @@
   {
    return;
   }
- $w->activate($w->index('active')+$amount);
+ my $active = $w->index('active');
+ if (!@Selection)
+  {
+   $w->selectionSet($active);
+   @Selection = $w->curselection;
+  }
+ $w->activate($active + $amount);
  $w->see('active');
  $w->Motion($w->index('active'))
 }
@@ -747,7 +786,7 @@
 {
  my $w = shift;
  my $el = shift;
- $mode = $w->cget('-selectmode');
+ my $mode = $w->cget('-selectmode');
  if ($mode eq 'extended')
   {
    $w->activate($el);
@@ -779,13 +818,11 @@
   {
    return;
   }
- $first = $w->index('anchor');
- $last = $Prev;
+ my $first = $w->index('anchor');
+ my $last = $Prev;
  if ($first > $last)
   {
-   $tmp = $first;
-   $first = $last;
-   $last = $tmp
+   ($first, $last) = ($last, $first);
   }
  $w->selectionClear($first,$last);
  while ($first <= $last)
@@ -794,8 +831,9 @@
     {
      $w->selectionSet($first)
     }
-   $first += 1
+   $first++
   }
+ $w->eventGenerate("<<ListboxSelect>>");
 }
 # SelectAll
 #
@@ -818,8 +856,10 @@
   {
    $w->selectionSet(0,'end')
   }
+ $w->eventGenerate("<<ListboxSelect>>");
 }
 
+# Perl/Tk extensions:
 sub SetList
 {
  my $w = shift;

Index: MANIFEST
--- Tk-804.025_beta7/MANIFEST	2003-11-29 11:38:19.000000000 +0000
+++ Tk-804.025_beta8/MANIFEST	2003-12-07 13:28:21.000000000 +0000
@@ -84,7 +84,6 @@
 demos/demos/images/face
 demos/demos/images/flagdown
 demos/demos/images/flagup
-demos/demos/images/flower2.png
 demos/demos/images/grey.25
 demos/demos/images/grey.5
 demos/demos/images/letters
@@ -105,6 +104,7 @@
 demos/demos/widget_lib/bounce.pl
 demos/demos/widget_lib/button.pl
 demos/demos/widget_lib/check.pl
+demos/demos/widget_lib/choosedir.pl
 demos/demos/widget_lib/clrpick.pl
 demos/demos/widget_lib/colors.pl
 demos/demos/widget_lib/cscroll.pl
@@ -131,6 +131,7 @@
 demos/demos/widget_lib/paned1.pl
 demos/demos/widget_lib/paned2.pl
 demos/demos/widget_lib/photo1.pl
+demos/demos/widget_lib/photo2.pl
 demos/demos/widget_lib/plot.pl
 demos/demos/widget_lib/Plot.pm
 demos/demos/widget_lib/puzzle.pl
@@ -143,6 +144,8 @@
 demos/demos/widget_lib/states.pl
 demos/demos/widget_lib/style.pl
 demos/demos/widget_lib/texts.pl
+demos/demos/widget_lib/trace1.pl
+demos/demos/widget_lib/trace2.pl
 demos/demos/widget_lib/transtile.pl
 demos/demos/widget_lib/twind.pl
 demos/demos/widget_lib/unicodeout.pl
@@ -655,6 +658,7 @@
 PNG/libpng/scripts/makefile.knr
 PNG/libpng/scripts/makefile.linux
 PNG/libpng/scripts/makefile.macosx
+PNG/libpng/scripts/makefile.mingw
 PNG/libpng/scripts/makefile.mips
 PNG/libpng/scripts/makefile.msc
 PNG/libpng/scripts/makefile.ne12bsd

Index: PNG/libpng/scripts/makefile.mingw
--- /dev/null	2003-09-23 18:59:22.000000000 +0100
+++ Tk-804.025_beta8/PNG/libpng/scripts/makefile.mingw	2003-12-07 13:28:21.000000000 +0000
@@ -0,0 +1,75 @@
+# makefile for libpng using gcc (generic, static library)
+# Copyright (C) 2000 Cosmin Truta
+# Copyright (C) 1995 Guy Eric Schalnat, Group 42, Inc.
+# For conditions of distribution and use, see copyright notice in png.h
+
+# Location of the zlib library and include files
+ZLIBINC = ../zlib
+ZLIBLIB = ../zlib
+
+# File extensions
+O=.o
+A=.a
+E=.exe
+
+# Compiler, linker, lib and other tools
+CC = gcc
+LD = $(CC)
+AR = ar rcs
+RANLIB = ranlib
+RM = del /f
+
+CDEBUG = -g -DPNG_DEBUG=5
+LDDEBUG =
+CRELEASE = -O2
+LDRELEASE = -s
+CFLAGS = -I$(ZLIBINC) -Wall $(CRELEASE)
+LDFLAGS = -L. -L$(ZLIBLIB) -lpng -lz -lm $(LDRELEASE)
+
+# Targets
+all: libpng$(A) pngtest$(E)
+
+%.o : %.c 
+	$(CC) -o $@ -c $(CFLAGS) $<
+
+%.exe : %.o 
+	$(LD) -o $@ $(CFLAGS) $< $(LDFLAGS)
+
+oops : $(OBJS)
+
+# Variables
+OBJS = png$(O) pngerror$(O) pngget$(O) pngmem$(O) pngpread$(O) \
+	pngread$(O) pngrio$(O) pngrtran$(O) pngrutil$(O) pngset$(O) \
+	pngtrans$(O) pngwio$(O) pngwrite$(O) pngwtran$(O) pngwutil$(O)
+
+
+libpng$(A): $(OBJS)
+	$(AR) $@ $(OBJS)
+	$(RANLIB) $@
+
+test: pngtest$(E)
+	./pngtest$(E)
+
+pngtest$(E): pngtest$(O) libpng$(A)
+	$(LD) -o $@ pngtest$(O) $(LDFLAGS)
+
+clean:
+	$(RM) $(OBJS) libpng$(A) pngtest$(E) pngout.png
+
+png$(O): png.h pngconf.h
+pngerror$(O): png.h pngconf.h
+pngget$(O): png.h pngconf.h
+pngmem$(O): png.h pngconf.h
+pngpread$(O): png.h pngconf.h
+pngread$(O): png.h pngconf.h
+pngrio$(O): png.h pngconf.h
+pngrtran$(O): png.h pngconf.h
+pngrutil$(O): png.h pngconf.h
+pngset$(O): png.h pngconf.h
+pngtest$(O): png.h pngconf.h
+pngtrans$(O): png.h pngconf.h
+pngwio$(O): png.h pngconf.h
+pngwrite$(O): png.h pngconf.h
+pngwtran$(O): png.h pngconf.h
+pngwutil$(O): png.h pngconf.h
+

Index: Tixish/Balloon.pm
--- Tk-804.025_beta7/Tixish/Balloon.pm	2003-11-02 12:19:43.000000000 +0000
+++ Tk-804.025_beta8/Tixish/Balloon.pm	2003-12-06 14:05:22.000000000 +0000
@@ -15,7 +15,7 @@
 package Tk::Balloon;
 
 use vars qw($VERSION);
-$VERSION = sprintf '4.%03d', q$Revision: #9 $ =~ /\D(\d+)\s*$/;
+$VERSION = sprintf '4.%03d', q$Revision: #10 $ =~ /\D(\d+)\s*$/;
 
 use Tk qw(Ev Exists);
 use Carp;
@@ -72,9 +72,9 @@
     # We give the Label a big borderwidth
     # ..enough to slide a 6x6 gif image along the border including some space
 
-    my $ml = $w->Label(-bd => 10,
-                -padx => 0,
-                -pady => 0,
+    my $ml = $w->Label(-bd => 0,
+                -padx => 10,
+                -pady => 3,
                 -justify => 'left',
                 -relief=>'flat');
     $w->Advertise('message' => $ml);
@@ -409,13 +409,15 @@
     my $yy=undef; # to hold final toplevel placement
     my $slideOffsetX = 0;
     my $slideOffsetY = 0;
-    my $testtop = $y - $height;
-    my $testbottom = $y + $height;
-    my $testright = $x + $width;
-    my $testleft = $x - $width;
+    my $cornerOffset = 5; #default - keep corner away from pointer
+    my $testtop = $y - $height - $cornerOffset;
+    my $testbottom = $y + $height + (2*$cornerOffset);
+    my $testright = $x + $width + (2*$cornerOffset);
+    my $testleft = $x - $width - $cornerOffset;
     my $vert='bottom'; #default
     my $horiz='right'; #default
 
+
     if ( defined $w->{'location'} ){
       # Once balloon is activated, **don't** change the location of the balloon.
       # It is annoying to have it jump from one location to another.
@@ -478,7 +480,7 @@
     $w->{'location'} = $vert.$horiz unless (defined $w->{'location'});
 
     if ($w->{'location'} eq 'bottomright') {
-        if ($slideOffsetX and $slideOffsetY) {
+        if ( $slideOffsetX or $slideOffsetY ) {
             $w->{'pointer'}->configure(-image => $w->{img_no});
         }
         else {
@@ -487,18 +489,19 @@
 
         $w->{'pointer'}->place(
             -in=>$w,
-            -relx=>0, -x=>$slideOffsetX + 2,
-            -rely=>0, -y=>$slideOffsetY + 2,
+#            -relx=>0, -x=>$slideOffsetX + 2,
+#            -rely=>0, -y=>$slideOffsetY + 2,
+            -relx=>0, -x=>2,
+            -rely=>0, -y=>2,
             -bordermode=>'outside',
             -anchor=>'nw');
-        # Keep corner away from pointer.
-        # It is okay if it goes offscreen a little, because of our 10 pixel borderwidth
-        $xx=$x-$slideOffsetX+10 unless (defined $xx);
-        $yy=$y-$slideOffsetY+10 unless (defined $yy);
+
+        $xx=$x-$slideOffsetX+(2*$cornerOffset) unless (defined $xx);
+        $yy=$y-$slideOffsetY+(2*$cornerOffset) unless (defined $yy);
 
     }
     elsif ($w->{'location'} eq 'bottomleft') {
-        if ($slideOffsetX and $slideOffsetY) {
+        if ( $slideOffsetX or $slideOffsetY ) {
             $w->{'pointer'}->configure(-image => $w->{img_no});
         }
         else {
@@ -506,16 +509,19 @@
         }
 
         $w->{'pointer'}->place(-in=>$w,
-            -relx=>1, -x=>$slideOffsetX - 2,
-            -rely=>0, -y=>$slideOffsetY + 2,
+#            -relx=>1, -x=>$slideOffsetX - 2,
+#            -rely=>0, -y=>$slideOffsetY + 2,
+            -relx=>1, -x=>-2,
+            -rely=>0, -y=>2,
             -bordermode=>'outside',
             -anchor=>'ne');
-        $xx=$x-$width-$slideOffsetX-5 unless (defined $xx);
-        $yy=$y-$slideOffsetY+10 unless (defined $yy);
+
+        $xx=$x-$width-$slideOffsetX-$cornerOffset unless (defined $xx);
+        $yy=$y-$slideOffsetY+(2*$cornerOffset) unless (defined $yy);
 
     }
     elsif ($w->{'location'} eq 'topright') {
-        if ($slideOffsetX and $slideOffsetY) {
+        if ( $slideOffsetX or $slideOffsetY ) {
             $w->{'pointer'}->configure(-image => $w->{img_no});
         }
         else {
@@ -523,15 +529,18 @@
         }
 
         $w->{'pointer'}->place(-in=>$w,
-            -relx=>0, -x=>$slideOffsetX + 2,
-            -rely=>1, -y=>$slideOffsetY - 2,
+#            -relx=>0, -x=>$slideOffsetX + 2,
+#            -rely=>1, -y=>$slideOffsetY - 2,
+            -relx=>0, -x=>2,
+            -rely=>1, -y=>-2,
             -bordermode=>'outside',
             -anchor=>'sw');
-        $xx=$x-$slideOffsetX+5 unless (defined $xx);
-        $yy=$y-$height-$slideOffsetY-5 unless (defined $yy);
+
+        $xx=$x-$slideOffsetX+$cornerOffset unless (defined $xx);
+        $yy=$y-$height-$slideOffsetY-$cornerOffset unless (defined $yy);
     }
     elsif ($w->{'location'} eq 'topleft') {
-        if ($slideOffsetX and $slideOffsetY) {
+        if ( $slideOffsetX or $slideOffsetY ) {
             $w->{'pointer'}->configure(-image => $w->{img_no});
         }
         else {
@@ -539,12 +548,15 @@
         }
 
         $w->{'pointer'}->place(-in=>$w,
-            -relx=>1, -x=>$slideOffsetX - 2,
-            -rely=>1, -y=>$slideOffsetY - 2,
+#            -relx=>1, -x=>$slideOffsetX - 2,
+#            -rely=>1, -y=>$slideOffsetY - 2,
+            -relx=>1, -x=>-2,
+            -rely=>1, -y=>-2,
             -bordermode=>'outside',
             -anchor=>'se');
-        $xx=$x-$width-$slideOffsetX-5 unless (defined $xx);
-        $yy=$y-$height-$slideOffsetY-5 unless (defined $yy);
+
+        $xx=$x-$width-$slideOffsetX-$cornerOffset unless (defined $xx);
+        $yy=$y-$height-$slideOffsetY-$cornerOffset unless (defined $yy);
     }
 
     $w->{'pointer'}->raise;

Index: Tixish/DirTree.pm
--- Tk-804.025_beta7/Tixish/DirTree.pm	2003-07-20 18:43:28.000000000 +0100
+++ Tk-804.025_beta8/Tixish/DirTree.pm	2003-12-06 13:38:23.000000000 +0000
@@ -6,7 +6,7 @@
 # Chris Dean <ctdean@cogit.com>
 
 use vars qw($VERSION);
-$VERSION = '4.009'; # $Id: //depot/Tkutf8/Tixish/DirTree.pm#9 $
+$VERSION = '4.009'; # $Id: //depot/Tkutf8/Tixish/DirTree.pm#10 $
 
 use Tk;
 use Tk::Derived;
@@ -158,6 +158,81 @@
     return( @names );
 }
 
+{
+    package Tk::DirTreeDialog;
+    use base qw(Tk::Toplevel);
+    Construct Tk::Widget 'DirTreeDialog';
+
+    sub Populate {
+	my($w, $args) = @_;
+	$w->{curr_dir} = $args->{-initialdir};
+	if (!defined $w->{curr_dir}) {
+	    require Cwd;
+	    $w->{curr_dir} = Cwd::cwd();
+	}
+	if (defined $args->{-mustexist}) {
+	    die "-mustexist is not yet implemented";
+	}
+	my $title = $args->{-title} || "Choose directory:";
+	delete $args->{-popover};
+
+	$w->title($title);
+	$w->{ok} = 0; # flag: "1" means OK, "-1" means cancelled
+
+	# Create Frame widget before the DirTree widget, so it's always visible
+	# if the window gets resized.
+	my $f = $w->Frame->pack(-fill => "x", -side => "bottom");
+
+	my $d;
+	$d = $f->Scrolled('DirTree',
+			  -scrollbars => 'osoe',
+			  -width => 35,
+			  -height => 20,
+			  -selectmode => 'browse',
+			  -exportselection => 1,
+			  -browsecmd => sub {
+			      $w->{curr_dir} = shift;
+			      if ($^O ne 'MSWin32') {
+				  $w->{curr_dir} =~ s|^//|/|; # bugfix
+			      }
+			  },
+
+			  # With this version of -command a double-click will
+			  # select the directory
+			  -command   => sub { $w->{ok} = 1 },
+
+			  # With this version of -command a double-click will
+			  # open a directory. Selection is only possible with
+			  # the Ok button.
+			  #-command   => sub { $d->opencmd($_[0]) },
+			 )->pack(-fill => "both", -expand => 1);
+	# Set the initial directory
+	exists &Tk::DirTree::chdir ? $d->chdir($w->{curr_dir}) : $d->set_dir($w->{curr_dir});
+
+	$f->Button(-text => 'Ok',
+		   -command => sub { $w->{ok} =  1 })->pack(-side => 'left');
+	$f->Button(-text => 'Cancel',
+		   -command => sub { $w->{ok} = -1 })->pack(-side => 'left');
+	$w->OnDestroy(sub { $w->{ok} = -1 });
+    }
+
+    sub Show {
+	my $w = shift;
+	my $old_focus = $w->focusSave;
+	my $old_grab = $w->grabSave;
+	Tk::catch {
+	    $w->grab;
+	};
+	$w->waitVariable(\$w->{ok});
+	my $ret = $w->{ok} == 1 ? $w->{curr_dir} : undef;
+	$w->grabRelease if Tk::Exists($w);
+	&$old_focus;
+	&$old_grab;
+	$w->destroy if Tk::Exists($w);
+	$ret;
+    }
+}
+
 __END__
 
 #  Copyright (c) 1996, Expert Interface Technologies

Index: Tixish/NoteBook.pm
--- Tk-804.025_beta7/Tixish/NoteBook.pm	2003-07-20 18:43:28.000000000 +0100
+++ Tk-804.025_beta8/Tixish/NoteBook.pm	2003-12-06 13:23:23.000000000 +0000
@@ -9,7 +9,7 @@
 
 use vars qw($VERSION);
 
-$VERSION = '4.007'; # $Id: //depot/Tkutf8/Tixish/NoteBook.pm#7 $
+$VERSION = '4.007'; # $Id: //depot/Tkutf8/Tixish/NoteBook.pm#8 $
 require Tk::NBFrame;
 
 use base  qw(Tk::Derived Tk::NBFrame);
@@ -357,7 +357,6 @@
 
 sub LostSlave {
     my ($w, $s) = @_;
-    print "Loosing $s\n";
     $s->UnmapWindow;
 }
 

Index: Tk.pm
--- Tk-804.025_beta7/Tk.pm	2003-11-02 19:12:22.000000000 +0000
+++ Tk-804.025_beta8/Tk.pm	2003-12-06 13:38:23.000000000 +0000
@@ -61,7 +61,7 @@
 use Carp;
 
 # Record author's perforce depot record
-$Tk::CHANGE      = q$Change: 2982 $;
+$Tk::CHANGE      = q$Change: 3011 $;
 
 # $tk_version and $tk_patchLevel are reset by pTk when a mainwindow
 # is created, $VERSION is checked by bootstrap
@@ -252,6 +252,9 @@
                tk_getOpenFile => 'FDialog',
                tk_getSaveFile => 'FDialog',
                tk_chooseDirectory => 'FDialog'
+# Slaven claims NI-S's version above does not work
+# and provides this
+#              tk_chooseDirectory => 'DirDialog'
              );
 
 foreach my $dialog (keys %dialog)
@@ -382,6 +385,12 @@
  DialogWrapper('FBox', $cmd, @_);
 }
 
+sub DirDialog
+{
+ require Tk::DirTree;
+ DialogWrapper('DirTreeDialog',@_);
+}
+
 *MotifFDialog = \&FDialog;
 
 *CORE::GLOBAL::exit = \&exit;

Index: Tk/ProgressBar.pm
--- Tk-804.025_beta7/Tk/ProgressBar.pm	2003-08-24 09:50:05.000000000 +0100
+++ Tk-804.025_beta8/Tk/ProgressBar.pm	2003-12-06 13:38:23.000000000 +0000
@@ -1,7 +1,7 @@
 package Tk::ProgressBar;
 
 use vars qw($VERSION);
-$VERSION = '4.008'; # $Id: //depot/Tkutf8/Tk/ProgressBar.pm#8 $
+$VERSION = '4.008'; # $Id: //depot/Tkutf8/Tk/ProgressBar.pm#9 $
 
 use Tk;
 use Tk::Canvas;
@@ -86,7 +86,7 @@
     my $from = $c->{Configure}{'-from'};
     my $to   = $c->{Configure}{'-to'};
     my $horz = $c->{Configure}{'-anchor'} =~ /[ew]/i ? 1 : 0;
-    my $dir  = $c->{Configure}{'-anchor'} =~ /[ne]/i ? -1 : 1;
+    my $dir  = $c->{Configure}{'-anchor'} =~ /[se]/i ? -1 : 1;
 
     my($minv,$maxv) = $from < $to ? ($from,$to) : ($to,$from);
 

Index: Tk/Wm.pm
--- Tk-804.025_beta7/Tk/Wm.pm	2003-08-24 09:50:05.000000000 +0100
+++ Tk-804.025_beta8/Tk/Wm.pm	2003-12-06 13:38:23.000000000 +0000
@@ -14,7 +14,7 @@
 
 
 use vars qw($VERSION);
-$VERSION = '4.012'; # $Id: //depot/Tkutf8/Tk/Wm.pm#12 $
+$VERSION = '4.012'; # $Id: //depot/Tkutf8/Tk/Wm.pm#13 $
 
 use Tk::Submethods;
 
@@ -127,6 +127,8 @@
  my ($X,$Y) = AnchorAdjust($w->cget('-overanchor'),$rx,$ry,$rw,$rh);
  ($X,$Y)    = AnchorAdjust($w->cget('-popanchor'),$X,$Y,-$mw,-$mh);
  # adjust to not cross screen borders
+ if ($X < 0) { $X = 0 }
+ if ($Y < 0) { $Y = 0 }
  if ($mw > $w->screenwidth)  { $X = 0 }
  if ($mh > $w->screenheight) { $Y = 0 }
  $w->Post($X,$Y);

Index: demos/demos/widget_lib/choosedir.pl
--- /dev/null	2003-09-23 18:59:22.000000000 +0100
+++ Tk-804.025_beta8/demos/demos/widget_lib/choosedir.pl	2003-12-06 13:18:27.000000000 +0000
@@ -0,0 +1,39 @@
+# This demonstration script prompts the user to select a directory.
+
+use vars qw/$TOP/;
+
+sub choosedir {
+    my $demo = shift;
+
+    $TOP = $MW->WidgetDemo
+      (
+       -name     => $demo,
+       -text     => "Enter a directory name in the entry box or click on the \"Browse\" buttons to select a directory name using the directory selection dialog.",
+       -title    => 'Choose Directory Demonstration',
+       -iconname => 'choosedir',
+      );
+    {
+	my $f = $TOP->Frame;
+	my $lab = $f->Label(-text => "Select a directory to open: ",
+			    -anchor => 'e');
+	my $ent = $f->Entry(-width => 20);
+	my $but = $f->Button(-text => "Browse ...",
+			     -command => sub { dirDialog($TOP, $ent)});
+	$lab->pack(-side => 'left');
+	$ent->pack(-side => 'left',-expand => 'yes', -fill => 'x');
+	$but->pack(-side => 'left');
+	$f->pack(-fill => 'x', -padx => '1c', -pady => 3);
+    }
+}
+
+sub dirDialog {
+    my $w = shift;
+    my $ent = shift;
+    my $dir;
+    $dir = $w->chooseDirectory;
+    if (defined $dir and $dir ne '') {
+	$ent->delete(0, 'end');
+	$ent->insert(0, $dir);
+	$ent->xview('end');
+    }
+}

Index: demos/demos/widget_lib/photo1.pl
--- Tk-804.025_beta7/demos/demos/widget_lib/photo1.pl	2003-11-09 18:17:42.000000000 +0000
+++ Tk-804.025_beta8/demos/demos/widget_lib/photo1.pl	2003-12-06 13:39:21.000000000 +0000
@@ -1,23 +1,21 @@
-# Transparent Photo pixels
+# photo1.pl
 
 use vars qw/$TOP/;
 
-use Tk::PNG;
-
 sub photo1 {
 
     my($demo) = @_;
 
     $TOP = $MW->WidgetDemo(
         -name             => $demo,
-        -text             => 'This demonstration displays a picture of a flower on a green background for two seconds, the proceeeds to make a 50 x 50 pixel rectangular area transparent so that the green background shows through.',
-        -title            => 'Photo Transparency',
+        -text             => 'This demonstration displays, for two seconds, a picture of a teapot over a green background, then proceeeds to render transparent a 50 x 50 pixel area of the teapot so that the green background shows through.',
+        -title            => 'Transparent Pixels',
         -iconname         => 'photo1',
     );
 
-    my $l = $TOP->Label( qw/ -background green -width 500 -height 350 / )->pack;
+    my $l = $TOP->Label( qw/ -background green -width 300 -height 300 / )->pack;
 
-    my $f1 = $TOP->Photo( -file => Tk->findINC('demos/images') . '/flower2.png' );
+    my $f1 = $TOP->Photo( -file => Tk->findINC( 'demos/images/teapot.ppm' ) );
     $l->configure( -image => $f1 );
     $TOP->idletasks;
     $TOP->after(2000);

Index: demos/demos/widget_lib/photo2.pl
--- /dev/null	2003-09-23 18:59:22.000000000 +0100
+++ Tk-804.025_beta8/demos/demos/widget_lib/photo2.pl	2003-12-06 13:39:21.000000000 +0000
@@ -0,0 +1,156 @@
+# photo2.pl
+
+use vars qw/ $TOP $photo2_use_bg /;
+use strict;
+
+sub photo2 {
+
+    my( $demo ) = @_;
+
+    my $alpha;			# transparency
+    my( $dx, $dy ) = ( 0, 0 );	# delta offsets
+    my $svar = 100;		# Scale variable
+    $photo2_use_bg = 0;         # nz IFF a green background
+
+    $TOP = $MW->WidgetDemo(
+        -name             => $demo,
+        -text             => [ "This demonstration illustrates compositing.  Commonly, each pixel of a color image is represented by three color components, red, green and blue, each specifiying a relative percentage of the color \"white\", such that, when the components are combined, they produce a visible color. Here are a few samples of 8-bit RGB triplets and the visible colors they produce:\n
+(255, 255, 255) = white   (000, 000, 000) = black\n(255, 000, 000) = red      (000, 255, 000) = green   (000, 000, 255) = blue\n\nAn additional transparency factor can be supplied that describes the importance of each pixel's RGB components when composited over another image. This transparency channel is called the Alpha channel.  Although the Alpha channel is said to contain transparency information, in fact, it actually contains opacity information.\n\nIt is still possible to think in terms of transparency, although in this case the transparency is applied to the background image over which the current image is composited. The composited color is computed as:\n\n (image_RGB_component * alpha) + (background_RGB_component * (1.0 - alpha))", -wraplength => 640 ],
+        -title            => 'Alpha Channel Compositing',
+        -iconname         => 'photo2',
+    );
+
+    my $mw = $TOP;
+    my $i1 = $mw->Photo( -file => Tk->findINC( 'demos/images/earth.gif' ) ); 
+    my $i2 = $mw->Photo( -file => Tk->findINC( 'demos/images/earthris.gif' ) ); 
+    my $i3 = $mw->Photo( qw/ -format png -width 320 -height 200 / );
+
+    my $tf = $mw->Frame;
+    $tf->Label( -image => $i2 )->pack( qw/ -side left / );
+    $tf->Label( -image => $i1 )->pack( qw/ -side left / );
+
+    my $bf = $mw->Frame;
+    my $controls = $bf->Frame;
+    my $results  = $bf->Frame;
+
+    $controls->pack( qw/ -side left -fill both -expand 1/ ) ;
+    $results->pack( qw/ -side right/ );
+
+    $controls->Label(
+        -font       => '9x15',
+        -foreground => 'blue',
+        -text       => 'Left Image Options',
+    )->pack;
+    my $s = $controls->Scale(
+        qw/
+        -from            100.0
+        -resolution      10.0
+        -tickinterval    10.0
+        -to              0.0
+        /,
+        -label        => '% Opacity',
+        -variable     => \$svar,
+    );
+    $svar = 80;
+
+    my $spacer = $controls->Frame( qw/ -borderwidth 2 -relief solid -width 5/ );
+
+    my $rt = $controls->Label( -text => 'Background' );
+    my $r = $controls->Frame;
+    my $r1 = $r->Radiobutton(
+        -anchor   => 'w',
+        -text     => 'Right Image',
+        -value    => 0,
+        -variable => \$photo2_use_bg,
+        -width    => 20,
+    );
+    my $r2 = $r->Radiobutton(
+        -anchor   => 'w',
+        -text     => 'The Color Green',
+        -value    => 1,
+        -variable => \$photo2_use_bg,
+        -width    => 20,
+    );
+    $r2->pack( qw/ -side bottom/ );
+    $r1->pack( qw/ -side bottom/ );
+
+    my $b = $controls->Button(
+        -command => [ \&photo2_blend, $i1, $i2, $i3, $dx, $dy, \$svar ],
+        -text    => 'Composite    ==>>',
+    );
+
+    my $l = $results->Label( -image => $i3 );
+
+    $tf->pack;
+    $bf->pack( qw/-fill both -expand 1/ ) ;
+    $b->pack( qw/ -side bottom -fill x/ );
+    $s->pack( qw/ -side left -fill both -expand 1 / );
+    $spacer->pack( qw/ -side left -fill y -expand 1 / );
+    $rt->pack( qw/ -side top / );
+    $r->pack( qw/ -side right / );
+    $l->pack( qw/ -side right / );
+
+} # end photo2
+
+sub photo2_blend {
+
+    my( $img1, $img2, $img3, $dx, $dy, $svar_ref ) = @_;
+
+    my $a2 = $$svar_ref / 100.0;
+    my $a1 = 1.0 - $a2;
+
+    my $width1  = $img1->width;
+    my $height1 = $img1->height;
+    my $width2  = $img2->width;
+    my $height2 = $img2->height;
+
+    $img3->blank;
+
+    my $x1 = $dx;
+    my $x2 = 0;
+
+    for ( my $i = 0; $i < $width1;  $i++ ) {
+	last if $i > $width2;
+	my $y1 = $dy;
+	my $y2 = 0;
+
+	for ( my $j = 0; $j < $height1; $j++ ) {
+	    last if $j > $height2;
+
+	    # Skip if no pixel at this coordinate or if transparent. Else,
+	    # combine the proper percentage of each color component and
+	    # put the pixel into the third image.
+
+	    Tk::catch {
+		if ( not $img2->transparencyGet( $x2, $y2 ) ) {
+
+		    my ( @c1 ) = $img1->get( $x1, $y1 );
+		    my ( @c2 ) = $img2->get( $x2, $y2 );
+
+		    # You can use a colored background rather than another
+		    # image to test alpha channels.  Uncomment this line to
+		    # ignore the first image and force a green backround.
+		    @c1 = ( 0, 255, 0 ) if $photo2_use_bg;
+
+		    foreach my $c ( 0 .. 2 ) {
+			$c1[$c] = $c1[$c] * $a1 + $c2[$c] * $a2;
+		    }
+		    
+		    my $color = sprintf( "#%02x%02x%02x", @c1[0 .. 2] );
+		    $img3->put( $color, -to => $x1, $y1 );
+
+		} # ifend
+	    }; # catchend
+
+	    $y1++;
+	    $y2++;
+
+	} # forend $j
+
+	$img3->update;
+	$x1++;
+	$x2++;
+
+    } # forend $i
+
+} # end photo2_blend

Index: demos/demos/widget_lib/trace1.pl
--- /dev/null	2003-09-23 18:59:22.000000000 +0100
+++ Tk-804.025_beta8/demos/demos/widget_lib/trace1.pl	2003-12-06 13:39:21.000000000 +0000
@@ -0,0 +1,49 @@
+# trace1.pl
+
+use Tk::widgets qw/  Trace /;
+use vars qw/ $TOP /;
+use strict;
+
+sub trace1 {
+
+    my( $demo ) = @_;
+
+    $TOP = $MW->WidgetDemo(
+        -name             => $demo,
+        -text             => "This demonstration animates an analog display as you move the Scale's slider.",
+        -title            => 'Move a meter tied to a variable',
+        -iconname         => 'trace1',
+    );
+
+    my $mw = $TOP;
+    my $v;			# variable to trace
+
+    my $c = $mw->Canvas(qw/-width 200 -height 110 -bd 2 -relief sunken/)->grid;
+    $c->createLine(qw/ 100 100 10 100  -tag meter -arrow last -width 5/);
+    my $s = $mw->Scale(qw/-orient h -from 0 -to 100 -variable/ => \$v)->grid;
+    $mw->Label(-text => 'Slide Me')->grid;
+
+    # Trace $v when written.  The callback is supplied three explicit arguments:
+    # the index if an array or hash, else undef, the proposed new value, and the
+    # trace operation (rwu) for read, write, undef, respectively. Additionally,
+    # we pass the Canvas and Scale widget references.
+
+    $mw->traceVariable(\$v, 'w' => [\&trace1_update_meter, $c, $s]);
+
+} # end trace1
+
+sub trace1_update_meter {
+
+    my( $index, $value, $op, $c, $s ) = @_;
+
+    return if $op eq 'u';
+
+    my($min, $max) = ($s->cget(-from), $s->cget(-to));
+    my $pos = $value / abs($max - $min);
+    my $pi = 3.1415926;
+    my $x = 100.0 - 90.0 * (cos( $pos * $pi ));
+    my $y = 100.0 - 90.0 * (sin( $pos * $pi ));
+    $c->coords(qw/meter 100 100/, $x, $y);
+    return $value;
+
+ } # end trace1_update_meter

Index: demos/demos/widget_lib/trace2.pl
--- /dev/null	2003-09-23 18:59:22.000000000 +0100
+++ Tk-804.025_beta8/demos/demos/widget_lib/trace2.pl	2003-12-06 13:39:21.000000000 +0000
@@ -0,0 +1,187 @@
+# trace2.pl
+
+$Tk::TraceText::VERSION = '1.0';
+
+package Tk::TraceText;
+
+use base qw/ Tk::Derived Tk::Text /;
+use strict;
+
+Construct Tk::Widget 'TraceText';
+
+sub Populate {
+
+    my( $self, $args ) = @_;
+
+    $self->SUPER::Populate( $args );
+
+    $self->ConfigSpecs(
+        -textvariable => [ 'METHOD', 'textVariable', 'TextVariable', undef ],
+    );
+
+    $self->OnDestroy( sub {
+	my $vref = $self->{_vref};
+	$self->traceVdelete ( $self->{_vref} ) if defined $vref;
+    } );
+
+} # end Populate
+
+# Private methods.
+
+sub insdel {
+
+    my( $self, $sub, @args ) = @_;
+    
+    $self->{_busy} = 1;
+    $self->$sub( @args );
+    my $vref = $self->{_vref};
+    $$vref = $self->get( qw/1.0 end/ );
+    $self->{_busy} = 0;
+
+} # end insedel
+
+sub textvariable {
+
+    my ( $self, $vref ) = @_;
+
+    $self->traceVariable( $vref, 'w', [ \&tracew => $self, $vref ] );
+    $self->{_vref} = $vref;
+    
+} # end textvariable
+
+sub tracew {
+
+    my ( $index, $value, $op, $self, $vref ) = @_;
+
+    return unless defined $self;	# if app is being destroyed
+    return if $self->{_busy};
+
+    if ( $op eq 'w' ) {
+	$self->delete( qw/1.0 end/ );
+	$self->insert( '1.0', $value );
+    } elsif ( $op eq 'r' ) {
+    } elsif ( $op eq 'u' ) {
+	$self->traceVdelete ( $vref );
+    }
+
+} # end tracew
+
+# Overridden methods.
+
+sub delete {
+
+    my ( $self, @args ) = @_;
+
+    $self->insdel( 'SUPER::delete', @args )
+
+} # end delete
+
+sub insert {
+
+    my ( $self, @args ) = @_;
+
+    $self->insdel( 'SUPER::insert', @args );
+
+} # end insert
+
+1;
+
+package main;
+
+use Tk::widgets qw/ Trace /;
+use vars qw / $TOP /;
+use strict;
+
+sub trace2 {
+
+    my( $demo ) = @_;
+
+    $TOP = $MW->WidgetDemo(
+        -name             => $demo,
+        -text             => "This demonstration derives a new Text widget whose contents are modified using a normal Perl variable.",
+        -title            => 'Contents of a Text idget tied to a variable',
+        -iconname         => 'trace2',
+    );
+
+    my $mw = $TOP;
+    my $tt = $mw->Scrolled( 'TraceText', -textvariable => \my $frog )->grid;
+    $tt->focus;
+
+    $mw->traceVariable( \$frog, 'wu', [ \&trace2_tracefrog, $mw, \$frog ] );
+
+    $frog = "Frogs lacking lipophores are blue.";
+
+} # end trace2
+
+sub trace2_tracefrog {
+
+    my( $index, $value, $op ) = @_;
+
+    print "Final " if $op eq 'u';
+    print "User trace: $value";
+    return $value;
+
+}
+
+__END__
+
+=head1 NAME
+
+Tk::TraceText - Text contents defined by a traced variable.
+
+=for pm Tk/TraceText.pm
+
+=for category Text
+
+=head1 SYNOPSIS
+
+ $tt = $parent->TraceText(-option => value, ... );
+
+=head1 DESCRIPTION
+
+Create a new B<TraceText> widget that is derived from the standard B<Text>
+widget. Because it inherits all the base options and methods it behaves
+just like a B<Text> widget.  Additionally, B<TraceText> adds a -textvariable
+option, which is a reference to a Perl scalar that defines the contents of
+the widget.
+
+Based on the Tcl/Tk TracedText "overridden widget" by Kevin Kenny.
+
+=over 4
+
+=item B<-textvariable>
+
+A scalar reference.  The value of the variable defines the contents of the
+TraceText widget.  Using the keyboard to insert or delete text changes the 
+value of the variable, and changing the variable alters the contents of the
+TraceText widget.
+
+=back
+
+=head1 METHODS
+
+Standard Text widget methods.
+
+=head1 ADVERTISED SUBWIDGETS
+
+None.
+
+=head1 EXAMPLE
+
+ $thumb = $mw->TraceText( -textvariabel => \$scalar );
+
+=head1 AUTHOR
+
+Stephen.O.Lidie@Lehigh.EDU
+
+Copyright (C) 2003 - 2004, Steve Lidie. All rights reserved.
+
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=head1 KEYWORDS
+
+text, trace
+
+=cut
+

Index: demos/widget
--- Tk-804.025_beta7/demos/widget	2003-11-09 17:47:09.000000000 +0000
+++ Tk-804.025_beta8/demos/widget	2003-12-06 13:39:31.000000000 +0000
@@ -198,7 +198,8 @@
 );
 
 demos 'Photos and Images', (
-    'photo1'     => 'Transparent Photo pixels',
+    'photo1'     => 'Transparent pixels',
+    'photo2'     => 'Alpha channel compositing',
 );
 
 demos 'Menus', (
@@ -210,6 +211,7 @@
 demos 'Common Dialogs', (
     'msgBox'     => 'Message boxes',
     'filebox'    => 'File selection dialog',
+    'choosedir'  => 'Directory selection dialog',
     'clrpick'    => 'Color picker',
 );
 
@@ -217,10 +219,15 @@
     'bounce'     => 'Balls bouncing in a cavity',
 );
 
+demos 'Pure Perl Mega-Widgets', (
+    'trace2'     => 'Derived Tk::TraceText - Text contents defined by a traced variable',
+);
+
 demos 'Miscellaneous', (
     'bitmaps'    => 'The built-in bitmaps',
     'dialog1'    => 'A dialog box with a local grab',
     'dialog2'    => 'A dialog box with a global grab',
+    'trace1'     => 'Trace a variable\'s value',
 );
 
 $T->insert('end', "\n", '', "User Contributed Demonstrations\n", 'title');
@@ -251,7 +258,7 @@
     -default_button => 'OK',
     -buttons        => ['OK'],
     -text           => "         widget\n\nPerl Version $]" .
-		       "\nTk Version $Tk::VERSION\n\n      2003/11/07",
+		       "\nTk Version $Tk::VERSION\n\n      2004/01/02",
 );
 $help->cget(-menu)->entryconfigure('About',
     -command => [$DIALOG_ABOUT => 'Show'],
@@ -336,7 +343,8 @@
 
     my($demo) = @_;
 
-    my $file = "${demo}.pl";
+    my $file;
+    $file = ( $demo =~ /\.pl$/ ) ? $demo : "${demo}.pl";
     if (not Exists $CODE) {
 	$CODE = $MW->Toplevel;
 	my $code_buttons = $CODE->Frame;
@@ -363,8 +371,8 @@
 	}
     });
     $CODE->iconname($file);
-    $file = "$WIDTRIB/${demo}.pl" if -f "$WIDTRIB/${demo}.pl";
-    $file = "$widget_lib/${demo}.pl" if -f "$widget_lib/${demo}.pl";
+    $file = "$WIDTRIB/$file" if -f "$WIDTRIB/$file";
+    $file = "$widget_lib/$file" if -f "$widget_lib/$file";
     $CODE->title("Demo code: $file");
     $CODE_TEXT->delete(qw/1.0 end/);
     open(CODE, "<$file") or warn "Cannot open demo file $file: $!";

Index: pTk/mTk/unix/tkUnixWm.c
--- Tk-804.025_beta7/pTk/mTk/unix/tkUnixWm.c	2003-07-27 17:30:57.000000000 +0100
+++ Tk-804.025_beta8/pTk/mTk/unix/tkUnixWm.c	2003-12-06 13:57:37.000000000 +0000
@@ -5480,7 +5480,7 @@
 	    Tcl_Preserve((ClientData) protPtr);
             interp = protPtr->interp;
             Tcl_Preserve((ClientData) interp);
-	    result = LangDoCallback(protPtr->interp, protPtr->command, 0, 0);
+	    result = LangDoCallback(protPtr->interp, protPtr->command, 0, 1, "%ld", eventPtr->xclient.data.l[1]);
 	    if (result != TCL_OK) {
 		Tcl_AddErrorInfo(interp, "\n    (command for \"");
 		Tcl_AddErrorInfo(interp, protocolName);

Index: pTk/mTk/win/tkWinWm.c
--- Tk-804.025_beta7/pTk/mTk/win/tkWinWm.c	2003-11-02 09:36:58.000000000 +0000
+++ Tk-804.025_beta8/pTk/mTk/win/tkWinWm.c	2003-12-06 13:57:39.000000000 +0000
@@ -5674,7 +5674,7 @@
 	    Tcl_Preserve((ClientData) protPtr);
             interp = protPtr->interp;
             Tcl_Preserve((ClientData) interp);
-	    result = LangDoCallback(protPtr->interp, protPtr->command, 0, 0);
+	    result = LangDoCallback(protPtr->interp, protPtr->command, 0, 1, "%ld", eventPtr->xclient.data.l[1]);
 	    if (result != TCL_OK) {
 		Tcl_AddErrorInfo(interp, "\n    (command for \"");
 		Tcl_AddErrorInfo(interp, name);

Index: t/dialogbox.t
--- Tk-804.025_beta7/t/dialogbox.t	2003-11-29 11:36:51.000000000 +0000
+++ Tk-804.025_beta8/t/dialogbox.t	2003-12-07 13:28:21.000000000 +0000
@@ -14,7 +14,7 @@
 ok($@, "", "loading Tk::DialogBox module");
 
 my $top = new MainWindow;
-$top->withdraw;
+$top->withdraw unless $^O eq 'MSWin32';
 eval { $top->geometry('+10+10'); };  # This works for mwm and interactivePlacement
 
 {

Index: tkGlue.def
--- Tk-804.025_beta7/tkGlue.def	2003-11-20 19:57:43.000000000 +0000
+++ Tk-804.025_beta8/tkGlue.def	2003-12-07 13:28:21.000000000 +0000
@@ -23,12 +23,16 @@
 #endif
 
 #ifndef dTHX
-#define dTHX dTHR
+#define dTHR int maybeTHR
 #endif
 
-#ifndef dTHR
+#ifndef dTHXs
+#ifdef PERL_IMPLICIT_SYS
+#define dTHXs dTHX
+#else
 #define dTHR int maybeTHR
 #endif
+#endif
 
 #ifndef ERRSV
 #define ERRSV GvSV(errgv)
__END_OF_PATCH__