Re: How to use a tcl/tk widget that needs a tcl array

[email protected] (Gisle Aas) Thu, 28 Oct 2010 23:26:04 +0200
Newsgroups perl.tcltk
Message-ID <[email protected]> 
On Oct 28, 2010, at 21:54 , Jeff Hobbs wrote:

> On 28/10/2010 12:51 PM, Gisle Aas wrote:
>> For this specific problem I think we should just make passing of a hash reference to a Tcl command work the same way it works to pass a scalar reference.  It should then be possible to just use:
> 
> FWIW I thought that might be a good idea as well, but it would be done at the Tcl.pm level in the 'call' subroutine.  Just adding a "$ref eq 'HASH'" check that mirrors (or adds on to) the $ref eq 'SCALAR' check.

Right.  The attached patch does exactly that.  It allows this program to work as expected:

----------------
use strict;
use warnings;
use Tkx;

Tkx::package_require("Tktable");

my $mw = Tkx::widget->new(".");
my %hash = ( # data to display
  '0,0' => 'Goodby',
  '1,1' => 'cruel',
  '2,2' => 'world',
);

my $t = $mw->new_table(
    -rows => 5,
    -cols => 3,
    -cache => 1,
    -variable => \%hash,
);
$t->g_pack(-fill => 'both', -expand => 1);
Tkx::MainLoop();
use Data::Dump; dd \%hash;
----------------

One uglyness is that the hash is copied the first time it's passed to a Tcl function in this way.  I wonder if it would be possible to set up some arrangement with tracing on the Tcl side that calls back into Perl so that we can actually keep that hash on the Perl side; thus avoiding the copy.  Too complicated?

--Gisle
0001-Automatically-tie-hash-references-passed-to-Tcl.patch (application/octet-stream, 1.9 KB) 
From 758156c880e130d1f4f7517589d9e9aa80039b4b Mon Sep 17 00:00:00 2001
From: Gisle Aas <[email protected]>
Date: Thu, 28 Oct 2010 23:15:45 +0200
Subject: [PATCH] Automatically tie hash references passed to Tcl

---
 Tcl.pm |   23 ++++++++++++++++++++++-
 1 files changed, 22 insertions(+), 1 deletions(-)

diff --git a/Tcl.pm b/Tcl.pm
index b48031d..49bc355 100644
--- a/Tcl.pm
+++ b/Tcl.pm
@@ -128,7 +128,10 @@ code as:
   my $r = 'aaaa';
   button(".d", -textvariable => \$r, -command=>sub {$r++});
 
-3.  As a special case, there is a mechanism to deal with Tk's special event
+3. All references to hashes will be substituted with names of Tcl array
+variables transformed appropriately.
+
+4.  As a special case, there is a mechanism to deal with Tk's special event
 variables (they are mentioned as '%x', '%y' and so on throughout Tcl).
 When creating a subroutine reference that uses such variables, you must
 declare the desired variables using Tcl::Ev as the first argument to the
@@ -494,6 +497,24 @@ sub call {
 	    }
 	    $args[$argcnt] = $nm; # ... and substitute its name
 	}
+	elsif ($ref eq 'HASH') {
+	    # We have been passed something like \%hash
+	    # Create a tied variable between Tcl and Perl.
+
+	    # stringify hash ref, create in ::perl namespace on Tcl side
+	    # This will be HASH(0xXXXXXX) - leave it to become part of a
+	    # Tcl array.
+	    my $nm = "::perl::$arg";
+	    $nm =~ s/\W/_/g; # remove () from stringified name
+	    unless (exists $anon_refs{$nm}) {
+		$widget_refs{$current_widget}->{$nm}++;
+		$anon_refs{$nm} = $arg;
+		my %s = %$arg;
+		tie %$arg, 'Tcl::Var', $interp, $nm;
+		%$arg = %s;
+	    }
+	    $args[$argcnt] = $nm; # ... and substitute its name
+	}
 	elsif ($ref eq 'ARRAY' && ref($arg->[0]) eq 'CODE') {
 	    # We have been passed something like [\&subroutine, $arg1, ...]
 	    # Create a proc in Tcl that invokes this subroutine with args
-- 
1.6.6.rc1.31.g1a56b