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

[Konovalov, V. <vko...@sp...>]

> > > 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.

Very very nice.

t/optmenu.t has failures because test was borrowed from perlTk, and
Optionmenu there has possibility to display different string than
appropriate variable holds.
Probably this feature could be just ignored and protected from tests? Must
decide. 
Additionally, there exists in that test something like 
 $varref = $widget->cget('textvariable};
 $$varref;

So I'll add temporarily a wrapper function "wcall" to have this implemented,
later we'll improve that.
$int->wcall will call "$int->call" and will substitute result value from
%anon_refs hash.

BTW I am planning to release both modules to CPAN tomorrow or at end of
weekend.

If no one mind, I'll release both modules with version 0.77. (or is it
reasonable to make version 0.80 due to many changes and improvements that
were done?)

Best regards,
Vadim/

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