• Tk::Tree

    From Angus McLeod@VERT/ANJO to All on Wednesday, June 07, 2006 04:44:00
    I'm using a Tk::Tree to display a two-legel heirarchal datastructure. I
    use

    $tree = $treeframe->Scrolled( 'Tree',
    -scrollbars => 'oe',
    -height => 40,
    -width => -1,
    -browsecmd => \&tree_browsecmd,
    -command => \&tree_command,
    # -closecmd => \&tree_closecmd,
    # -opencmd => \&tree_opencmd,
    pack( -expand => 1, -fill => 'both', -side => 'top', );

    to create a scrollable Tree. Notice that the open and close callbacks are commented out.

    I then add each top-level item like this:

    $tree->add( $key, -text => $top_data );

    also adding each sub-item like this:

    $tree->hide( 'entry', # sub-items collapsed at start
    $tree->addchild(
    $key,
    -text => $sub_data,
    )
    );

    before finally declaring the top-level item "openable" like so:

    $tree->setmode( $key, 'open' );

    Okay, on MainWindow, I get a good Tk::Tree displayed with the top-level
    data listes with a little [+] to the left. If I press the [+] the tree
    branch opens up to list all the sub-items and the [+] becomes a [-]. If I click the [-] the tree branch closes up again. Opening and closing the
    branch does NOT fire my callbacks, because they are commented out of the
    call to the constructor.

    If I double-click an item (top- or sub-level) my &tree_command() callback fires (it's just a stub at the moment, as are all the callbacks).

    Now, suppose I UN-comment the open and close callbacks, and re-run the
    proggy. Now, clicking [+] and [-] fire the open and close callbacks
    (still only stubs) as expected.. but the tree branch DOES NOT open and
    close as before. Perldoc says "Specifies a command to call whenever an
    entry needs to be opened/closed [...] If the -opencmd/-closecmd option is
    not specified, the default opening action is to show all the child entries
    of the specified entry."

    By specifying my own callbacks, I have disabled whatever default callbacks were defined. I need to know how to trigger the default callbacks from
    within my own callbacks so that my &tree_opencmd() and &tree_closecmd() callbacks can do useful things *as*well*as* open/close the branch of the
    tree. I'd like the &tree_command() callback to also be able to open/close
    the tree branch as well.

    Anyone know how to get hold of, and later invoke, the default callbacks?


    ---
    þ Synchronet þ Programatically generated on The ANJO BBS
  • From Angus McLeod@VERT/ANJO to All on Tuesday, June 06, 2006 23:52:00
    Well, I don't much like it, but I've found a way. Here are my (still
    stubby) callbacks:

    sub tree_command {
    my $ent = shift;
    my $mode = $tree->getmode( $ent );
    print "tree_command( $ent ); # mode is $mode;\n";
    if ($mode eq 'open') {
    print "Tk::Tree::OpenCmd( \$tree, $ent );\n";
    print "\$tree->setmode( $ent, 'close' );\n";
    Tk::Tree::OpenCmd( $tree, $ent );
    $tree->setmode( $ent, 'close' );

    } elsif ($mode eq 'close') {
    # closing a t
    print "Tk::Tree::CloseCmd( $tree, $ent );\n";
    print "\$tree->setmode( $ent, 'open' );\n";
    Tk::Tree::CloseCmd( $tree, $ent );
    $tree->setmode( $ent, 'open' );
    } else {
    # not a top-level (openable/closeable) tree entry
    }
    }

    sub tree_closecmd {
    my $ent = shift;
    print "tree_closecmd( $ent )\n";
    Tk::Tree::OpenCmd( $tree, $ent );
    }

    sub tree_opencmd {
    my $ent = shift;
    print "tree_opencmd( $ent )\n";
    Tk::Tree::CloseCmd( $tree, $ent );
    }

    By spelunking through the source for Tk::Tree I found that the default callbacks were called &CloseCmd() and &OpenCmd(). So after my callbacks
    run my code, I call the default callbacks directly, with a fully qualified name. The only thing partly tricky is for &tree_cpmmand() which must
    use &getmode() to determine whether the top-level entry is to be opened or closed, and the &setmode() after it has been opened/closed to keep track.

    It works, but it's ugly. I'd have prefered some method that returns a
    coderef for the default callbacks. I'd store the coderef replace it with
    my own callback, and call the stored coderef from my function as needed.

    Hmmmm. Why didn't I think of that before?


    ---
    þ Synchronet þ Programatically generated on The ANJO BBS
  • From Deuce@VERT/SYNCNIX to Angus McLeod on Tuesday, June 06, 2006 22:49:00
    Re: Tk::Tree
    By: Angus McLeod to All on Wed Jun 07 2006 04:44 am

    Anyone know how to get hold of, and later invoke, the default callbacks?

    I've never tried it, but assuming the default callback isn't a Tcl command string, you should be able to use $w->optionGet() after creating the object to tuck away a reference to the original callback, then set the callback using $w->optionAdd().

    If it *is* a command string then I can't help you as I'm not sure how to execute Tcl from perl.

    ---
    I find pleasure in knowing... this colours my words enough that people think I enjoy proving them wrong. Howver, I would be just as happy being proven wrong and knowing more than proving myself right. Please understand that any perceived rudeness is not intended. Rest assured that should I feel like being purposely rude, I will insult you personally and not attack your knowledge.

    ---
    þ Synchronet þ My Brand-New BBS (All the cool SysOps run STOCK!)
  • From Angus McLeod@VERT/ANJO to Deuce on Wednesday, June 07, 2006 11:26:00
    Re: Tk::Tree
    By: Deuce to Angus McLeod on Tue Jun 06 2006 22:49:00

    Re: Tk::Tree
    By: Angus McLeod to All on Wed Jun 07 2006 04:44 am

    Anyone know how to get hold of, and later invoke, the default callbacks?

    I've never tried it, but assuming the default callback isn't a Tcl command string, you should be able to use $w->optionGet() after creating the object tuck away a reference to the original callback, then set the callback using $w->optionAdd().

    Hmmm. I'll look at optionGet() and see if it can help. Not so sure about using optionAdd() tho. What I'd like is to get a coderef for the old callback, and store it in a scalar. Then when I need to run it I could do something like &{$old_cb_coderef}() to trigger the original behaviour.

    I *did* look at $old_cb = $tree->cget( '-opencmd' ); but unfortunately,
    it does not return a coderef. Therefore, I have to do something like

    &{"Tk::Tree::$old_cb"}();

    to call it. (by name rather than by actual coderef.)

    In order for $tree->cget() to work, I have to create the tree withOUT specifying the callbacks, then use cget(), then use configure() to set
    each re-placement callback. Ugly!

    If it *is* a command string then I can't help you as I'm not sure how to execute Tcl from perl.

    Exactly. That's why I was hoping for a coderef. With a coderef, it
    shouldn't matter *how* the callback is implemented -- you just run it!

    ---
    þ Synchronet þ Programatically generated on The ANJO BBS