#!/usr/bin/perl

use strict;
use Tk;
use Tk::HList;

my $noderef = create_nodes();

my $mw = MainWindow->new();
my $label = $mw->Label(-width=>15);
my $hlist = $mw->HList(
                       -itemtype   => 'text',
                       -separator  => '.',
                       -selectmode => 'single',
                       -browsecmd  => sub {
                           my $path = shift;
                           $label->configure(-text=>$path);
                       }
                      );
my $button = $mw->Button(-text    => 'Move to Top',
                         -command => [ \&rearrange, $hlist, $noderef ],
                        );
add_to_hlist( $hlist, $noderef );

$hlist->pack;
$label->pack;
$button->pack;

MainLoop;

sub create_nodes
{
    my %nodehash = ( n1 => { -text => "top_level_1",
                              -data => "first piece of data" },
                     'n1.1' => { -text => "first_child_of_1",
                                 -data => "2nd data piece" },
                     'n1.2' => { -text => "second_child_of_1",
                                 -data => "3rd data" },
                     n2 => { -text => "top_level_2",
                             -data => "4th piece of data" },
                     'n2.1' => { -text => "1st_child_of_2",
                                 -data => "5th data piece" },
                     'n2.2' => { -text => "2nd_child_of_2",
                                 -data => "6th data" },
                   );
    return \%nodehash;
}

sub add_to_hlist
{
    my ( $hlist, $noderef, $which ) = @_;
    my @to_add;
    my %at = ();
    if ( $which ) {
        @to_add = sort grep /^$which/, keys %$noderef;
        %at = ( -at => 0 );
    }
    else {
        @to_add = sort keys %$noderef;
    }
    for ( @to_add ) {
        $hlist->add($_, %at);
        if ( $which ) { $at{-at}++; }
        for my $attrib ( keys %{$$noderef{$_}} ) {
            $hlist->entryconfigure( $_, $attrib, $$noderef{$_}{$attrib} );
        }
    }
}

sub rearrange
{
    my ( $hl, $nl ) = @_;
    my $anchor = $hl->info( 'anchor' );
    printf( "anchor = %s whose data is '%s'\n",
            $anchor, $hl->info( 'data', $anchor ));

    my $parent = $hl->info( 'parent', $anchor ) || $anchor;
    while ( my $higher = $hl->info( 'parent', $parent )) {
        $parent = $higher;
    }
    printf( "top-level = %s which follows %s\n\n",
            $parent, $hl->info( 'prev', $parent ));
    $hl->delete( 'entry', $parent );
    add_to_hlist( $hl, $nl, $parent );
}