package QWizard::Generator::Tk;

#
# TODO:
#  - better layout; currently ugly
#  - bar support
#  - left/right side support

use strict;
my $VERSION = '3.15';
use Tk;
use Tk::Table;
use Tk::Pane;
use Tk::FileSelect;
require Exporter;
use QWizard::Generator;

@QWizard::Generator::Tk::ISA = qw(Exporter QWizard::Generator);

my $have_gd_graph = eval { require GD::Graph::lines; };
my $have_tk_tree = eval { require Tk::Tree; };
my $have_tk_png = eval { require Tk::PNG; };

sub new {
    my $type = shift;
    my ($class) = ref($type) || $type;
    my $self = {'keep_working_hook' => \&QWizard::Generator::backup_params};
    for (my $i = 0; $i <= $#_; $i += 2) {
	$self->{$_[$i]} = $_[$i+1];
    }
    bless($self, $class);
    $self->add_handler('text',\&QWizard::Generator::Tk::do_entry,
		       [['single','name'],
			['default'],
			['forced','0'],
			['single','size'],
			['single','maxsize'],
			['single','submit'],
			['single','refresh_on_change']]);
    # XXX: we need to do a real text box
    $self->add_handler('textbox',\&QWizard::Generator::Tk::do_textbox,
		       [['single','name'],
			['default'],
			['single','size'],
			['single','width'],
			['single','height']]);
    $self->add_handler('hidetext',\&QWizard::Generator::Tk::do_entry,
		       [['single','name'],
			['default'],
			['forced','1'],
			['single','size'],
			['single','maxsize'],
			['single','submit'],
			['single','refresh_on_change']]);
    $self->add_handler('checkbox',\&QWizard::Generator::Tk::do_checkbox,
		       [['multi','values'],
			['default'],
			['single','button_label']]);
    $self->add_handler('multi_checkbox',
		       \&QWizard::Generator::Tk::do_multicheckbox,
		       [['multi','default'],
			['values,labels']]);
    $self->add_handler('menu',
		       \&QWizard::Generator::Tk::do_menu,
		       [['values,labels'],
			['default'],
			['single','name']]);
    $self->add_handler('radio',
		       \&QWizard::Generator::Tk::do_radio,
		       [['values,labels', "   "],
			['default'],
			['single','name']]);
    $self->add_handler('label',
		       \&QWizard::Generator::Tk::do_label,
		       [['multi','values']]);
    $self->add_handler('paragraph',
		       \&QWizard::Generator::Tk::do_paragraph,
		       [['multi','values'],
			['single','preformatted'],
			['single','width']]);
    $self->add_handler('button',
		       \&QWizard::Generator::Tk::do_button,
		       [['single','values'],
			['default']]);
    $self->add_handler('table',
		       \&QWizard::Generator::Tk::do_table,
		       [['norecurse','values'],
			['norecurse','headers']]);
    $self->add_handler('graph',
		       \&QWizard::Generator::Tk::do_graph,
		       [['norecurse','values'],
			['norecursemulti','graph_options']]);
    $self->add_handler('image',
		       \&QWizard::Generator::Tk::do_image,
		       [['norecurse','imgdata'],
			['norecurse','image'],
			['single','imagealt']]);
    $self->add_handler('fileupload',
		       \&QWizard::Generator::Tk::do_fileupload,
		       [['default','values']]);
    $self->add_handler('filedownload',
		       \&QWizard::Generator::Tk::do_filedownload,
		       [['default','values']]);

    $self->add_handler('unknown',
		       \&QWizard::Generator::Tk::do_unknown,
		       []);

    $self->init_default_storage();
    return $self;
}

sub goto_top {
    my $self = shift;
    my $wiz = shift;
    $self->unmake_top();
    $wiz->reset_qwizard();
}

sub goto_next {
#     print STDERR "-----\n";
#     for (my $i = 0; $i <= $#_; $i++) {
# 	print STDERR "next $i: $_[$i]\n";
#     }
#     my @stuff = caller(1);
#     print STDERR "$stuff[1] $stuff[2] -> $stuff[3]\n";
#     my @stuff = caller(2);
#     print STDERR "$stuff[1] $stuff[2] -> $stuff[3]\n";
#     my @stuff = caller(3);
#     print STDERR "$stuff[1] $stuff[2] -> $stuff[3]\n";
#     my @stuff = caller(4);
#     print STDERR "$stuff[1] $stuff[2] -> $stuff[3]\n";
#     print STDERR "-----\n";
    shift if (ref($_[0]) ne 'QWizard::Generator::Tk');
    my ($self, $ignorefirst_or_varname, $refresh_on_change, $val) = @_;
    if ($ignorefirst_or_varname &&
	ref($ignorefirst_or_varname) eq 'SCALAR' && $$ignorefirst_or_varname) {
	$$ignorefirst_or_varname--;
	return;
    } elsif (ref($ignorefirst_or_varname) ne 'SCALAR') {
	if ($ignorefirst_or_varname) {
	    $self->qwparam($ignorefirst_or_varname, $val);
	}
    }
    if ($refresh_on_change) {
	$self->qwparam('redo_screen',1);
    }

    $self->unmake_top();
#    print STDERR "-----x\n";
}

sub goto_prev {
    my ($self) = @_;
    $self->revert_params();
    $self->unmake_top();
}

sub our_mainloop {
    my $self = shift;
    while ($self->{'qtable'} && Tk::MainWindow->Count) {
	if ($self->{'nextf'}) {
	    $self->{'nextf'}->focus();
	    $self->{'nextf'} = undef;
	}
	DoOneEvent(0);
    }
}

sub unmake_top {
    my $self = shift;
    $self->{'qtable'}->destroy() if ($self->{'qtable'});
    $self->{'qtable'} = undef;
}

sub make_top {
    my $self = shift;
    $self->unmake_top();

    if (!$self->{'top'}) {
	$self->{'top'} = $self->{'window'}->Frame();
	$self->{'top'}->pack(-expand => 1, -fill => 'both');
	my $haveballoon = eval {require Tk::Balloon;};
	if ($haveballoon) {
	    $self->{'balloon'} = $self->{'top'}->Balloon();
	}
    }

    my $px = $self->{'top'}->width();
    my $py = $self->{'top'}->height();
    $px = $self->{'qwidth'} || 600 if ($px < 600);
    $py = $self->{'qheight'} || 500 if ($py < 500);

    if (!$self->{'qtitle'}) {
	$self->{'qtitle'} = $self->{'top'}->Label();
	$self->{'qtitle'}->pack(-side => 'top');
    }
    if (!$self->{'qintro'}) {
	$self->{'qintro'} = $self->{'top'}->Scrolled('Text',
						     -scrollbars => 'w',
						     -width => $px, 
						     -height => 200,
						     -wrap => 'word',
						     -relief => 'flat');
	$self->{'qintro'}->pack(-side => 'top', -expand => 1, -fill => 'both');
    }
    if (!$self->{'qpane'}) {
	$self->{'qpane'} = $self->{'top'}->Scrolled('Pane', -width => $px, 
						    -height => $py,
						    -sticky => 'nsew');
	$self->{'qpane'}->pack(-expand => 1, -fill => 'both');
    }
    $self->{'qtable'} = $self->{'qpane'}->Table(-rows => 200,
						-columns => 10,
						-scrollbars => '');
    $self->{'qtable'}->pack(-expand => 1, -fill => 'both');

    # we make some decisions based on which table we're currently
    # pointing at; thus remember the original.
    $self->{'origqtable'} = $self->{'qtable'};
}

sub init_screen {
    my ($self, $wiz, $title) = @_;
    if (!$self->{'window'}) {
	$self->{'window'} = new MainWindow(
					-title => $title,
					#-background => $self->{'bgcolor'} || $wiz->{'bgcolor'} || "#ffffff"
				       );
	$self->{'tktitle'} =
	  $self->{'window'}->Label(-text => $title,
				   -relief => 'raised',
				   -foreground => '#ffa26c',
				   -background => $self->{'bgcolor'} ||
				                  $wiz->{'bgcolor'} ||
				                  "#ffffff");
	$self->{'tktitle'}->pack(-expand => 1, -fill => 'x', -side => 'top');
    }
    $self->make_top();
    $self->{'qadd'} = 0;
}

sub do_ok_cancel {
  my ($self, $nexttext, $wiz, $dontdocan) = @_;
  if (!$self->{'bot'}) {
      $self->{'bot'} = $self->{'top'}->Frame(-relief => 'raised',
					     -borderwidth => 3);
      if (!$self->{'prevbut'}) {
	  $self->{'prevbut'} = 
	    $self->{'bot'}->Button(-text => ($wiz->{'back_text'} || 
						 'Back'),
				   -command => [\&goto_prev, 
						$self]);
	  $self->{'prevbut'}->pack(-side => 'left');
      }
      if (!$self->{'nextbut'}) {
	  my $text =
	    QWizard::Generator::remove_accelerator($nexttext  ||
						   $wiz->{'next_text'} || 
						   'Next');
	  $self->{'nextbut'} = 
	    $self->{'bot'}->Button(-text => $text,
				   -command => [\&goto_next, 
						$self]);
	  $self->{'nextbut'}->pack(-side => 'left');
      }
      if (! $dontdocan) {
	  if (!$self->{'canbut'}) {
	      $self->{'canbut'} = 
		$self->{'bot'}->Button(-text => ($wiz->{'cancel_text'} || 
						 'Cancel'),
				       -command => [\&goto_top, $self, $wiz]);
	      $self->{'canbut'}->pack(-side => 'right');
	  }
      }
      $self->{'bot'}->pack(-expand => 1, -fill => 'x');
  } else {
      my $text =
	QWizard::Generator::remove_accelerator($nexttext || 'Ok');
      $self->{'nextbut'}->configure(-text => $text);
  }

  # see if we have backup places to get to.  If not, grey out the button
  if ($#{$self->{'backupvars'}} > -1) {
      $self->{'prevbut'}->configure(-state => 'normal');
  } else {
      $self->{'prevbut'}->configure(-state => 'disabled');
  }
}


# put stuff at a particular spot in the current table
sub put_it {
    my ($self, $w, $row, $col) = @_;
    if (!$row) {
	if (exists($self->{'currentrow'}) && defined($self->{'currentrow'})) {
	    $row = $self->{'currentrow'};
	} else {
	    $row = $self->{'currentq'};
	}
    }
    if (!$col) {
	if (exists($self->{'currentcol'}) && defined($self->{'currentcol'})) {
	    $col = $self->{'currentcol'};
	} else {
	    $col = 2;
	}
    }

    # remove the temp assignments

    if (ref($w) eq '') {
	$w = $self->{'qtable'}->Label(-text => $w,
				      -anchor => 'w');
    }

    # place the item in the table
    $self->{'qtable'}->put($row, $col, $w);

    # bind the tab and alt-tab key presses to forward and backward widgets
    if (ref($w) =~ /Entry|Menu|Text|Button|Checkbutton|Radio|Optionmenu/) {
	if ($self->{'lastw'}) {
	    $self->{'lastw'}->bind('<Tab>',[\&tab_next, $w, $self]);
	    $w->bind('<Alt-Key-Tab>',[\&tab_next, $self->{'lastw'}, $self]);
	}
	$self->{'lastw'} = $w;
    }
}

sub tab_next {
    # forcing the focus here doesn't work (I suspect because the top
    # level tab binding gets called after us and takes precidence and
    # focuses away from our containing table.  Thus we save our focus
    # call for even later)
    $_[2]->{'nextf'} = $_[1];
}

sub set_default {
    my ($self, $q, $def) = @_;
    $self->qwparam($q->{'name'}, $def) if ($def && $self->qwparam($q->{'name'}) ne $def);
}

######################################################################
# QWizard functions for doing stuff.

sub wait_for {
  my ($self, $wiz, $next) = @_;
  $self->do_ok_cancel($next, $wiz);
  $self->our_mainloop();
  return 1;
}

sub do_error {
    my ($self, $q, $wiz, $p, $err) = @_;
    $self->{'currentq'}++;
    $self->{'qadd'}++;
    $self->put_it($self->{'qtable'}->Label(-text => $err, 
					   -foreground => 'red'),
		  undef, 1);

}

sub do_question {
    my ($self, $q, $wiz, $p, $text, $qcount) = @_;
    my $top = $self->{'qtable'};

    $self->{'currentq'} = $qcount + $self->{'qadd'};
    return if (!$text && $self->{'qtable'} != $self->{'origqtable'});

    #
    # Get the actual help text, in case this is a subroutine.
    #
    my $helptext = $q->{'helpdesc'};
    if (ref($helptext) eq "CODE") {
	$helptext = $helptext->();
    }

    $text = "    $text" if ($q->{'indent'});
    if ($helptext && !$self->qwpref('usehelpballons')) {
	my $f = $top->Frame();
	$f->Label(-text => $text, -anchor => 'nw')->pack(-anchor => 'w');
	$helptext = "    $helptext" if ($q->{'indent'});
	$helptext = " $helptext";
	my $height = int(length($helptext)/40)+1;
	my $t = $f->Text(-width => 40,
			 -height => $height,
			 -relief => 'flat',
			 -wrap => 'word',
			 -font => 'Helvetica 12 italic')
	  ->pack(-anchor => 'w');
	$t->insert('end', $helptext);
	$self->put_it($f, undef, 1);
    } else {
	my $l = $top->Label(-text => $text, -anchor => 'nw');
	$self->put_it($l, undef, 1);
	if ($self->{'balloon'} && $helptext) {
	    $self->{'balloon'}->attach($l, -balloonmsg => $helptext);
	    # XXX: change the "help" window text, which doesn't exist yet.
	}
    }
}

sub start_questions {
    my ($self, $wiz, $p, $title, $intro) = @_;
    if ($title) {
	$self->{'qtitle'}->configure(-text => $title);
    }
	
    $self->{'qintro'}->delete('1.0','end');
    if ($intro) {
	$self->{'qintro'}->configure(-height => (length($intro)/80 + 1));
	$self->{'qintro'}->insert('end',$intro);
    } else {
	$self->{'qintro'}->configure(-height => 0);
    }
}

sub end_questions {
    my $self = shift;
    # this makes us keep adding new table rows during a merge
    $self->{'qadd'} = $self->{'currentq'} + 1;
    $self->{'lastw'} = undef;
}


##################################################
# widgets
##################################################

sub get_extra_args {
    my ($self, $q, $wiz) = @_;

    my @args;

    if (($q->{'submit'} || $q->{'refresh_on_change'}) &&
      $q->{type} ne 'text') {
	my $ignorefirst = 0;
	if ($q->{'type'} eq 'menu') {
	    # menus do an initial call immediately after being created.
	    # we use this hack to ignore the first call to the function.
	    # (did I mention "sigh"?)
#	    my $wehere = $self->qwparam('redo_screen');
#	    print "setting ignoring first: $wehere\n";
#	    $ignorefirst = 1 unless($wehere eq '') ;
	    $ignorefirst = 1;
	}
	push @args, '-command', [\&goto_next, $self, \$ignorefirst,
				 $q->{'refresh_on_change'}];
    }
    return \@args;
}

sub make_check {
    my ($self, $name, $text, $on, $off, $top, $defval) = @_;

    my $x = "hi";
    $top = $self->{'qf'} if (!$top);
    $top->Checkbutton(-textvariable => \$text,
		      -variable => \$self->{'datastore'}{'vars'}{$name},
		      -anchor => 'w')
      ->pack(-side => 'top', -expand => 1, -fill => 'x');
}


sub do_button {
    my ($self, $q, $wiz, $p, $vals, $def) = @_;
    my $but = $self->{'qtable'}->Button(-text => $vals,
					-command => [\&goto_next, 
						     $self, $q->{'name'},
						     $q->{'refresh_on_change'},
						     $def]);
    $self->put_it($but);
}

sub do_checkbox {
    my ($self, $q, $wiz, $p, $vals, $def, $button_label) = @_;
    $vals = [1, 0] if ($#$vals == -1);
    my $chk = $self->{'qtable'}->Checkbutton(-anchor => 'w',
  					     -onvalue => $vals->[0],
  					     -offvalue => $vals->[1],
					     -text => $button_label,
					     -variable => 
					     \$self->{'datastore'}{'vars'}{$q->{'name'}},
					     @{$self->get_extra_args($q, $wiz,
								     $p)}
					    );
    $self->put_it($chk);
    $self->set_default($q, $def);
}

sub do_multicheckbox {
    my ($self, $q, $wiz, $p, $defs, $vals, $labels) = @_;
    my $tf = $self->{'qtable'}->Frame();
    my $count = -1;
    foreach my $v (@$vals) {
	$count++;
	my $l = (($labels->{$v}) ? $labels->{$v} : "$v");
	make_check($self, $q->{'name'} . $l, $l, $v, '', $tf);
	push @{$wiz->{'passvars'}},$q->{'name'} . $v;
	$self->{'datastore'}->set($v, $defs->[$count]);
    }
    $self->put_it($tf);
}

sub do_radio {
    my ($self, $q, $wiz, $p, $vals, $labels, $def, $name) = @_;
    my $tf = $self->{'qtable'}->Frame();

    my $widargs = $self->get_extra_args($q, $wiz, $p);

    foreach my $val (@$vals) {
	my $text = (($labels->{$val}) ? $labels->{$val} : "$val");
	$tf->Radiobutton(-value => $val, -textvariable => \$text,
			 -variable => \$self->{'datastore'}{'vars'}{$name},
			 -anchor => 'w',
			 @{$self->get_extra_args($q, $wiz, $p)})
	  ->pack(-side => 'top', -fill => 'x', -expand => 1);
    }
    $self->put_it($tf);

    $self->set_default($q, $def);
}

sub do_label {
    my ($self, $q, $wiz, $p, $vals, $def) = @_;
    if (defined ($vals)) {
	foreach my $i (@$vals) {
	    $self->put_it($i);
	}
    }
}

sub do_paragraph {
    my ($self, $q, $wiz, $p, $vals, $preformatted, $width) = @_;
    my $w = $width || 80;
    foreach my $i (@$vals) {
	my $t;
	if ($preformatted) {
	    my $c = $i;
	    $c =~ s/[^\n]//g;  # XXX: must be a better and more efficient way
	    $t = $self->{'qtable'}->Scrolled('Text', -width => $w, 
					     -height => length($c) || 24,
					     -wrap => 'none',
					     -relief => 'flat');
	} else {
	    $t = $self->{'qtable'}->Text(-width => $w,
					 -height => 
					 int(length($i)/40) + 1,
					 -wrap => 'word',
					 -relief => 'flat');
	}
	$t->insert('end',$i);
	$self->put_it($t);
    }
}

sub do_menu {
    my ($self, $q, $wiz, $p, $vals, $labels, $def, $name) = @_;

    my @items;
    foreach my $v (@$vals) {
	if ($labels->{$v}) {
	    push @items, [ $labels->{$v} => $v ];
	} else {
	    push @items, $v;
	    $labels->{$v} = $v;
	}
	if (defined($def) && $v eq $def) {
	    # Tk::Optionmenu sucks badly when it comes to default; the
	    # default value must be the first in the list because that
	    # is what is shown.  ugh.  XXX: maybe use a Tk::BrowseEntry?
	    unshift @items, (pop @items);
	}
    }

    $self->set_default($q, $def);
    $self->put_it($self->{'qtable'}->Optionmenu(-options => \@items,
						-variable => \$self->{'datastore'}{'vars'}{$name},
						-relief => 'raised',
						@{$self->get_extra_args($q, $wiz, $p)}));
}

sub select_openfile {
    my ($self, $name, $widget) = @_;

    my $file = $self->{'qtable'}->getOpenFile();
    $widget->configure(-text => 'Select File: ' . $file);
    $self->qwparam($name, $file) if ($file ne '');
}

sub do_fileupload {
    my ($self, $q, $wiz, $p, $def) = @_;

    my $openbutton = 
      $self->{'qtable'}->Button(-text => 'Select File...');
    $openbutton->configure(-command => [\&select_openfile,
					$self, $q->{'name'}, $openbutton]);
    $self->put_it($openbutton);
    $self->set_default($q, $def);
}

sub select_savefile {
    my ($self, $name, $data, $datafn, $qw, $q, $p, $widget) = @_;
    my $file = $self->{'qtable'}->getSaveFile();
    $widget->configure(-text => 'Select File: ' . $file);
    my $fileh = new IO::File;
    $fileh->open('>' . $file);

    # save the question data field
    if ($data) {
	print $fileh $data;
    }

    # call the datafn routine as well
    if ($datafn && ref($datafn) eq 'CODE') {
	$datafn->($fileh, $file, $qw, $q, $p);
    }

    # close the output file
    $fileh->close();

    $self->qwparam($name, $file) if ($file ne '');
}

sub do_filedownload {
    my ($self, $q, $wiz, $p, $def) = @_;

    my $openbutton = 
      $self->{'qtable'}->Button(-text => 'Select File...');
    $openbutton->configure(-command => [\&select_savefile,
					$self, $q->{'name'},
					$q->{'data'}, $q->{'datafn'},
					$wiz, $q, $p, $openbutton]);
    $self->put_it($openbutton);
    $self->set_default($q, $def);
}

sub do_entry {
    my ($self, $q, $wiz, $p, $name, $def, $hide) = @_;
    $self->{'datastore'}->set($q->{'name'}, $def);

    #
    # Set up a value to use if the text shouldn't be echoed to the screen.
    #
    my $hideval;
    if ($hide) {
	$hideval = '*';
    }

    $self->put_it($self->{'qtable'}->Entry(-textvariable => \$self->{'datastore'}{'vars'}{$name}, -show => $hideval, @{$self->get_extra_args($q, $wiz, $p)}));
    $self->set_default($q, $def);
}

sub do_textbox {
    my ($self, $q, $wiz, $p, $vals, $def) = @_;
    my ($self, $q, $wiz, $p, $name, $def, $size, $width, $height) = @_;
    my $tb =
      $self->{'qtable'}->Text(-width => ($size || $width || 80),
			      -height => ($height || 8),
			      -wrap => 'none',
#			      -relief => 'flat',
			      @{$self->get_extra_args($q, $wiz, $p)});

    $tb->bind('<Any-Leave>',
	      sub { $self->{'datastore'}{'vars'}{$name} =
		      $_[0]->get('0.0','end'); });
    $tb->insert('end',$def || "",'geoqotext');
    $self->set_default($q, $def);
    $self->put_it($tb);
}

sub do_separator {
    my ($self, $q, $wiz, $p, $text) = @_;
    my $where = $self->{'qf'};
    $self->{'currentq'}++;
    $self->{'qadd'}++;
    if (!$where) {
	$where = $self->{'top'}->Frame();
	$where->pack(-expand => 1, -fill => 'x');
    }
    $self->put_it($text);
}

##################################################
# Display
##################################################

sub do_a_table {
    my ($self, $table, $parentt, $rowc, $wiz, $q, $p) = @_;

    foreach my $row (@$table) {
	my $col = 0;
	$rowc++;
	foreach my $column (@$row) {
	    if (ref($column) eq "ARRAY") {
		# sub table
		my $newt = $parentt->Table(-rows => 200,
					   -columns => 100,
					   -scrollbars => '');
		$self->do_a_table($column, $newt, -1, $wiz, $q, $p);
		$parentt->put($rowc, $col++, $newt);
	    } elsif (ref($column) eq "HASH") {
		my $oldqt = $self->{'qtable'};
		$self->{'qtable'} = $parentt;

		my $oldq = $self->{'currentq'};

		my $oldrow = $self->{'currentrow'};
		$self->{'currentrow'} = $rowc;

		my $oldc = $self->{'currentcol'};
		$self->{'currentcol'} = $col;
		$col++;
		
		my $subname = $wiz->ask_question($p, $column);
		push @{$wiz->{'passvars'}}, $subname if ($subname);

		$self->{'qtable'} = $oldqt;
		$self->{'currentq'} = $oldq;
		if ($oldc) {
		    $self->{'currentcol'} = $oldc;
		} else {
		    delete $self->{'currentcol'};
		}
		if ($oldrow) {
		    $self->{'currentrow'} = $oldrow;
		} else {
		    delete $self->{'currentrow'};
		}

	    } else {
		$parentt->put($rowc, $col++, 
			      $parentt->Label(-text =>
					      $self->make_displayable($column),
					      -anchor => 'w'));
	    }
	}
    }
}

sub do_table {
    my ($self, $q, $wiz, $p, $table, $headers) = @_;

    my $fixed = ($headers) ? 1 : 0;
    my $f = $self->{'qtable'}->Frame(-relief => 'raised', -border => 3);
    my $tab = $f->Table(-rows => 1000, #($#$table + $fixed + 1),
			-columns => 1000, #($#{$table->[0]} + 1),
			-fixedrows => $fixed,
			-scrollbars => '');
    $tab->pack();
    if ($headers) {
	my $col = 0;
	foreach my $column (@$headers) {
	    $tab->put(0, $col++, $tab->Label(-text => $column,
					     -relief => 'raised',
					     -anchor => 'w',
					     -border => 3));
	}
    }

    $self->do_a_table($table, $tab, $fixed-1, $wiz, $q, $p);

    $self->put_it($f);
}

sub do_graph {
    my $self = shift;
    my ($q, $wiz, $p, $data, $gopts) = @_;

    if ($have_gd_graph) {
	require MIME::Base64;
	# grrr...  photo requires data to be in base64 or a file.  Why???
	my $photo = $self->{'qtable'}->Photo(
					     -data => 
					     MIME::Base64::encode_base64(
						    $self->do_graph_data(@_)
									),
					    );
	$self->put_it($self->{'qtable'}->Label(-image => $photo,
					       -anchor => 'w'));
    } else {
	$self->put_it("Graphing support not available.");
    }
}

##############################################
#
sub do_image {
	my $self = shift;
	my ($q, $wiz, $p, $datastr, $filestr, $imgalt) = @_;

	my $ph;
	if ($have_tk_png) {
	    if ($datastr) {
		require MIME::Base64;
		$ph = $self->{'qtable'}->Photo(
					       -format => 'png',
					       -data =>
					       MIME::Base64::encode_base64($datastr));

	    } else {
		# image file
		$ph = $self->{'qtable'}->Photo(-format => 'png',
					       -file => $wiz->{'generator'}{'imagebase'} . $filestr);
	    }
	}
	if ($ph) {
	    $self->put_it($self->{'qtable'}->Label(-image => $ph,
						   -anchor => 'w'));
	} else {
	    $self->put_it($self->{'qtable'}->Label(-text => $imgalt || "Broken Image"));
	}
}

##################################################
# Trees
##################################################

sub do_tree {
    my ($self, $q, $wiz, $p, $labels) = @_;

    if (!$have_tk_tree) {
	print STDERR "Tree support not available.  Install the Tk::Tree perl module\n";
    }

    my $top = $self->{'qtable'} || $self->{'top'};
    my $tree = $self->{'qtable'}->ScrlTree(-width => 40,  #size that looked good to me
					   -height => 14,
					   -scrollbars => 'osoe');

    my @expand;
    if ($q->{'default'}) {
	#ensure that the default is initially visible
	my $cur = $q->{'default'};
	until ($cur eq $q->{'root'}) {
	    $cur = get_name($q->{'parent'}->($wiz, $cur));
	    unshift @expand, $cur;
	}
	$self->{'datastore'}->set($q->{'name'},$q->{'default'}) if $q->{'name'};
    }

    add_node($wiz, $tree, $q->{'root'}, $q, "", $labels, @expand);

    $tree->configure( -opencmd => sub { my $branch = shift;
					open_branch($wiz, $tree, $branch,
						    $q, $labels) } );
    $tree->configure( -browsecmd => sub { if ($q->{'name'}) {
	                                     my @sel = $tree->infoSelection();
					     my $node = ($#sel > -1 ? 
							  $tree->infoData($sel[0]) : "");
					     $self->{'datastore'}->set($q->{'name'}, $node);
					 } } );

    $self->put_it($tree);
}

sub get_name {
    my $node = shift;

    if (ref($node) eq 'HASH') {
	return $node->{'name'};
    } else {
	return $node;
    }
}

sub add_node {
    my ($wiz, $tree, $node, $q, $parent, $labels, @expand) = @_;

    my $label;
    my $exp = shift @expand;
    my $name = get_name($node);
    if (ref($node) eq 'HASH') {
	$label = $node->{'label'};
    }
    $label = $label || $labels->{$name} || $name;

    #text of the node is the label. data is the identifier.
    my $child = $tree->addchild($parent, -text => $label,
				-data => $name);
    my $ans = $q->{'children'}->($wiz, $node);
    $tree->setmode($child, ($ans && $#$ans > -1) ? 'open' : 'none');

    $tree->selectionSet($child) if ($name eq $q->{'default'});
    if ($name eq $exp) {
	$tree->open($child);
	open_branch($wiz, $tree, $child, $q, $labels, @expand);
    }
}

sub open_branch {
    my ($wiz, $tree, $branch, $q, $labels, @expand) = @_;

    if (my @children = $tree->infoChildren($branch)) {
	#we've already opened this branch, so just reopen it
	foreach my $child (@children) {
	    $tree->show( -entry => $child);
	}
	return;
    }

    my $children = $q->{'children'}->($wiz, $tree->infoData($branch));
    return if (!$children || $#$children == -1);
    foreach my $child (@$children) {
	add_node($wiz, $tree, $child, $q, $branch, $labels, @expand);
    }
}

##################################################
#
# Automatic updating for monitors.
#

sub do_autoupd
{
	#
	# Dummy routine for now!
	#
	warn "Tk.do_autoupd:  currently no automatic updating is defined for Tk.  This should be fixed RSN.\n"
}

##################################################
# unknown type errors
#
sub do_unknown {
    my ($self, $q, $wiz, $p) = @_;
    $self->{'currentq'}++;
    $self->{'qadd'}++;
    $self->put_it($self->{'qtable'}->Label(-text => "Unknown question type '$q->{type}' not handled in primary '$p->{module_name}'.  It is highly likely this application will no longer function properly beyond this point.",
					   -foreground => 'red'));
}


##################################################
# action confirm
##################################################

sub start_confirm {
    my ($self, $wiz) = @_;

    $self->make_top();
    $self->put_it('Wrapping up.',1,1);
    $self->put_it('Do you want to commit the following changes:',2,1);
    $self->{'resultf'} = $self->{'qtable'}->Frame(-relief => 'sunken',
						  -border => 3);
    $self->put_it($self->{'resultf'},3,1);
}

sub end_confirm {
    my ($self, $wiz) = @_;
    # this will be deleted by the cancel button if they press it.
    $self->do_hidden($wiz, 'wiz_confirmed', 'Commit');
    $self->do_ok_cancel("Commit", $wiz);
    $self->our_mainloop();
    return 1;
}

sub do_confirm_message {
    my ($self, $wiz, $msg) = @_;
    $self->{'resultf'}->Label(-justify => 'left', -text => $msg, -anchor => 'w')
      ->pack(-expand => 1, -fill => 'x');
}

sub canceled_confirm {
    my ($self, $wiz) = @_;
    goto_top();
}

##################################################
# actions
##################################################

sub start_actions {
    my ($self, $wiz) = @_;
    $self->make_top();
    $self->put_it('Processing your request...',1,1);
    $self->{'resultf'} = $self->{'qtable'}->Frame(-relief => 'sunken',
						  -border => 3);
    $self->put_it($self->{'resultf'},2,1);
}

sub end_actions {
    my ($self, $wiz) = @_;
    $self->put_it('Done',3,1);
    $self->do_ok_cancel("Finish", $wiz);
    $self->clear_params();
    $self->our_mainloop();
    return 1;
}

sub do_action_output {
    my ($self, $wiz, $action) = @_;
    $self->{'resultf'}->Label(-text => $action, -anchor => 'w')->pack(-expand => 1, -fill => 'x');
}

sub do_action_error {
    my ($self, $wiz, $errstr) = @_;
    $self->{'resultf'}->Label(-text => $errstr, -foreground => 'red',
			  -anchor => 'w')
      ->pack(-expand => 1, -fill => 'x');
}

1;