# PilotManager: A tool suite to sync your Unix box with a USRobotics PalmPilot
# Copyright (C) 1997 Bharat Mediratta
# 
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 1, or (at your option)
# any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
# 
#
# Convenience functions for TkPerl
#
# ident "@(#)TkUtils.pm 1.5     97/08/01 Bharat Mediratta"
#
#
package TkUtils;

use Tk;
use Exporter;

# Export properly 
#
@ISA = (Exporter);
@EXPORT = qw(AlignedLabelEntries
	     Button
	     Checkbutton
	     Entry
	     Label
	     LabelEntry
	     LabelRadiobuttons
	     LabelVar
	     List
	     Menu
	     Radiobuttons
	     Text
	     Version
	     inswt);

sub AlignedLabelEntries
{
    my ($parent, @list) = @_;
    my ($frame, $lframe, $eframe);
    my (@labels, @entries);

    $frame = $parent->Frame;
    $lframe = $frame->Frame;
    $eframe = $frame->Frame;

    while (($tag, $var) = splice(@list, 0, 2))
    {
	my ($label, $entry);
	$label = Label($lframe, $tag);
	$entry = Entry($eframe, $var);

	push(@labels, $label);
	push(@entries, $entry);
    }
    $lframe->pack (-side => 'left');
    $eframe->pack (-side => 'left');

    return (\@labels, \@entries);
}

sub Label
{
    my ($parent, $msg) = @_;

    $label = $parent->Label(-text => $msg,
			    -borderwidth => 4);
    $label->pack(-anchor => "nw");

    return($label);
}

sub LabelVar
{
    my ($parent, $msg, $var) = @_;
    my ($label1, $label2);
    my ($subframe);

    $label1 = &Label($parent, $msg);
    $label1->pack(-anchor => "ne");
    
    $label2 = $parent->Label(-textvariable => $var,
			     -borderwidth => 4);
    $label2->pack(-anchor => "ne");

    return ($label1, $label2);
}

sub Menu
{
    my ($parent, $title, $cmd, @menuEntries) = @_;
    my ($menu, $submenu, $option);
    my ($packable);

    if (ref $parent eq "Tk::Frame")
    {
	$menu = $parent->Menubutton(-text => $title,
				    -relief => "raised");
	$packable = 1;
    }
    elsif (ref $parent eq "Tk::Menubutton")
    {
	my ($parentmenu) = $parent->cget(-menu);
	$menu = $parentmenu->Menu;
    }
    else
    {
	die "Unknown parent: $parent\n";
    }

    while (($option, $submenu) = splice(@menuEntries, 0, 2))
    {
	if ($submenu && @$submenu)
	{
	    # This entry contains a submenu
	    # Run Menu again with the contents of
	    # the submenu.
	    $menu->cascade(-label => $option);
	    $submenu = Menu($menu, 
			    "$title / $option", 
			    $cmd, 
			    @$submenu);
	    $menu->entryconfigure($option,
				  -menu => $submenu);
	}
	else
	{
	    if ($option eq "-")
	    {
		$menu->separator;
	    }
	    else
	    {
		$menu->command(-label => $option,
			       -command => 
			       eval qq{sub{\&\$cmd("$title / $option")}});
	    }
	}
	$menu->pack(-anchor => "nw",
		    -side => "top")
	    if ($packable);
    }
    return($menu);
}

sub LabelEntry
{
    my ($parent, $msg, $var) = @_;
    my ($label, $entry, $frame);

    $frame = $parent->Frame;
    $label = $frame->Label(-text => $msg);
    $label->pack(-side => "left",
		 -anchor => "nw",
		 -fill => "x");
    $entry = $frame->Entry(-textvariable => $var,
			   -relief => "sunken");
    $entry->pack(-anchor => "w",
		 -fill => "x");
    $frame->pack(-side => "top",
		 -fill => "x");

    return($label, $entry);
}


sub Entry
{
    my ($parent, $var) = @_;
    my ($entry);

    $entry = $parent->Entry(-textvariable => $var,
			    -relief => "sunken");
    $entry->pack(-anchor => "w",
		 -fill => "x");

    return($entry);
}


sub Text
{
    my ($parent, $title) = @_;
    my ($text, $label, $frame);

    $frame = $parent->Frame;

    if ($title ne "")
    {
	$label = &Label($frame, "$title");
	$label->pack(-anchor => "c");
    }
	

    $text = $frame->Text(-wrap => "word",
			  -width => 80,
			  -height => 10);
    
    $text_sb = $frame->Scrollbar(-command => ['yview', $text]);
    $text_sb->pack(-side => "right",
		   -fill => "y");
    $text_sb->configure(-takefocus => 0);

    $text->configure(-yscrollcommand => ['set', $text_sb]);

    $text->pack(-fill => "both",
		-expand => "true");
    $frame->pack(-fill => "both",
		-expand => "true");

    return($text, $label);
}

sub Button
{
    my ($parent, $title, $command) = @_;
    my ($button);

    $button = $parent->Button(-text => $title,
			      -command => eval qq{sub {\&\$command}});
    $button->pack;

    return($button);
}

sub List
{
    my ($parent, $title, $scroll) = @_;
    my ($list);

    my ($frame) = $parent->Frame;

    if ($title ne "")
    {
	$label = &Label($frame, "$title");
	$label->pack(-anchor => "c");
    }

    $list = $frame->Listbox(-selectmode => "browse");

    if ($scroll =~ /vertical/)
    {
	my($scrollbar) = $frame->Scrollbar(-command => [$list => "yview"]);
	$scrollbar->pack(-side => "right",
			 -fill => "y");
	$list->configure(-yscrollcommand => [$scrollbar => "set"]);
    }

    if ($scroll =~ /horizontal/)
    {
	my($scrollbar) = $frame->Scrollbar(-orient => "horizontal",
					   -command => [$list => "xview"]);
	$scrollbar->pack(-side => "bottom",
			 -fill => "x");
	$list->configure(-xscrollcommand => [$scrollbar => "set"]);
    }

    $list->pack(-side => "top",
		-expand => "true",
		-fill => "both");

    $frame->pack(-expand => "true",
		 -fill => "both");

    return($list, $label);
}

sub LabelRadiobuttons
{
    my ($parent, $title, $var, @buttons) = @_;
    my ($label, @rb);

    $label = &Label($parent, $title);
    $label->pack(-side => "left",
		 -anchor => "nw");
    
    @rb = &Radiobuttons($parent, $var, @buttons);

    return($label, @rb)
}    

sub Radiobuttons
{
    my ($parent, $var, @buttons) = @_;
    my ($b, $i, @rb);
   
    $i = 0;
    foreach $b (@buttons)
    {
	$rb[$i] = $parent->Radiobutton(-text => $b,
				       -variable => $var,
				       -value => $b);
	$rb[$i]->pack(-side => "left",
		      -anchor => "w");
	$i++;
    }

    return(@rb)
}    

sub Checkbutton
{
    my ($parent, $title, $var) = @_;
    my ($b);

    $b = $parent->Checkbutton(-text => $title,
			      -variable => $var);
    $b->pack(-side => "left",
	     -anchor => "w");

    return($b);
}

sub inswt {

    # insert_with_tags
    #
    # The procedure below inserts text into a given text widget and applies
    # one or more tags to that text.  The arguments are:
    #
    # w         Window in which to insert
    # text      Text to insert (it's inserted at the "insert" mark)
    # args      One or more tags to apply to text.  If this is empty then all
    #           tags are removed from the text.

    my($w, $text, @args) = @_;
    my($tag, $i, $start);

    $start = $w->index('insert');
    $w->insert('insert', $text);
    foreach $tag ($w->tag('names', $start)) {
        $w->tag('remove', $tag, $start, 'insert');
    }
    foreach $i (@args) {
        $w->tag('add', $i, $start, 'insert');
    }

} # end inswt


sub Version
{
    return("1.5");
}

1;
