Re: [tcltk-perl] Why is Tcl a subclass of Tck::Tk?

[Gisle A. <gi...@Ac...>]

"Konovalov, Vadim" <vko...@sp...> writes:

> > > Could you please explain your way of doing things?
> > 
> > I would expect:
> > 
> >    $tcl = Tcl->new;
> > 
> > to give me an interpreter that only can do the plain Tcl stuff,
> > i.e. what tclsh can do.
> > 
> > I would expect:
> > 
> >    $tcltk = Tcl::Tk->new
> > 
> > to be a subclass of Tcl that can do plain Tcl stuff as well as all the
> > Tk stuff, ie. what wish can do.
> > 
> > I don't expect my $tcl to suddenly grow more capable or different just
> > becase I happened to load the Tcl::Tk module in the same process
> > later.  Perhaps I just misunderstand what tcl actually looks like
> > underneath.  I have not used actually tcl in 15 years, so my memory of
> > what it is is rusty.
> 
> All your arguments are very reasonable and in case you have patch please
> give it to me.

This patch make Tcl::Tk a subclass of Tcl instead of the other way
around.  The test suite certainly still passes as well as it did
before; t/optmenu.t have some failures but from its cvs log they
appear to be know.

--Gisle


Index: Tcl.pm
===================================================================
RCS file: /cvsroot/tcltkce/Tcl/Tcl.pm,v
retrieving revision 1.14
diff -u -p -r1.14 Tcl.pm
--- Tcl.pm	15 Apr 2004 13:25:20 -0000	1.14
+++ Tcl.pm	16 Apr 2004 09:31:26 -0000
@@ -272,11 +272,8 @@ See http://www.perl.com/perl/misc/Artist
 
 use strict;
 use DynaLoader;
-unless (defined $Tcl::Tk::VERSION) {
-    package Tcl::Tk; # define empty package
-}
 use vars qw(@ISA);
-@ISA = qw(DynaLoader Tcl::Tk);
+@ISA = qw(DynaLoader);
 
 Tcl->bootstrap($Tcl::VERSION);
 
Index: Tcl.xs
===================================================================
RCS file: /cvsroot/tcltkce/Tcl/Tcl.xs,v
retrieving revision 1.21
diff -u -p -r1.21 Tcl.xs
--- Tcl.xs	15 Apr 2004 10:47:16 -0000	1.21
+++ Tcl.xs	16 Apr 2004 09:31:27 -0000
@@ -871,7 +871,7 @@ FETCH(av, key = NULL)
 	    croak("bad object passed to Tcl::Var::FETCH");
 	}
 	sv = *av_fetch(av, 0, FALSE);
-	if (sv_isa(sv, "Tcl")) {
+	if (sv_derived_from(sv, "Tcl")) {
 	    IV tmp = SvIV((SV *) SvRV(sv));
 	    interp = (Tcl) tmp;
 	}
@@ -904,7 +904,7 @@ STORE(av, sv1, sv2 = NULL)
 	if (AvFILL(av) != 1 && AvFILL(av) != 2)
 	    croak("bad object passed to Tcl::Var::STORE");
 	sv = *av_fetch(av, 0, FALSE);
-	if (sv_isa(sv, "Tcl")) {
+	if (sv_derived_from(sv, "Tcl")) {
 	    IV tmp = SvIV((SV *) SvRV(sv));
 	    interp = (Tcl) tmp;
 	}
Index: lib/Tcl/Tk.pm
===================================================================
RCS file: /cvsroot/tcltkce/TclTk/lib/Tcl/Tk.pm,v
retrieving revision 1.21
diff -u -p -r1.21 Tk.pm
--- lib/Tcl/Tk.pm	15 Apr 2004 22:07:31 -0000	1.21
+++ lib/Tcl/Tk.pm	16 Apr 2004 09:32:00 -0000
@@ -5,7 +5,7 @@ use Tcl;
 use Exporter;
 use DynaLoader;
 use vars qw(@ISA @EXPORT_OK %EXPORT_TAGS);
-@ISA = qw(Exporter DynaLoader);
+@ISA = qw(DynaLoader Exporter Tcl);
 
 $Tcl::Tk::VERSION = '0.77';
 
@@ -340,6 +340,7 @@ sub new {
 	$sync = 0;
     }
     $i = new Tcl;
+    bless $i, $class;
     if (!defined($tkinterp)) {
 	# CreateMainWindow is no longer necessary (was for pre-Tk8)
 	#$i->CreateMainWindow($display, $name, $sync);
@@ -371,11 +372,11 @@ sub new {
 }
 
 sub tkinit {
-    $tkinterp = new(@_);
+    $tkinterp = Tcl::Tk->new(@_);
     $mainwindow;
 }
 sub MainWindow {
-    $tkinterp = new(@_);
+    $tkinterp = Tcl::Tk->new(@_);
     $mainwindow;
 }