Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

How to create/delete headers in MTree

by ghosh123 (Monk)
on Feb 29, 2012 at 19:17 UTC ( #957005=perlquestion: print w/ replies, xml ) Need Help??
ghosh123 has asked for the wisdom of the Perl Monks concerning the following question:

Hi Monks, I am working with MTree. But I am not able to create or delete a header in MTree. Please help.

use Tk; require "/home/ghosh/personal/tk_perl/HListplus.pm"; require "/home/ghosh/personal/tk_perl/MTree.pm"; my $mw = MainWindow->new(); my $frame = $mw->Frame()->pack(); my $tree = $frame->Scrolled( 'MTree', -height => 20, -width => 50, -columns => 4, ); $tree->add(ROOT_ITEM_PATH, -itemtype => 'text', -text => 'Jobs for tes +t'); $tree->header('create', 1 , -itemtype => 'text',-text => 'Cells',); $tree->header('create', 1 , -itemtype => 'text',-text => 'ID',);

I am not getting the columns 'Cells' and 'ID'. Also suggest how can I delete any of those created columns. I need it in Mtree only. Thanks.

Comment on How to create/delete headers in MTree
Download Code
Re: How to create/delete headers in MTree
by Anonymous Monk on Mar 01, 2012 at 03:36 UTC

      Hi, I meant Mtree, NOT MListplus. For your perusal I am including the Mtree.pm code here. It also uses HListplus.pm. You can find HListplus.pm in cpan,http://search.cpan.org/~mikra/Tk-MK-0.21/lib/Tk/HListplus.pm

      package Tk::MTree; # Tree -- TixTree widget # # Derived from Tree.tcl in Tix 4.1 # use vars qw($VERSION); $VERSION = '4.005'; # $Id: //depot/Tkutf8/Tixish/Tree.pm#5 $ use Tk (); use Tk::Derived; use Tk::HListplus; use base qw(Tk::Derived Tk::HListplus); use strict; Construct Tk::Widget 'MTree'; sub Tk::Widget::ScrlMTree { shift->Scrolled('MTree' => @_) } sub Populate { my( $w, $args ) = @_; $w->SUPER::Populate( $args ); $w->ConfigSpecs( -ignoreinvoke => ['PASSIVE', 'ignoreInvoke', 'IgnoreInvoke', +0], -opencmd => ['CALLBACK', 'openCmd', 'OpenCmd', 'Open +Cmd' ], -indicatorcmd => ['CALLBACK', 'indicatorCmd', 'IndicatorCmd', +'IndicatorCmd'], -closecmd => ['CALLBACK', 'closeCmd', 'CloseCmd', 'Clo +seCmd'], -indicator => ['SELF', 'indicator', 'Indicator', 1], -indent => ['SELF', 'indent', 'Indent', 20], -width => ['SELF', 'width', 'Width', 20], -itemtype => ['SELF', 'itemtype', 'Itemtype', 'imagetext'] +, -foreground => ['SELF'], ); } sub autosetmode { my( $w ) = @_; $w->setmode(); } sub IndicatorCmd { my( $w, $ent, $event ) = @_; my $mode = $w->getmode( $ent ); if ( $event eq '<Arm>' ) { if ($mode eq 'open' ) { $w->_indicator_image( $ent, 'plusarm' ); } else { $w->_indicator_image( $ent, 'minusarm' ); } } elsif ( $event eq '<Disarm>' ) { if ($mode eq 'open' ) { $w->_indicator_image( $ent, 'plus' ); } else { $w->_indicator_image( $ent, 'minus' ); } } elsif( $event eq '<Activate>' ) { $w->Activate( $ent, $mode ); $w->Callback( -browsecmd => $ent ); } } sub close { my( $w, $ent ) = @_; my $mode = $w->getmode( $ent ); $w->Activate( $ent, $mode ) if( $mode eq 'close' ); } sub open { my( $w, $ent ) = @_; my $mode = $w->getmode( $ent ); $w->Activate( $ent, $mode ) if( $mode eq 'open' ); } sub getmode { my( $w, $ent ) = @_; return( 'none' ) unless $w->indicatorExists( $ent ); my $img = $w->_indicator_image( $ent ); return( 'open' ) if( $img eq 'plus' || $img eq 'plusarm' ); return( 'close' ); } sub setmode { my ($w,$ent,$mode) = @_; unless (defined $mode) { $mode = 'none'; my @args; push(@args,$ent) if defined $ent; my @children = $w->infoChildren( @args ); if ( @children ) { $mode = 'close'; foreach my $c (@children) { $mode = 'open' if $w->infoHidden( $c ); $w->setmode( $c ); } } } if (defined $ent) { if ( $mode eq 'open' ) { $w->_indicator_image( $ent, 'plus' ); } elsif ( $mode eq 'close' ) { $w->_indicator_image( $ent, 'minus' ); } elsif( $mode eq 'none' ) { $w->_indicator_image( $ent, undef ); } } } sub Activate { my( $w, $ent, $mode ) = @_; if ( $mode eq 'open' ) { $w->Callback( -opencmd => $ent ); $w->_indicator_image( $ent, 'minus' ); } elsif ( $mode eq 'close' ) { $w->Callback( -closecmd => $ent ); $w->_indicator_image( $ent, 'plus' ); } else { } } sub OpenCmd { my( $w, $ent ) = @_; # The default action foreach my $kid ($w->infoChildren( $ent )) { $w->show( -entry => $kid ); } } sub CloseCmd { my( $w, $ent ) = @_; # The default action foreach my $kid ($w->infoChildren( $ent )) { $w->hide( -entry => $kid ); } } sub Command { my( $w, $ent ) = @_; return if $w->{Configure}{-ignoreInvoke}; $w->Activate( $ent, $w->getmode( $ent ) ) if $w->indicatorExists( $en +t ); } sub _indicator_image { my( $w, $ent, $image ) = @_; my $data = $w->privateData(); if (@_ > 2) { if (defined $image) { $w->indicatorCreate( $ent, -itemtype => 'image' ) unless $w->indicatorExists($ent); $data->{$ent} = $image; $w->indicatorConfigure( $ent, -image => $w->Getimage( $image ) ); } else { $w->indicatorDelete( $ent ) if $w->indicatorExists( $ent ); delete $data->{$ent}; } } return $data->{$ent}; } 1;

        Hello, I made a small mistake in creating the columns. I have corrected that. Now I want to delete a particular column upon a press of a button on the window. Please see the attached code below.

        /usr/bin/perl use Tk; require "/home/kumar/personal/tk_perl/HListplus.pm"; require "/home/kumar/personal/tk_perl/MTree.pm"; my $mw = MainWindow->new(); my $frame = $mw->Frame()->pack(); my $tree = $frame->Scrolled( 'MTree', -height => 20, -width => 50, -columns => 4, -itemtype => 'text', -header => 'true', ); $tree->add(ROOT_ITEM_PATH, -itemtype => 'text', -text => 'Jobs for tes +t'); $tree->header('create', 0 , -itemtype => 'text',-text => 'Cells',); $tree->pack; $tree->header('create', 1 , -text => 'ID'); $tree->header('create', 2 , -text => 'State'); $frame->Button(-text => 'Delete col', -command => sub { $tree->header( +'delete',2,-text=> 'State');})->pack; MainLoop;

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://957005]
Front-paged by Arunbear
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (14)
As of 2014-07-30 12:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (231 votes), past polls