# strip everything before this
# cd to your version of Tk-804.025_beta6
# and feed this file to /bin/sh
#
#
touch t/dialogbox.t
chmod 0444 t/dialogbox.t
patch -p1 -N <<'__END_OF_PATCH__'

Index: Canvas/Canvas.xs
--- Tk-804.025_beta6/Canvas/Canvas.xs	2003-07-20 17:50:54.000000000 +0100
+++ Tk-804.025_beta7/Canvas/Canvas.xs	2003-11-20 19:29:12.000000000 +0000
@@ -3,7 +3,7 @@
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */
-
+#define PERL_NO_GET_CONTEXT
 #include <EXTERN.h>
 #include <perl.h>
 #include <XSUB.h>

Index: Change.log
--- Tk-804.025_beta6/Change.log	2003-11-16 20:35:02.000000000 +0000
+++ Tk-804.025_beta7/Change.log	2003-12-02 20:57:12.000000000 +0000
@@ -1,3 +1,33 @@
+Change 3008 on 2003/12/02 by nick@llama
+
+	Avoid 'nsv' as a variable after scare with encGlue.c in perl5.9
+
+Change 3007 on 2003/12/01 by nick@llama
+
+	Avoid PERL_HASH stuff for perl5.9 compatibility.
+
+Change 3004 on 2003/11/29 by nick@llama
+
+	Propagate CC= to libjpeg's 'configure'
+
+Change 3003 on 2003/11/29 by nick@llama
+
+	Slaven's (revised) DialogBox patch
+
+Change 2999 on 2003/11/21 by nick@llama
+
+	Slaven's patch for Copy/Paste mess in Derived's -background
+	code.
+
+Change 2998 on 2003/11/20 by nick@llama
+
+	PERL_NO_GET_CONTEXT in all .xs files
+
+Change 2997 on 2003/11/16 by nick@llama
+
+	Change.log update.
+	Also add blibdirs to MANIFEST.SKIP (via .PL file)
+
 Change 2996 on 2003/11/16 by nick@llama
 
 	Steve's ->clear method for Table. (Add to POD as well).

Index: Compound/Compound.xs
--- Tk-804.025_beta6/Compound/Compound.xs	2003-07-20 17:50:55.000000000 +0100
+++ Tk-804.025_beta7/Compound/Compound.xs	2003-11-20 19:57:03.000000000 +0000
@@ -3,7 +3,7 @@
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */
-
+#define PERL_NO_GET_CONTEXT
 #include <EXTERN.h>
 #include <perl.h>
 #include <XSUB.h>

Index: DragDrop/Win32Site/Win32Site.xs
--- Tk-804.025_beta6/DragDrop/Win32Site/Win32Site.xs	2003-07-20 17:50:54.000000000 +0100
+++ Tk-804.025_beta7/DragDrop/Win32Site/Win32Site.xs	2003-11-20 19:56:46.000000000 +0000
@@ -3,6 +3,7 @@
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */
+#define PERL_NO_GET_CONTEXT
 #include <windows.h>
 #include <shellapi.h>
 

Index: Entry/Entry.xs
--- Tk-804.025_beta6/Entry/Entry.xs	2003-07-23 14:57:07.000000000 +0100
+++ Tk-804.025_beta7/Entry/Entry.xs	2003-11-20 19:23:23.000000000 +0000
@@ -3,7 +3,7 @@
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */
-
+#define PERL_NO_GET_CONTEXT
 #include <EXTERN.h>
 #include <perl.h>
 #include <XSUB.h>

Index: Event/Event.xs
--- Tk-804.025_beta6/Event/Event.xs	2003-08-30 23:23:46.000000000 +0100
+++ Tk-804.025_beta7/Event/Event.xs	2003-11-20 20:06:52.000000000 +0000
@@ -3,7 +3,7 @@
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */
-
+#define PERL_NO_GET_CONTEXT
 #include <EXTERN.h>
 #include <perl.h>
 #include <XSUB.h>
@@ -21,9 +21,7 @@
 extern void TclInitSubsystems(CONST char *argv0);
 
 static SV *
-FindVarName(varName,flags)
-char *varName;
-int flags;
+FindVarName(pTHX_ char *varName,int flags)
 {
  STRLEN len;
  SV *name = newSVpv("Tk",2);
@@ -45,9 +43,10 @@
 void
 LangDebug(CONST char *fmt,...)
 {
+ dTHX; /* FIXME? */
  va_list ap;
  va_start(ap,fmt);
- if (SvIV(FindVarName("LangDebug",GV_ADD|GV_ADDWARN)))
+ if (SvIV(FindVarName(aTHX_ "LangDebug",GV_ADD|GV_ADDWARN)))
   {
    PerlIO_vprintf(PerlIO_stderr(), fmt, ap);
    PerlIO_flush(PerlIO_stderr());
@@ -65,6 +64,7 @@
 va_dcl
 #endif
 {
+ dTHX;
  va_list ap;
 #ifdef I_STDARG
  va_start(ap, fmt);
@@ -360,17 +360,14 @@
 }
 
 static void
-install_vtab(name, table, size)
-char *name;
-void *table;
-size_t size;
+install_vtab(pTHX_ char *name, void *table, size_t size)
 {
  if (table)
   {
    typedef int (*fptr)_((void));
    fptr *q = table;
    unsigned i;
-   sv_setiv(FindVarName(name,GV_ADD|GV_ADDMULTI),PTR2IV(table));
+   sv_setiv(FindVarName(aTHX_ name,GV_ADD|GV_ADDMULTI),PTR2IV(table));
    if (size % sizeof(fptr))
     {
      warn("%s is strange size %d",name,size);
@@ -457,6 +454,7 @@
 PerlIO_handle(filePtr)
 PerlIOHandler *filePtr;
 {
+ dTHX; /* FIXME */
  filePtr->io = sv_2io(filePtr->handle);
  if (filePtr->io)
   {
@@ -479,6 +477,7 @@
 void
 PerlIO_watch(PerlIOHandler *filePtr)
 {
+ dTHX; /* FIXME */
  PerlIO *ip = IoIFP(filePtr->io);
  PerlIO *op = IoOFP(filePtr->io);
  int fd     = (ip) ? PerlIO_fileno(ip) : ((op) ? PerlIO_fileno(op) : -1);
@@ -536,6 +535,7 @@
 {
  if (!(filePtr->readyMask & TCL_WRITABLE))
   {
+   dTHX; /* FIXME */
    PerlIO *op = IoOFP(filePtr->io);
    if (op)
     {
@@ -551,6 +551,7 @@
 int
 PerlIO_is_readable(PerlIOHandler *filePtr)
 {
+ dTHX; /* FIXME */
  if (!(filePtr->readyMask & TCL_READABLE))
   {
    PerlIO *io = IoIFP(filePtr->io);
@@ -633,6 +634,7 @@
 PerlIOHandler *filePtr;
 char *s;
 {
+ dTHX; /* FIXME */
  PerlIO *ip = IoIFP(filePtr->io);
  PerlIO *op = IoOFP(filePtr->io);
  int ifd    = (ip) ? PerlIO_fileno(ip) : -1;
@@ -809,6 +811,7 @@
 SVtoPerlIOHandler(sv)
 SV *sv;
 {
+ dTHX; /* FIXME */
  if (sv_isa(sv,"Tk::Event::IO"))
   return (PerlIOHandler *) SvPVX(SvRV(sv));
  croak("Not an Tk::Event::IO");
@@ -822,6 +825,7 @@
 SV *fh;
 int mask;                         /* OR'ed TCL_READABLE, TCL_WRITABLE, and TCL_EXCEPTION */
 {
+ dTHX; /* FIXME */
  HV *stash = gv_stashpv(class, TRUE);
  GV *tmpgv = (GV *) newSV(0);
  IO *tmpio = newIO();
@@ -855,6 +859,7 @@
 PerlIO_DESTROY(thisPtr)
 PerlIOHandler *thisPtr;
 {
+ dTHX; /* FIXME */
  if (initialized)
   {
    PerlIOHandler **link = &firstPerlIOHandler;
@@ -904,6 +909,7 @@
 int mask;
 LangCallback *cb;
 {
+ dTHX; /* FIXME */
  STRLEN len;
  if (cb)
   {
@@ -1024,6 +1030,7 @@
 ClientData clientData;
 int flags;
 {
+ dTHX; /* FIXME */
  dSP;
  ENTER;
  SAVETMPS;
@@ -1041,6 +1048,7 @@
 ClientData clientData;
 int flags;
 {
+ dTHX; /* FIXME */
  dSP;
  ENTER;
  SAVETMPS;
@@ -1066,6 +1074,7 @@
 {PerlEvent *pe = (PerlEvent *) evPtr;
  int code = 1;
  int count;
+ dTHX; /* FIXME */
  dSP;
  ENTER;
  SAVETMPS;
@@ -1108,7 +1117,7 @@
 }
 
 void
-HandleSignals()
+HandleSignals(pTHX)
 {
 #if defined(PATCHLEVEL) && (PATCHLEVEL < 5)
  croak("Cannot HandleSignals with before perl5.005");
@@ -1211,7 +1220,7 @@
 XS(XS_Tk__Event_INIT)
 {
  dXSARGS;
- install_vtab("TkeventVtab",TkeventVGet(),sizeof(TkeventVtab));
+ install_vtab(aTHX_ "TkeventVtab",TkeventVGet(),sizeof(TkeventVtab));
  XSRETURN_EMPTY;
 }
 
@@ -1476,6 +1485,10 @@
 
 void
 HandleSignals()
+CODE:
+ {
+  HandleSignals(aTHX);
+ }
 
 MODULE = Tk::Event	PACKAGE = Tk::Event	PREFIX = Event_
 
@@ -1497,8 +1510,8 @@
  PL_curcop->cop_warnings = old_warn;
 #endif
   newXS("Tk::Callback::Call", XS_Tk__Callback_Call, __FILE__);
-  install_vtab("TkeventVtab",TkeventVGet(),sizeof(TkeventVtab));
-  sv_setiv(FindVarName("LangDebug",GV_ADD|GV_ADDMULTI),1);
+  install_vtab(aTHX_ "TkeventVtab",TkeventVGet(),sizeof(TkeventVtab));
+  sv_setiv(FindVarName(aTHX_ "LangDebug",GV_ADD|GV_ADDMULTI),1);
   TclInitSubsystems(SvPV_nolen(get_sv("0",FALSE)));
  }
 

Index: Event/pTkCallback.c
--- Tk-804.025_beta6/Event/pTkCallback.c	2003-09-25 19:27:14.000000000 +0100
+++ Tk-804.025_beta7/Event/pTkCallback.c	2003-11-20 20:09:52.000000000 +0000
@@ -3,7 +3,7 @@
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */
-
+#define PERL_NO_GET_CONTEXT
 #include <EXTERN.h>
 #include <perl.h>
 #include <XSUB.h>
@@ -35,6 +35,7 @@
 LangMakeCallback(sv)
 SV *sv;
 {
+ dTHX; /* FIXME */
  if (sv)
   {
    dTHX;
@@ -107,6 +108,7 @@
 LangFreeCallback(sv)
 SV *sv;
 {
+ dTHX; /* FIXME */
  if (!sv_isa(sv,"Tk::Callback"))
   {
    warn("Free non-Callback %p RV=%p",sv,SvRV(sv));
@@ -119,6 +121,7 @@
 LangCallbackObj(sv)
 SV *sv;
 {
+ dTHX; /* FIXME */
  if (sv && !sv_isa(sv,"Tk::Callback"))
   {
    warn("non-Callback arg");
@@ -133,6 +136,7 @@
 char *file;
 int line;
 {
+ dTHX; /* FIXME */
  LangDebug("%s:%d: LangCallbackArg is deprecated\n",file,line);
  sv = LangCallbackObj(sv);
  SvREFCNT_dec(sv);
@@ -144,6 +148,7 @@
 SV *sv;
 int flags;
 {
+ dTHX; /* FIXME */
  dSP;
  STRLEN na;
  I32 myframe = TOPMARK;
@@ -215,6 +220,7 @@
 void
 LangPushCallbackArgs(SV **svp)
 {
+ dTHX; /* FIXME */
  SV *sv = *svp;
  dSP;
  STRLEN na;
@@ -267,6 +273,7 @@
 SV *a;
 SV *b;
 {
+ dTHX; /* FIXME */
  if (a == b)
   return 1;
  if (!a || !b)
@@ -394,6 +401,7 @@
  * which have stored stack addresses in Tk structures.
  * The die scheme works round this but imposes cost on normal execution.
  */
+ dTHX; /* FIXME */
  if (PL_in_eval)
   croak("_TK_EXIT_(%d)\n",status);
  else

Index: Extensions/ImageBack/ImageBack.xs
--- Tk-804.025_beta6/Extensions/ImageBack/ImageBack.xs	2003-07-20 17:50:55.000000000 +0100
+++ Tk-804.025_beta7/Extensions/ImageBack/ImageBack.xs	2003-11-20 19:56:21.000000000 +0000
@@ -3,7 +3,7 @@
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */
-
+#define PERL_NO_GET_CONTEXT
 #include <EXTERN.h>
 #include <perl.h>
 #include <XSUB.h>

Index: HList/HList.xs
--- Tk-804.025_beta6/HList/HList.xs	2003-07-20 17:50:55.000000000 +0100
+++ Tk-804.025_beta7/HList/HList.xs	2003-11-20 19:55:44.000000000 +0000
@@ -3,7 +3,7 @@
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */
-
+#define PERL_NO_GET_CONTEXT
 #include <EXTERN.h>
 #include <perl.h>
 #include <XSUB.h>

Index: IO/IO.xs
--- Tk-804.025_beta6/IO/IO.xs	2003-07-20 17:50:50.000000000 +0100
+++ Tk-804.025_beta7/IO/IO.xs	2003-11-20 19:39:44.000000000 +0000
@@ -3,7 +3,7 @@
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */
-
+#define PERL_NO_GET_CONTEXT
 #include <EXTERN.h>
 #include <perl.h>
 #include <XSUB.h>
@@ -44,6 +44,7 @@
 ClientData clientData;
 int mask;
 {
+ dTHX; /* FIXME */
  if (mask & TCL_READABLE)
   {
    nIO_read *info = (nIO_read *) clientData;
@@ -76,12 +77,10 @@
   }
 }
 
-static int restore_mode _((PerlIO *f,int mode));
-static int make_nonblock _((PerlIO *f,int *mode,int *newmode));
 
 #if defined(__WIN32__) && !defined(__CYGWIN__)
 static int
-make_nonblock(f,mode,newmode)
+make_nonblock (pTHX_ PerlIO *f,int *mode,int *newmode)
 PerlIO *f;
 int *mode;
 int *newmode;
@@ -91,19 +90,14 @@
 }
 
 static int
-restore_mode(f,mode)
-PerlIO *f;
-int mode;
+restore_mode (pTHX_ PerlIO *f,int mode)
 {
  croak("Cannot make nonblocking on Win32 yet");
  return -1;
 }
 #else
 static int
-make_nonblock(f,mode,newmode)
-PerlIO *f;
-int *mode;
-int *newmode;
+make_nonblock (pTHX_ PerlIO *f,int *mode,int *newmode)
 {
  int RETVAL = fcntl(PerlIO_fileno(f), F_GETFL, 0);
  if (RETVAL >= 0)
@@ -145,9 +139,7 @@
 }
 
 static int
-restore_mode(f,mode)
-PerlIO *f;
-int mode;
+restore_mode (pTHX_ PerlIO *f,int mode)
 {
  return fcntl(PerlIO_fileno(f), F_SETFL, mode);
 }
@@ -178,6 +170,10 @@
 InputStream	f
 int	&mode = NO_INIT
 int	&newmode  = NO_INIT
+CODE:
+ {
+  make_nonblock(aTHX_ f,&mode,&newmode);
+ }
 OUTPUT:
   mode
   newmode
@@ -186,6 +182,10 @@
 restore_mode(f,mode)
 InputStream	f
 int	mode
+CODE:
+ {
+  restore_mode(aTHX_ f,mode);
+ }
 
 SV *
 read(f,buf,len,offset = 0)
@@ -197,7 +197,7 @@
   {
    int mode;
    int newmode;
-   int count = make_nonblock(f,&mode,&newmode);
+   int count = make_nonblock(aTHX_ f,&mode,&newmode);
    /* Copy stuff out of PerlIO *  */
    ST(0) = &PL_sv_undef;
    if (count == 0)
@@ -225,7 +225,7 @@
      Tcl_DeleteFileHandler(fd);
      if (mode != newmode)
       {
-       count = restore_mode(f,mode);
+       count = restore_mode(aTHX_ f,mode);
        if (count != 0)
         croak("Cannot make blocking");
       }
@@ -245,7 +245,7 @@
   {
    int mode;
    int newmode;
-   int count = make_nonblock(f,&mode,&newmode);
+   int count = make_nonblock(aTHX_ f,&mode,&newmode);
    /* Copy stuff out of PerlIO *  */
    ST(0) = &PL_sv_undef;
    if (count == 0)
@@ -271,7 +271,7 @@
      Tcl_DeleteFileHandler(fd);
      if (mode != newmode)
       {
-       count = restore_mode(f,mode);
+       count = restore_mode(aTHX_ f,mode);
        if (count != 0)
         croak("Cannot make blocking");
       }

Index: InputO/InputO.xs
--- Tk-804.025_beta6/InputO/InputO.xs	2003-07-20 17:50:55.000000000 +0100
+++ Tk-804.025_beta7/InputO/InputO.xs	2003-11-20 19:52:49.000000000 +0000
@@ -3,7 +3,7 @@
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */
-
+#define PERL_NO_GET_CONTEXT
 #include <EXTERN.h>
 #include <perl.h>
 #include <XSUB.h>

Index: JPEG/JPEG.xs
--- Tk-804.025_beta6/JPEG/JPEG.xs	2003-09-06 22:20:54.000000000 +0100
+++ Tk-804.025_beta7/JPEG/JPEG.xs	2003-11-20 19:40:36.000000000 +0000
@@ -3,7 +3,7 @@
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */
-
+#define PERL_NO_GET_CONTEXT
 #include <EXTERN.h>
 #include <perl.h>
 #include <XSUB.h>

Index: JPEG/Makefile.PL
--- Tk-804.025_beta6/JPEG/Makefile.PL	2003-09-06 22:20:54.000000000 +0100
+++ Tk-804.025_beta7/JPEG/Makefile.PL	2003-11-29 13:19:32.000000000 +0000
@@ -33,7 +33,7 @@
     'NAME'         => 'Tk::JPEG',
     'EXE_FILES'    => ['tkjpeg'],
     'PMLIBDIRS'    => [],
-    'PREREQ_PM'    => { # Tk => 800.015, 
+    'PREREQ_PM'    => { # Tk => 800.015,
                         ExtUtils::MakeMaker => 6.05 },
     'OBJECT'       => '$(O_FILES)',
     'VERSION_FROM' => 'JPEG.pm',

Index: JPEG/jpeg/Makefile.maybe
--- Tk-804.025_beta6/JPEG/jpeg/Makefile.maybe	2003-09-06 22:20:54.000000000 +0100
+++ Tk-804.025_beta7/JPEG/jpeg/Makefile.maybe	2003-11-29 13:15:03.000000000 +0000
@@ -30,6 +30,7 @@
  }
 else
  {
+  $ENV{CC} = $Config{cc};
   system("./configure");
  }
 1;

Index: Listbox/Listbox.xs
--- Tk-804.025_beta6/Listbox/Listbox.xs	2003-07-20 17:50:55.000000000 +0100
+++ Tk-804.025_beta7/Listbox/Listbox.xs	2003-11-20 19:23:05.000000000 +0000
@@ -3,6 +3,7 @@
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */
+#define PERL_NO_GET_CONTEXT
 
 #include <EXTERN.h>
 #include <perl.h>

Index: MANIFEST
--- Tk-804.025_beta6/MANIFEST	2003-11-09 18:09:41.000000000 +0000
+++ Tk-804.025_beta7/MANIFEST	2003-11-29 11:38:19.000000000 +0000
@@ -1830,6 +1830,7 @@
 t/create.t
 t/cursor.t
 t/dash.t
+t/dialogbox.t
 t/entry.t
 t/fbox.t
 t/fileevent.t

Index: Menubutton/Menubutton.xs
--- Tk-804.025_beta6/Menubutton/Menubutton.xs	2003-07-20 17:50:55.000000000 +0100
+++ Tk-804.025_beta7/Menubutton/Menubutton.xs	2003-11-20 19:52:31.000000000 +0000
@@ -3,7 +3,7 @@
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */
-
+#define PERL_NO_GET_CONTEXT
 #include <EXTERN.h>
 #include <perl.h>
 #include <XSUB.h>

Index: Mwm/Mwm.xs
--- Tk-804.025_beta6/Mwm/Mwm.xs	2003-07-20 17:50:51.000000000 +0100
+++ Tk-804.025_beta7/Mwm/Mwm.xs	2003-11-20 19:52:14.000000000 +0000
@@ -3,7 +3,7 @@
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */
-
+#define PERL_NO_GET_CONTEXT
 #include <EXTERN.h>
 #include <perl.h>
 #include <XSUB.h>

Index: NBFrame/NBFrame.xs
--- Tk-804.025_beta6/NBFrame/NBFrame.xs	2003-07-20 17:50:55.000000000 +0100
+++ Tk-804.025_beta7/NBFrame/NBFrame.xs	2003-11-20 19:51:56.000000000 +0000
@@ -3,7 +3,7 @@
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */
-
+#define PERL_NO_GET_CONTEXT
 #include <EXTERN.h>
 #include <perl.h>
 #include <XSUB.h>

Index: PNG/PNG.xs
--- Tk-804.025_beta6/PNG/PNG.xs	2003-11-09 17:50:10.000000000 +0000
+++ Tk-804.025_beta7/PNG/PNG.xs	2003-11-29 11:39:29.000000000 +0000
@@ -3,7 +3,7 @@
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */
-
+#define PERL_NO_GET_CONTEXT
 #include <EXTERN.h>
 #include <perl.h>
 #include <XSUB.h>

Index: Scale/Scale.xs
--- Tk-804.025_beta6/Scale/Scale.xs	2003-07-20 17:50:55.000000000 +0100
+++ Tk-804.025_beta7/Scale/Scale.xs	2003-11-20 19:51:38.000000000 +0000
@@ -3,7 +3,7 @@
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */
-
+#define PERL_NO_GET_CONTEXT
 #include <EXTERN.h>
 #include <perl.h>
 #include <XSUB.h>

Index: Scrollbar/Scrollbar.xs
--- Tk-804.025_beta6/Scrollbar/Scrollbar.xs	2003-07-20 17:50:55.000000000 +0100
+++ Tk-804.025_beta7/Scrollbar/Scrollbar.xs	2003-11-20 19:42:20.000000000 +0000
@@ -3,7 +3,7 @@
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */
-
+#define PERL_NO_GET_CONTEXT
 #include <EXTERN.h>
 #include <perl.h>
 #include <XSUB.h>

Index: TList/TList.xs
--- Tk-804.025_beta6/TList/TList.xs	2003-07-20 17:50:55.000000000 +0100
+++ Tk-804.025_beta7/TList/TList.xs	2003-11-20 19:51:20.000000000 +0000
@@ -3,7 +3,7 @@
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */
-
+#define PERL_NO_GET_CONTEXT
 #include <EXTERN.h>
 #include <perl.h>
 #include <XSUB.h>

Index: Text/Text.xs
--- Tk-804.025_beta6/Text/Text.xs	2003-07-20 17:50:53.000000000 +0100
+++ Tk-804.025_beta7/Text/Text.xs	2003-11-20 19:50:59.000000000 +0000
@@ -3,7 +3,7 @@
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */
-
+#define PERL_NO_GET_CONTEXT
 #include <EXTERN.h>
 #include <perl.h>
 #include <XSUB.h>

Index: TixGrid/TixGrid.xs
--- Tk-804.025_beta6/TixGrid/TixGrid.xs	2003-07-20 17:50:55.000000000 +0100
+++ Tk-804.025_beta7/TixGrid/TixGrid.xs	2003-11-20 19:29:06.000000000 +0000
@@ -3,7 +3,7 @@
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */
-
+#define PERL_NO_GET_CONTEXT
 #include <EXTERN.h>
 #include <perl.h>
 #include <XSUB.h>

Index: TixPixmap/Pixmap.xs
--- Tk-804.025_beta6/TixPixmap/Pixmap.xs	2003-07-20 17:50:55.000000000 +0100
+++ Tk-804.025_beta7/TixPixmap/Pixmap.xs	2003-11-20 19:50:37.000000000 +0000
@@ -3,7 +3,7 @@
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */
-
+#define PERL_NO_GET_CONTEXT
 #include <EXTERN.h>
 #include <perl.h>
 #include <XSUB.h>

Index: Tixish/DialogBox.pm
--- Tk-804.025_beta6/Tixish/DialogBox.pm	2003-11-02 20:43:27.000000000 +0000
+++ Tk-804.025_beta7/Tixish/DialogBox.pm	2003-11-29 13:02:50.000000000 +0000
@@ -9,7 +9,7 @@
 use Carp;
 
 use vars qw($VERSION);
-$VERSION = sprintf '4.%03d', q$Revision: #12 $ =~ /\D(\d+)\s*$/;
+$VERSION = sprintf '4.%03d', q$Revision: #13 $ =~ /\D(\d+)\s*$/;
 
 use base  qw(Tk::Toplevel);
 
@@ -70,6 +70,8 @@
     $cw->ConfigSpecs(-command    => ['CALLBACK', undef, undef, undef ],
                      -foreground => ['DESCENDANTS', 'foreground','Foreground', 'black'],
                      -background => ['DESCENDANTS', 'background','Background',  undef],
+		     -focus	 => ['PASSIVE', undef, undef, undef],
+		     -showcommand => ['CALLBACK', undef, undef, undef],
                     );
     $cw->Delegates('Construct',$top);
 }
@@ -84,6 +86,7 @@
 sub Wait
 {
  my $cw = shift;
+ $cw->Callback(-showcommand => $cw);
  $cw->waitVariable(\$cw->{'selected_button'});
  $cw->grabRelease;
  $cw->withdraw;
@@ -109,7 +112,9 @@
 	$cw->grab;
     }
     };
-    if (defined $cw->{'default_button'}) {
+    if (my $focusw = $cw->cget(-focus)) {
+	$focusw->focus;
+    } elsif (defined $cw->{'default_button'}) {
 	$cw->{'default_button'}->focus;
     } else {
 	$cw->focus;

Index: Tk.xs
--- Tk-804.025_beta6/Tk.xs	2003-10-09 11:56:31.000000000 +0100
+++ Tk-804.025_beta7/Tk.xs	2003-11-20 19:26:48.000000000 +0000
@@ -3,7 +3,7 @@
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */
-
+#define PERL_NO_GET_CONTEXT
 #include <EXTERN.h>
 #include <perl.h>
 #include <XSUB.h>
@@ -75,39 +75,6 @@
 
 static XFontStruct * TkwinFont _((Tk_Window tkwin, Tk_Uid name));
 
-static void pTk_DefineBitmap _((Tk_Window tkwin, char *name,
-                               int width, int height, SV *source));
-
-static void
-pTk_DefineBitmap (tkwin, name, width, height, source)
-Tk_Window tkwin;
-char *name;
-int width;
-int height;
-SV *source;
-{
- Tcl_Interp *interp;
- if (TkToWidget(tkwin,&interp) && interp)
-  {STRLEN len;
-   unsigned char *data = (unsigned char *) SvPV(source, len);
-   STRLEN byte_line = (width + 7) / 8;
-   if (len == height * byte_line)
-    {
-     Tcl_ResetResult(interp);
-     if (Tk_DefineBitmap(interp, Tk_GetUid(name), data, width, height) != TCL_OK)
-      croak(Tcl_GetStringResult(interp));
-    }
-   else
-    {
-     croak("Data wrong size for %dx%d bitmap",width,height);
-    }
-  }
- else
-  {
-   croak("Invalid widget");
-  }
-}
-
 #define pTk_Synchronize(win,flag) \
    XSynchronize(Tk_Display(win), flag)
 
@@ -565,12 +532,35 @@
 }
 
 void
-pTk_DefineBitmap (win, name, width, height, source)
-Tk_Window	win;
+pTk_DefineBitmap (tkwin, name, width, height, source)
+Tk_Window	tkwin;
 char *	name;
 int	width;
 int	height;
 SV *	source;
+CODE:
+{
+ Tcl_Interp *interp;
+ if (TkToWidget(tkwin,&interp) && interp)
+  {STRLEN len;
+   unsigned char *data = (unsigned char *) SvPV(source, len);
+   STRLEN byte_line = (width + 7) / 8;
+   if (len == height * byte_line)
+    {
+     Tcl_ResetResult(interp);
+     if (Tk_DefineBitmap(interp, Tk_GetUid(name), data, width, height) != TCL_OK)
+      croak(Tcl_GetStringResult(interp));
+    }
+   else
+    {
+     croak("Data wrong size for %dx%d bitmap",width,height);
+    }
+  }
+ else
+  {
+   croak("Invalid widget");
+  }
+}
 
 void
 pTk_GetBitmap(tkwin, name)

Index: Tk/Derived.pm
--- Tk-804.025_beta6/Tk/Derived.pm	2003-11-01 20:32:45.000000000 +0000
+++ Tk-804.025_beta7/Tk/Derived.pm	2003-11-21 20:52:16.000000000 +0000
@@ -8,7 +8,7 @@
 use Carp;
 
 use vars qw($VERSION);
-$VERSION = sprintf '4.%03d', q$Revision: #9 $ =~ /\D(\d+)\s*$/;
+$VERSION = sprintf '4.%03d', q$Revision: #10 $ =~ /\D(\d+)\s*$/;
 
 $Tk::Derived::Debug = 0;
 
@@ -336,7 +336,7 @@
 
  unless (exists($specs->{'-background'}))
   {
-   Tk::catch { $cw->Tk::cget('-foreground') };
+   Tk::catch { $cw->Tk::cget('-background') };
    my (@bg) = $@ ? ('PASSIVE') : ('SELF');
    push(@bg,'CHILDREN') if $child;
    $specs->{'-background'} = [\@bg,'background','Background',NORMAL_BG];

Index: WinPhoto/WinPhoto.xs
--- Tk-804.025_beta6/WinPhoto/WinPhoto.xs	2003-08-24 13:33:43.000000000 +0100
+++ Tk-804.025_beta7/WinPhoto/WinPhoto.xs	2003-11-20 19:56:28.000000000 +0000
@@ -3,7 +3,7 @@
   This program is free software; you can redistribute it and/or
   modify it under the same terms as Perl itself.
 */
-
+#define PERL_NO_GET_CONTEXT
 #include <EXTERN.h>
 #include <perl.h>
 #include <XSUB.h>

Index: Xlib/X/X.xs
--- Tk-804.025_beta6/Xlib/X/X.xs	2003-07-19 09:39:03.000000000 +0100
+++ Tk-804.025_beta7/Xlib/X/X.xs	2003-11-20 19:57:20.000000000 +0000
@@ -1,3 +1,4 @@
+#define PERL_NO_GET_CONTEXT
 #ifdef __cplusplus
 extern "C" {
 #endif

Index: Xlib/Xlib.xs
--- Tk-804.025_beta6/Xlib/Xlib.xs	2003-07-19 15:29:29.000000000 +0100
+++ Tk-804.025_beta7/Xlib/Xlib.xs	2003-11-20 19:49:43.000000000 +0000
@@ -1,7 +1,7 @@
+#define PERL_NO_GET_CONTEXT
 #include <EXTERN.h>
 #include <perl.h>
 #include <XSUB.h>
-
 #include "tkGlue.def"
 
 #include "pTk/tkPort.h"
@@ -38,9 +38,7 @@
 #endif
 
 static IV
-SvGCIVOBJ(class,sv)
-char *class;
-SV *sv;
+SvGCIVOBJ(pTHX_ char *class,SV *sv)
 {
  if (sv_isa(sv, class))
   return SvIV((SV*)SvRV(sv));
@@ -52,8 +50,8 @@
 #define SvGCint(x)           SvIV(x)
 #define SvGCBool(x)          SvIV(x)
 #define SvGCunsigned_long(x) SvIV(x)
-#define SvGCPixmap(x)        (Pixmap) SvGCIVOBJ("Pixmap",x)
-#define SvGCFont(x)          (Font)   SvGCIVOBJ("Font",x)
+#define SvGCPixmap(x)        (Pixmap) SvGCIVOBJ(aTHX_ "Pixmap",x)
+#define SvGCFont(x)          (Font)   SvGCIVOBJ(aTHX_ "Font",x)
 
 #define GCField(name,bit,field,func) \
  if (!strcmp(key,name)) {            \
@@ -62,11 +60,8 @@
  } else
 
 unsigned long
-GCSetValue(valuemask,values,key,value)
-unsigned long valuemask;
-XGCValues *values;
-char *key;
-SV *value;
+GCSetValue(pTHX_ unsigned long valuemask,
+           XGCValues *values,char *key,SV *value)
 {
 #include "GC.def"
  croak("Setting GC %s not implemented",key);
@@ -363,7 +358,7 @@
    for (i=3; i < items; i += 2)
     {char *key = SvPV(ST(i),na);
      if (i+1 < items)
-      valuemask = GCSetValue(valuemask,&values,key,ST(i+1));
+      valuemask = GCSetValue(aTHX_ valuemask,&values,key,ST(i+1));
      else
       croak("No value for %s",key);
     }

Index: encGlue.c
--- Tk-804.025_beta6/encGlue.c	2003-10-09 11:55:15.000000000 +0100
+++ Tk-804.025_beta7/encGlue.c	2003-12-01 19:07:04.000000000 +0000
@@ -550,14 +550,12 @@
  HE *he;
  STRLEN len = strlen(name);
  SV *sv   = NULL;
- SV *nsv  = newSVpv((char *)name,len);
- I32 hash;
- PERL_HASH(hash, (char *)name, len);
+ SV *nmsv  = newSVpv((char *)name,len);
  if (!encodings)
   {
    encodings = newHV();
   }
- he = hv_fetch_ent(encodings,nsv,0,hash);
+ he = hv_fetch_ent(encodings,nmsv,0,0);
  if (!he || !HeVAL(he))
   {
    dSP;
@@ -565,19 +563,19 @@
    SAVETMPS;
    PUSHMARK(sp);
    XPUSHs(sv_2mortal(newSVpv("Tk",0)));
-   XPUSHs(nsv);
+   XPUSHs(nmsv);
    PUTBACK;
    perl_call_method("getEncoding",G_SCALAR);
    SPAGAIN;
    sv = POPs;
    PUTBACK;
-   he = hv_store_ent(encodings,nsv,newSVsv(sv),hash);
+   he = hv_store_ent(encodings,nmsv,newSVsv(sv),0);
    if (0 && !SvOK(sv))
     warn("Cannot find '%s'",name);
    FREETMPS;
    LEAVE;
   }
- SvREFCNT_dec(nsv);
+ SvREFCNT_dec(nmsv);
  sv = HeVAL(he);
  if (sv_isobject(sv))
   {

Index: objGlue.c
--- Tk-804.025_beta6/objGlue.c	2003-10-28 21:24:26.000000000 +0000
+++ Tk-804.025_beta7/objGlue.c	2003-12-02 19:54:45.000000000 +0000
@@ -157,11 +157,11 @@
  if (SvTYPE(sv) == SVt_PVAV)
   {
    AV *av = (AV *) sv;
-   SV *nsv = newSVpv("",0);
-   Scalarize(aTHX_ nsv, (AV *) av);
+   SV *newsv = newSVpv("",0);
+   Scalarize(aTHX_ newsv, (AV *) av);
    av_clear(av);
-   av_store(av,0,nsv);
-   return nsv;
+   av_store(av,0,newsv);
+   return newsv;
   }
  else
   {
@@ -170,17 +170,17 @@
      /* Callbacks and lists often get stringified by mistake due to
         Tcl/Tk's string fixation - don't change the real value
       */
-     SV *nsv = newSVpv("",0);
-     Scalarize(aTHX_ nsv, (AV *) SvRV(sv));
-     return sv_2mortal(nsv);
+     SV *newsv = newSVpv("",0);
+     Scalarize(aTHX_ newsv, (AV *) SvRV(sv));
+     return sv_2mortal(newsv);
     }
    else if (!SvOK(sv))
     {
      /* Map undef to null string */
      if (SvREADONLY(sv))
       {
-       SV *nsv = newSVpv("",0);
-       return sv_2mortal(nsv);
+       SV *newsv = newSVpv("",0);
+       return sv_2mortal(newsv);
       }
      else
       sv_setpvn(sv,"",0);
@@ -195,10 +195,10 @@
  if (SvTYPE(sv) == SVt_PVAV)
   {
    AV *av = (AV *) sv;
-   SV *nsv = newSVpv("",0);
+   SV *newsv = newSVpv("",0);
    av_clear(av);
-   av_store(av,0,nsv);
-   return nsv;
+   av_store(av,0,newsv);
+   return newsv;
   }
  else
   {

Index: pod/DialogBox.pod
--- Tk-804.025_beta6/pod/DialogBox.pod	2003-07-20 12:50:47.000000000 +0100
+++ Tk-804.025_beta7/pod/DialogBox.pod	2003-11-29 11:37:01.000000000 +0000
@@ -51,6 +51,24 @@
 array whose reference is passed to the B<-buttons> option is used
 as the default.
 
+=item B<-command>
+
+A callback which is executed after invoking an action to close the
+DialogBox, but before restoring focus and grab information. The
+selected button is passed as the first argument.
+
+=item B<-focus>
+
+Specify the widget to receive the initial focus after popping up the
+DialogBox. By default the B<-default_button> widget receives the
+initial focus.
+
+=item B<-showcommand>
+
+A callback which is executed before displaying the DialogBox and
+waiting for user input. The DialogBox itself is passed as the first
+argument.
+
 =back
 
 =head1 METHODS
@@ -122,6 +140,8 @@
 subwidget name is the string I<B_> concatenated with the Button's -text
 value.
 
+=back
+
 =head1 BUGS
 
 There is no way of removing a widget once it has been added to the

Index: t/dialogbox.t
--- /dev/null	2003-09-23 18:59:22.000000000 +0100
+++ Tk-804.025_beta7/t/dialogbox.t	2003-11-29 11:36:51.000000000 +0000
@@ -0,0 +1,52 @@
+# -*- perl -*-
+BEGIN { $|=1; $^W=1; }
+use strict;
+use Test;
+
+BEGIN { plan test => 8 };
+
+if (!defined $ENV{BATCH}) { $ENV{BATCH} = 1 }
+
+eval { require Tk };
+ok($@, "", "loading Tk module");
+
+eval { require Tk::DialogBox };
+ok($@, "", "loading Tk::DialogBox module");
+
+my $top = new MainWindow;
+$top->withdraw;
+eval { $top->geometry('+10+10'); };  # This works for mwm and interactivePlacement
+
+{
+    my $d = $top->DialogBox;
+    my $e = $d->add("Entry")->pack;
+    $d->configure(-focus => $e,
+		  -showcommand => sub {
+		      my $w = shift;
+		      ok($w, $d, "Callback parameter check");
+		      $d->update;
+		      my $fc = $d->focusCurrent || "";
+		      ok($fc eq "" || $fc eq $e, 1,
+			 "Check -focus option (current focus is on `$fc')");
+		      my $ok_b = $d->Subwidget("B_OK");
+		      ok(!!Tk::Exists($ok_b), 1, "Check default button");
+		      ok(UNIVERSAL::isa($ok_b, "Tk::Button"));
+		      $ok_b->after(300, sub { $ok_b->invoke }) if $ENV{BATCH};
+		  });
+    ok($d->Show, "OK");
+}
+
+{
+    my $d = $top->DialogBox(-buttons => [qw(OK Cancel), "I don't know"],
+			    -default_button => "Cancel");
+    my $e = $d->add("Label", -text => "Hello, world!")->pack;
+    $d->configure(-showcommand => sub {
+		      $d->update;
+		      my $d_b = $d->{default_button};
+		      $d->after(300, sub { $d_b->invoke }) if $ENV{BATCH};
+		  });
+    ok($d->Show, "Cancel");
+}
+
+1;
+__END__
__END_OF_PATCH__