
package ZooZ::Forms;
$ZooZ::Forms::VERSION = '1.9.1';
#
# This package implements all the forms for ZooZ.
# These include:
# 1. new project form.
# 2. configure widget form.
# 3. choose font form.
# 4. choose callback form.
# 5. choose variable form.

use strict;
use Storable;  # remove an error from Tk::CodeText

use ZooZ::Fonts;
use ZooZ::Callbacks;
use ZooZ::Options;
use ZooZ::Generic;
use ZooZ::varRefs;
use ZooZ::TiedVar;

use Tk::Font;
use Tk::Pane;
use Tk::Dialog;
use Tie::Watch;

my (
    %FORMS,        # a list of all forms and their titles.
    %TOPLEVEL,     # to hold the toplevel widgets of all forms.

    # Data for widget configuration
    %CONFDATA,

    # Data for Fonts.
    %FONTDATA,

    # Data for varRefs.
    %VARDATA,

    # Data for callbacks
    %CBDATA,

    # Data for row/col conf.
    %ROWCOLDATA,

    %ignoreOptions,   # options to be hidden from user

    # Tab options. for Notebooks
    @TAB_OPTIONS,

    # Menu configuration for toplevels.
    %MENUDATA,
    @MENUS,
   );

%FORMS = (
	  #newProject      => 'Create New Project',
	  configureWidget => 'Configure Widget',
	  chooseFont      => 'Choose/Create Font',
	  chooseCallback  => 'Choose/Create Callback',
	  chooseVarRef    => 'Choose/Create Variable',
	  configureRowCol => 'Configure Row/Column',
	  configureMenu   => 'Configure Menu',
	 );

# the options to ignore. Those can't (and shouldn't) be
# exposed to the user.
%ignoreOptions = (
		  -class => 1,
		 );

# Sigils for vars.
$VARDATA{SIGIL}= {
		  Scalar => "\$",
		  Array  => "\@",
		  Hash   => "%"
		 };

# Tab options.
@TAB_OPTIONS = qw(-anchor -bitmap -image -label
		  -justify -createcmd -raisecmd
		  -state -underline -wraplength);

###################
#
# This should be called as a static sub.
# It creates toplevels for all the forms.
#
###################

sub createAllForms {
  my $mw = shift;

  for my $form (keys %FORMS) {
    my $t = $mw->Toplevel;

    $t->withdraw;
    $t->title   ($FORMS{$form});
    $t->protocol(WM_DELETE_WINDOW => [$t => 'withdraw']);

    my $setup = "setup_$form";
    ZooZ::Forms->$setup($t);

    $TOPLEVEL{$form} = $t;
  }
}

###############
#
# Setup the form to configure the widgets.
#
###############

sub setup_configureWidget {
  my ($class, $top) = @_;

  # Create a label that is easy to see to tell user what widget
  # is being configured.
  $top->Label(
	      -textvariable => \$CONFDATA{WidgetName},
	      -font         => 'WidgetName',
	      -fg           => 'darkolivegreen',
	      -bg           => 'white',
	      -borderwidth  => 1,
	      -relief       => 'ridge',
	      -pady         => 5,
	     )->pack(qw/-fill x -padx 5 -pady 5/);

  # create the notebook.
  $CONFDATA{NB} = $top->NoteBook(
				 -borderwidth => 1,
				)->pack(qw/-fill both -expand 1/);
  $CONFDATA{NBWIDGET} = $CONFDATA{NB}->add('NBWIDGET', -label => 'Widget Specific');
  $CONFDATA{NBPLACE}  = $CONFDATA{NB}->add('NBPLACE',  -label => 'Placement Specific');
  $CONFDATA{NBEXTRA}  = $CONFDATA{NB}->add('NBEXTRA',  -label => 'Extra Properties');

  # make things a bit nicer
  for (qw/NBPLACE NBWIDGET NBEXTRA/) {
    $CONFDATA{$_}->optionAdd('*Entry.BorderWidth'       => 1);
    $CONFDATA{$_}->optionAdd('*Button.BorderWidth'      => 1);
    $CONFDATA{$_}->optionAdd('*Checkbutton.BorderWidth' => 1);
    $CONFDATA{$_}->optionAdd('*Radiobutton.BorderWidth' => 1);
  }

  # bind for mouse wheel.
  ZooZ::Generic::BindMouseWheel($top, sub {
				  my $r = $CONFDATA{NB}->raised;
				  ($CONFDATA{$r}->packSlaves)[0];
				});
}

###############
#
# Setup the font selection form
#
###############

sub setup_chooseFont {
  my ($class, $top) = @_;

  $top->optionAdd("*$_.BorderWidth" => 1) for qw(Button
						 Checkbutton
						 Radiobutton
						 Optionmenu
						 Listbox);

  my $f1 = $top->Frame->pack(qw/-side top -fill both -expand 1/);
  my $f2 = $top->Labelframe(-text      => 'Preview',
			    -height    => 200,
			   )->pack(qw/-side bottom -fill x/);

  my $f3 = $f1->Labelframe(-text   => 'Previously Used Fonts',
			  )->pack(qw/-side left -fill both -expand 1/);
  my $l3 = $f3->Scrolled(qw/Listbox -scrollbars se/,
			 -exportselection => 0,
			 -selectmode      => 'browse',
			)->pack(qw/-fill both -expand 1/);

  my $f4 = $f1->Labelframe(-text => 'Available Families',
			)->pack(qw/-side left -fill both -expand 1/);
  my $l4 = $f4->Scrolled(qw/Listbox -scrollbars se/,
			 -exportselection => 0,
			 -selectmode      => 'browse',
			 -width => 30,
			)->pack(qw/-fill both -expand 1/);

  my $F4 = $f1->Frame->pack(qw/-side left -fill y -expand 0/);
  my $f5 = $F4->Labelframe(-text     => 'Extra Options',
			)->pack(qw/-side top -fill y -expand 1 -anchor n/);

  $_->Subwidget('xscrollbar')->configure(-borderwidth => 1) for $l3, $l4;
  $_->Subwidget('yscrollbar')->configure(-borderwidth => 1) for $l3, $l4;

  # populate family list.
  $l4->insert(end => $_) for sort $top->fontFamilies;

  $F4->Button(-text => 'Ok',
	      -command => sub {
		my $name = "$FONTDATA{family} $FONTDATA{size} $FONTDATA{weight} $FONTDATA{slant} " .
		  ($FONTDATA{underline} ? 'u ' : '') . ($FONTDATA{overstrike} ? 'o': '');
		$name =~ y/ /_/;

		#print "Name is $name.\n";
		# register it unless font already exists.
		unless ($::FONTOBJ->FontExists($name)) {
		  # create it and register it.
		  my $obj = $top->fontCreate($name,
					     map {
					       '-' . $_ =>  $FONTDATA{$_}
					     } qw/family size weight slant underline overstrike/);
		  $::FONTOBJ->add($name, $obj);
		}

		$FONTDATA{localReturn} = $name;
	      })->pack(qw/-side top -padx 5 -pady 0 -fill x/);

  $F4->Button(-text    => 'Cancel',
	      -command => [\&cancelForm, \%FONTDATA],
	     )->pack(qw/-side top -padx 5 -pady 0 -fill x/);

  my $sample         = $f2->Label(-text => "There's More Than One Way To Do It",
				 )->pack(qw/-side top/);

  my $default        = $sample->cget('-font');
  if ($default =~ /\{(.+)\}\s+(\d+)/) {
    $FONTDATA{family}   = $1;
    $FONTDATA{size}     = $2;
  } else {
    $FONTDATA{family}   = '';
    $FONTDATA{size}     = 8;
  }

  $FONTDATA{weight}     = 'normal';
  $FONTDATA{slant}      = 'roman';
  $FONTDATA{underline}  = 0;
  $FONTDATA{overstrike} = 0;

  for my $i (0 .. $l4->size - 1) {
    next unless $l4->get($i) eq $FONTDATA{family};

    $l4->selectionSet($i);
    $l4->see($i);
    last;
  }


  $f5->Label(-text => 'Size',
	    )->grid(-column => 0, -row => 0, -sticky => 'w');
  $f5->Optionmenu(-options => [5 .. 25],
		  -textvariable => \$FONTDATA{size},
		  -command      => [\&configureSampleFont, $sample],
		 )->grid(-column => 1, -row => 0, -sticky => 'ew',
			 -columnspan => 2);

  $f5->Label(-text => 'Weight',
	    )->grid(-column => 0, -row => 1, -sticky => 'w');
  $f5->Radiobutton(-text => 'Normal',
		   -value => 'normal',
		   -variable => \$FONTDATA{weight},
		   -command  => [\&configureSampleFont, $sample],
		  )->grid(-column => 1, -row => 1, -sticky => 'w');
  $f5->Radiobutton(-text => 'Bold',
		   -value => 'bold',
		   -variable => \$FONTDATA{weight},
		   -command  => [\&configureSampleFont, $sample],
		  )->grid(-column => 2, -row => 1, -sticky => 'w');

  $f5->Label(-text => 'Slant',
	    )->grid(-column => 0, -row => 2, -sticky => 'w');
  $f5->Radiobutton(-text => 'Normal',
		   -value => 'roman',
		   -variable => \$FONTDATA{slant},
		   -command  => [\&configureSampleFont, $sample],
		  )->grid(-column => 1, -row => 2, -sticky => 'w');
  $f5->Radiobutton(-text => 'Italic',
		   -value => 'italic',
		   -variable => \$FONTDATA{slant},
		   -command  => [\&configureSampleFont, $sample],
		  )->grid(-column => 2, -row => 2, -sticky => 'w');

  $f5->Label(-text => 'Underline',
	    )->grid(-column => 0, -row => 3, -sticky => 'w');
  $f5->Checkbutton(-text => 'Yes/No',
		   -variable => \$FONTDATA{underline},
		   -command  => [\&configureSampleFont, $sample],
		  )->grid(-column => 1, -row => 3, -sticky => 'ew',
			  -columnspan => 2);

  $f5->Label(-text => 'Overstrike',
	    )->grid(-column => 0, -row => 4, -sticky => 'w');
  $f5->Checkbutton(-text => 'Yes/No',
		   -variable => \$FONTDATA{overstrike},
		   -command  => [\&configureSampleFont, $sample],
		  )->grid(-column => 1, -row => 4, -sticky => 'ew',
			  -columnspan => 2);

  # when user selects a registered font, update the other widgets.
  $l3->bind('<1>' => sub {
	      my ($sel) = $l3->curselection;
	      defined $sel or return;

	      $sel    = $l3->get($sel);
	      my $obj = $::FONTOBJ->obj($sel);

	      # update all the vars.
	      for my $o (qw/family size weight slant underline overstrike/) {
		$FONTDATA{$o} = $obj->configure("-$o");
	      }

	      # configure the sample.
	      $sample->configure(-font => $obj);

	      # select the correct entry in the list of available fonts.
	      for my $i (0 .. $l4->size - 1) {
		next unless $l4->get($i) eq $FONTDATA{family};
		$l4->selectionClear(qw/0.0 end/);
		$l4->selectionSet($i);
		$l4->see($i);
		last;
	      }
	    });

  # when user selects a new font, update the sample and some vars.
  $l4->bind('<1>' => sub {
	      my ($sel) = $l4->curselection;
	      defined $sel or return;

	      $l3->selectionClear(qw/0.0 end/);
	      $FONTDATA{family} = $l4->get($sel);
	      configureSampleFont($sample);
	    });

  # to take care of waitVariable.
  $top->protocol(WM_DELETE_WINDOW => sub {
		   $FONTDATA{localReturn} = '';
		 });

  $FONTDATA{list} = $l3;
}

sub setup_chooseCallback {
  # this form let's users add/delete callbacks/subroutines.
  # as a side effect, it returns the name of the
  # selected callback so it can be used to assign
  # callbacks to -command arguments.
  my ($class, $top) = @_;

  my $f1 = $top->Labelframe(-text      => 'Defined Subroutines',
			   )->pack(qw/-side top -fill both -expand 1/);

  my $f2 = $top->Frame->pack(qw/-side bottom -fill x -padx 5 -pady 5/);

  my $l  = $f1->Scrolled(qw/Listbox -scrollbars se/,
			 -selectmode => 'single',
			 -width => 40,
			)->pack(qw/-side left -fill y/);

  eval "require Tk::CodeText";

  my @textWidget = $@ ? ('Text') : ('CodeText',
				    -disablemenu => 1, # no idea
				    -syntax      => 'Perl',
				   );

  my $r  = $f1->Scrolled(@textWidget,
			 -scrollbars => 'se',
			 -width      => 60,
			)->pack(qw/-side left -fill both -expand 1/);

  $r->bind('<Key>' => sub {
	     return unless $CBDATA{selected};

	     $::CALLBACKOBJ->code($CBDATA{selected}, $r->get(qw/0.0 end/));
	   });

  $CBDATA{list} = $l;

  $l->bind('<1>' => sub {
	     my ($sel) = $l->curselection;
	     #defined $sel or return;
	     defined $sel or do {
	       $CBDATA{selected} = '';
	       return;
	     };

	     $sel     = $l ->get($sel);
	     my $code = $::CALLBACKOBJ->code($sel);
	     $r->delete(qw/0.0 end/);
	     $r->insert(end => $code);

	     $CBDATA{selected} = $sel;
	   });

  $f2->Button(-text    => 'Add Subroutine',
	      -height  => 2,
	      -command => sub {
		my $name = $::CALLBACKOBJ->newName;

		unless (exists $CBDATA{newN}) {
		  my $d = $top->DialogBox(-title   => 'New Subroutine',
					  -buttons => [qw/Ok Cancel/],
					  -popover => $top);

		  my $f = $d->Labelframe(-text => 'Enter Unique Subroutine Name',
					)->pack(qw/-fill both -expand 1/);

		  $CBDATA{newN}   = $d;
		  $CBDATA{newN_e} = $f->Entry->pack;
		}

		my $e = $CBDATA{newN_e};

		do {
		  $e->delete(qw/0.0 end/);
		  $e->insert(0.0 => $name);
		  $e->selectionRange(qw/0.0 end/);
		  $e->focus;

		  my $ans = $CBDATA{newN}->Show;
		  return if $ans eq 'Cancel';

		  $name = $e->get;
		  $name =~ s/\W/_/g; # make sure it's legal
		  #$name = 'main::' . $name unless $name =~ /::/;
		  $name =~ s/^(?:.*::)?/main::/;  # only main allowed.
		} while $::CALLBACKOBJ->CallbackExists($name);


		$::CALLBACKOBJ->add($name, <<EOT);
# To rename the sub, use the button below.
sub $name {

}
EOT
  ;

		# add it to listbox.
		$l->insert(end => $name);
		$l->selectionSet('end');

		my $code = $::CALLBACKOBJ->code($name);
		$r->delete(qw/0.0 end/);
		$r->insert(end => $code);

		# select it
		$CBDATA{selected} = $name;

	      })->pack(qw/-side left -fill x -expand 1/);

  # AGAIN: Do I really need this?
  if (0) {
    $f2->Button(-text    => 'Delete Selected Sub',
		-height  => 2,
		-command => sub {
		  my ($sel) = $l->curselection;
		  defined $sel or return;

		  my $nam = $l->get($sel);
		  my $ans = $top->Dialog
		    (-title   => 'Are you sure?',
		     -bitmap  => 'question',
		     -buttons => [qw/Yes No/],
		     -font    => 'Questions',
		     -text    => <<EOT)->Show;
Are you sure you want to delete
callback '$nam' with its
associated code?
EOT
  ;
		  return if $ans eq 'No';
		  $::CALLBACKOBJ->remove($nam);
		  $l->delete($sel);
		  $r->delete(qw/0.0 end/);
		  # TBD: Must check if any widgets are using this
		  #      callback. If so, either fix that, or don't
		  #      delete the callback.
		})->pack(qw/-side left -fill x -expand 1/);
  }

  $f2->Button(-text    => 'Rename Selected Sub',
	      -height  => 2,
	      -command => sub {
		my ($sel) = $l->curselection;
		defined $sel or return;

		my $name = $l->get($sel);

		unless (exists $CBDATA{rename}) {
		  my $d = $top->DialogBox(-title   => 'Rename Callback',
					  -buttons => [qw/Ok Cancel/],
					  -popover => $top);

		  my $f = $d->Labelframe(-text => 'Enter Unique Subroutine Name',
					)->pack(qw/-fill both -expand 1/);

		  $CBDATA{rename}   = $d;
		  $CBDATA{rename_e} = $f->Entry->pack;
		}

		my $e = $CBDATA{rename_e};

		my $oldName = $name;
		$name =~ s/main:://;
		do {
		  $e->delete(qw/0.0 end/);
		  $e->insert(0.0 => $name);
		  $e->selectionRange(qw/0.0 end/);
		  $e->focus;

		  my $ans = $CBDATA{rename}->Show;
		  return if $ans eq 'Cancel';

		  $name = $e->get;
		  $name =~ s/\W/_/g; # make sure it's legal
		  #$name = 'main::' . $name unless $name =~ /::/;
		  $name =~ s/^(?:.*::)?/main::/;  # only main allowed
		} while $::CALLBACKOBJ->CallbackExists($name);
		
		$::CALLBACKOBJ->rename($oldName => $name);
		$l->delete($sel);
		$l->insert($sel => $name);

		my $code = $::CALLBACKOBJ->code($name);
		$code =~ s/\b(sub\s+)$oldName\b/$ {1}$name/;
		$::CALLBACKOBJ->code($name, $code);

		# stick it back
		$r->delete(qw/0.0 end/);
		$r->insert(end => $code);
	      })->pack(qw/-side left -fill x -expand 1/);

  $f2->Button(-text    => 'Return Selected',
	      -height  => 2,
	      -command => sub {
		my ($sel) = $l->curselection;
		defined $sel || return $CBDATA{localReturn} = '';

		$sel      = $l->get($sel) if defined $sel;

		# before we return, eval the subroutine, unless
		# it has been evaled before.
		my $code = $::CALLBACKOBJ->code($sel);

		{
		  no strict;
		  no warnings;

		  $code =~ s/sub \Q$sel/sub /;
		  *{"main::$sel"} = eval "package main; $code";
		}

		$CBDATA{localReturn} = $sel;
	      })->pack(qw/-side left -fill x -expand 1/);

  $f2->Button(-text    => "Return Nothing\n(Unsets binding)",
	      -command => sub {
		$CBDATA{localReturn} = 'UNSET';
	      })->pack(qw/-side left -fill both -expand 1/);

  $f2->Button(-text    => 'Cancel',
	      -height  => 2,
	      -command => [\&cancelForm, \%CBDATA],
	     )->pack(qw/-side left -fill x -expand 1/);

  $l->delete(qw/0.0 end/);
  $l->insert(end => $_) for $::CALLBACKOBJ->listAll;

  # to take care of waitVariable.
  $top->protocol(WM_DELETE_WINDOW => sub {
		   $CBDATA{localReturn} = '';
		 });
}

sub setup_chooseVarRef {
  my ($class, $top) = @_;

  my $f1 = $top->Labelframe(-text      => 'Defined Variables',
			   )->pack(qw/-side top -fill both -expand 1/);
  my $f2 = $top->Frame->pack(qw/-side bottom -fill x -padx 5 -pady 5/);

  my $l  = $f1->Scrolled(qw/Listbox -scrollbars se/,
			 -selectmode  => 'single',
			 -width       => 40,
			 -borderwidth => 1,
			)->pack(qw/-side left -fill both -expand 1/);

  $VARDATA{list} = $l;

  $l->bind('<1>' => sub {
	     my ($sel) = $l->curselection;
	     defined $sel or do {
	       $VARDATA{selected} = '';
	       return;
	     };

	     $VARDATA{selected} = $sel;
	   });

  $f2->Button(-text    => 'New Variable',
	      -height  => 2,
	      -command => sub {
		my $name = $::VARREFOBJ->newName;

		unless (exists $VARDATA{newN}) {
		  my $d = $top->DialogBox(-title   => 'New Variable',
					  -buttons => [qw/Ok Cancel/],
					  -popover => $top);

		  my $f = $d->Labelframe(-text => 'Enter Unique Variable Name',
					)->pack(qw/-fill both -expand 1/);

		  $VARDATA{newN}   = $d;
		  $VARDATA{newN_e} = $f->Entry->pack;
		  $VARDATA{newN_t} = 'Scalar';

		  $f->Radiobutton(-text     => $_,
				  -variable => \$VARDATA{newN_t},
				  -value    => $_,
				 )->pack(qw/-fill x/) for qw/Scalar Array Hash/;
		}

		my $e = $VARDATA{newN_e};

		do {
		  $e->delete(qw/0.0 end/);
		  $e->insert(0.0 => $name);
		  $e->selectionRange(qw/0.0 end/);
		  $e->focus;

		  my $ans = $VARDATA{newN}->Show;
		  return if $ans eq 'Cancel';

		  $name = $e->get;
		} while $::VARREFOBJ->varRefExists($name);

		if ($name =~ /^\w/) {  # add sigil if user didn't specify one.
		  my $type = $VARDATA{newN_t};
		  $name    = $VARDATA{SIGIL}{$type} . $name;
		}

		$::VARREFOBJ->add($name);

		# add it to listbox.
		$l->insert(end => $name);
		$l->selectionSet('end');

		# select it
		$VARDATA{selected} = $name;

	      })->pack(qw/-side left -fill x -expand 1/);

  # do I need this?
  if (0) {
  $f2->Button(-text    => 'Delete Selected Variable',
	      -height  => 2,
	      -command => sub {
		my ($sel) = $l->curselection;
		defined $sel or return;

		my $nam = $l->get($sel);
		my $ans = $top->Dialog
		  (-title   => 'Are you sure?',
		   -bitmap  => 'question',
		   -buttons => [qw/Yes No/],
		   -font    => 'Questions',
		   -text    => <<EOT)->Show;
Are you sure you want to delete
variable '$nam'?
EOT
  ;
		return if $ans eq 'No';
		$::VARREFOBJ->remove($nam);
		$l->delete($sel);

		## TBD: check for any widgets that are using this variable
		##      and update them.
	      })->pack(qw/-side left -fill x -expand 1/);
} # delete button

  $f2->Button(-text    => 'Initialize Variable',
	      -height  => 2,
	      -command => [\&initSelectedVar, $top, $l],
	     )->pack(qw/-side left -fill x -expand 1/);

  $f2->Button(-text    => 'Return Selected',
	      -height  => 2,
	      -command => sub {
		my ($sel)             = $l->curselection;
		$VARDATA{localReturn} = $l->get($sel) if defined $sel;
	      })->pack(qw/-side left -fill x -expand 1/);

  $f2->Button(-text    => "Return Nothing\n(Unsets binding)",
	      -command => sub {
		$VARDATA{localReturn} = 'UNSET';
	      })->pack(qw/-side left -fill both -expand 1/);

  $f2->Button(-text    => 'Cancel',
	      -height  => 2,
	      -command => [\&cancelForm, \%VARDATA],
	     )->pack(qw/-side left -fill x -expand 1/);

  # to take care of waitVariable.
  $top->protocol(WM_DELETE_WINDOW => sub {
		   $VARDATA{localReturn} = '';
		 });

  $l->bind('<Double-1>' => [\&initSelectedVar, $top, $l]);
}

sub initSelectedVar {
  my $l   = pop;
  my $top = pop;
  my $sel = $l->curselection;

  return unless defined $sel;
  my $var = $l->get($sel);
  $var =~ s/^(.)//;  # the sigil.
  my $s = $1;

  unless ($VARDATA{initForm}) {
    my $t = $VARDATA{initForm} = $top->DialogBox(-title   => 'Initialize Variable',
						 -buttons => [qw/Ok Cancel/],
						 -popover => $top);

    $t->bind('<Return>' => ''); # remove default.

    # create a frame for each type of variable.
    {
      my $f = $VARDATA{initScalarF} = $t->Frame;
      $f->Label(-text   => 'Enter Value',
		-anchor => 'w',
	       )->pack(qw/-fill x/);

      $VARDATA{initScalarV} = $f->Entry->pack(qw/-fill x/);
    }

    {
      my $f = $VARDATA{initArrayF} = $t->Frame;
      $f->Label(-text   => 'Enter Values One Per Line',
		-anchor => 'w',
	       )->pack(qw/-fill x/);
      $VARDATA{initArrayV} = $f->Scrolled(Text        =>
					  -scrollbars => 'e',
					 )->pack(qw/-fill both -expand 1/);
    }

    {
      my $f = $VARDATA{initHashF} = $t->Frame;
      $f->Label(-anchor  => 'w',
		-justify => 'left',
		-text    => <<EOT)->grid(-columnspan => 2);
Enter key value pairs.
Each line on the left will define a key and
each line on the right will define the corresponding value.
EOT
  ;
      $f->Label(-text => 'Keys',
		-font => 'OptionText',
	       )->grid(-row => 1, -column => 0, -sticky => 'w');
      $f->Label(-text => 'Values',
		-font => 'OptionText',
	       )->grid(-row => 1, -column => 1, -sticky => 'w');
      my $t1 = $f->Scrolled(Text        =>
			    -scrollbars => 'e',
			    -width      => 20,
			    -bd         => 1,
			    -wrap       => 'none',
			   )->grid(-row => 2, -column => 0);
      my $t2 = $f->Scrolled(Text        =>
			    -scrollbars => 'e',
			    -width      => 20,
			    -bd         => 1,
			    -wrap       => 'none',
			   )->grid(-row => 2, -column => 1);

      # define bindings such that the tab key
      # jumps between the two texts.
      # must jump to same location.
      $VARDATA{initHashK} = $t1->Subwidget('text');
      $VARDATA{initHashV} = $t2->Subwidget('text');
      $_->bindtags([$_, 'Tk::Text']) for $VARDATA{initHashK}, $VARDATA{initHashV};

      $VARDATA{initHashK}->bind('<Tab>' => sub {
				  my $loc = $VARDATA{initHashK}->index('insert');
				  my $end = $VARDATA{initHashV}->index('end');
				  $loc =~ s/\..*//;
				  $end =~ s/\..*//;

				  $VARDATA{initHashV}->insert(end => "\n") for $end .. $loc;
				  $VARDATA{initHashV}->focus;
				  $VARDATA{initHashV}->markSet(insert => "$loc.0");
				  Tk::break;
				});
      $VARDATA{initHashV}->bind('<Tab>' => sub {
				  my $loc = $VARDATA{initHashV}->index('insert');
				  $loc =~ s/\..*//;
				  $VARDATA{initHashK}->insert(end => "\n")
				    if $VARDATA{initHashK}->get("$loc.0") =~ /\S/ &&
				      $VARDATA{initHashK}->get(($loc+1).".0") !~ /\S/;
				  $VARDATA{initHashK}->focus;
				  $VARDATA{initHashK}->markSet(insert => ($loc+1) . ".0");
				  Tk::break;
				});

    }
  }

  my $f = $s eq "\$" ? 'initScalarF' : $s eq '@' ? 'initArrayF' : 'initHashF';

  # populate with the any old values.
  {
    no strict;

    if ($f =~ /Scalar/) {
      $VARDATA{initScalarV}->delete(qw/0 end/);
      $VARDATA{initScalarV}->insert(0, $ {"main::$var"});
    } elsif ($f =~ /Array/) {
      $VARDATA{initArrayV}->delete(qw/0.0 end/);
      $VARDATA{initArrayV}->insert(end => "$_\n") for @{"main::$var"};
    } else { # hash
      $VARDATA{$_}->delete(qw/0.0 end/) for qw/initHashK initHashV/;
      for my $k (sort keys %{"main::$var"}) {
	$VARDATA{initHashK}->insert(end => "$k\n");
	$VARDATA{initHashV}->insert(end => $ {"main::$var"}{$k} . "\n");
      }
    }
  }

  $VARDATA{$_}->packForget for qw/initScalarF initArrayF initHashF/;
  $VARDATA{$f}->pack(qw/-fill both -expand 1/);

  my $ans = $VARDATA{initForm}->Show;

  return if $ans eq 'Cancel';

  # set the value.
  {
    no strict;

    if ($f =~ /Scalar/) {
      $ {"main::$var"} = $VARDATA{initScalarV}->get;
    } elsif ($f =~ /Array/) {
      @ {"main::$var"} = split /\n/ => $VARDATA{initArrayV}->get(qw/0.0 end/);
    } else { # hash
      %{"main::$var"} = ();
      my @k = split /\n/ => $VARDATA{initHashK}->get(qw/0.0 end/);
      for my $i (1 .. @k) {
	my $v = $VARDATA{initHashV}->get("$i.0", "$i.end");
	$ {"main::$var"}{$k[$i - 1]} = $v;
      }
    }
  }
}

###############
#
# Setup the form to configure the menus.
#
###############

sub setup_configureMenu {
  my ($class, $top) = @_;

  # Create a label that is easy to see to tell user what widget
  # is being configured.
  $top->Label(
	      -textvariable => \$MENUDATA{FormName},
	      -font         => 'WidgetName',
	      -fg           => 'darkolivegreen',
	      -bg           => 'white',
	      -borderwidth  => 1,
	      -relief       => 'ridge',
	      -pady         => 5,
	     )->grid(-row        => 0,
		     -column     => 0,
		     -columnspan => 2,
		     -sticky     => 'ew');

  my $hl = $top->Scrolled(HList       =>
			  -scrollbars => 'se',
			  -bg         => 'white',
			  -header     => 1,
			  -columns    => 4,
			 )->grid(-row     => 1,
				 -column  => 0,
				 -rowspan => 2,
				 -sticky  => 'nsew',
				);

  $hl->header(create => 0, -relief => 'raised', -text => 'Label');
  $hl->header(create => 1, -relief => 'raised', -text => 'Type');
  $hl->header(create => 2, -relief => 'raised', -text => 'Accelerator');
  $hl->header(create => 3, -relief => 'raised', -text => 'Command');

  my $det = $top->Labelframe(-text => 'Details',
			    )->grid(-row    => 1,
				    -column => 1,
				    -sticky => 'ns',
				   );
#  my $but = $top->Frame->grid(-row    => 1,
#			      -column => 2,
#			      -sticky => 'ns',
#			     );
  my $but = $top->Frame->grid(-row    => 2,
			      -column => 1,
			      -sticky => 'ns',
			     );

  # create the buttons.
  $but->Button(-text => 'Add',
	      )->pack(qw/-side left -fill x -expand 1/);
  $but->Button(-text => 'Delete Selected',
	      )->pack(qw/-side left -fill x -expand 1/);

  # now the details.
  

  $top->gridRowconfigure   (1, -weight => 1);
  $top->gridColumnconfigure(0, -weight => 1);

  $MENUDATA{HL} = $hl;

  # bind for mouse wheel.
  ZooZ::Generic::BindMouseWheel($top, sub {
				  my $r = $CONFDATA{NB}->raised;
				  ($CONFDATA{$r}->packSlaves)[0];
				});
}

#########################
#
# This should be called as a static sub
#
#########################

# IS THIS NECESSARY?
sub displayForm {
  my $form = shift;

  return unless exists $TOPLEVEL{$form};
  my $t = $TOPLEVEL{$form};

  $t->deiconify;
}

##########################
#
# This deletes the form associated with the
# deleted widget. It also hides the propertis window.
#
##########################

sub deleteWidget {
  my ($class,
      $projid,
      $name) = @_;

  $TOPLEVEL{configureWidget}->withdraw;
  delete $CONFDATA{$projid}{$name};
}

sub changeWidgetName {
  my ($self, $v) = @_;

  $self->Store($v);

  my $args                = $self->Args('-store');
  my ($p, $n, $l, $i, $c) = @$args;

  my $col = $p->renameWidget($$n, $v) ? $c : 'red';
  $l->configure(-bg => $col);

  if ($col eq $c) { # went fine.
    # now must fix up the frame hashes.
    $CONFDATA{FORMS}{$i}{$v} = delete $CONFDATA{FORMS}{$i}{$$n};
    $CONFDATA{WidgetName}    = $v;

    $$n = $v;
  }
}

sub configureMenu {
  my ($class,
      $project,
      $projid,
      $name,
      $widget,
     ) = @_;

  $MENUDATA{FormName} = $project->{PROJNAME} . '.' . $name;

  $TOPLEVEL{configureMenu}->deiconify;
#  $TOPLEVEL{configureMenu}->grab;
#  $TOPLEVEL{configureMenu}->waitVariable(\$FONTDATA{localReturn});
#  $TOPLEVEL{configureMenu}->grabRelease;
#  $TOPLEVEL{configureMenu}->withdraw;

#  return $FONTDATA{localReturn};
}

###########################
#
# This method pops up the widget configuration form
#
###########################

sub configureWidget {
  my ($class,    # called as a method.
      $project,  # actual project widget.
      $parent,   # parent widget
      $projid,   # project ID
      $name,     # Widget name (unique)
      $widget,   # widget itself (preview, really)
      $Woptions, # hash of widget options.
      $Poptions, # hash of placement options.
      $Eoptions, # hash of extra options.
      $noforce,  # If window is not viewable, it won't show if this is 1.
      $scroll,   # Whether widget is scrollable or not.
     ) = @_;

  $CONFDATA{WidgetName} = $name;

  # create the frame for this widget if we haven't done that before.
  # should create one frame per widget per project.
  unless (exists $CONFDATA{FORMS}{$projid}{$name}) {

    # frame for widget options.
    my $f = $CONFDATA{NBWIDGET}->Scrolled('Pane',
					  -sticky     => 'nsew',
					  -scrollbars => 'e',
					  -gridded    => 'xy');

    # frame for extra options.
    my $h = $CONFDATA{NBEXTRA}->Scrolled('Pane',
					 -sticky     => 'nsew',
					 -scrollbars => 'e',
					);

    # frame for placement options.
    my $g = $CONFDATA{NBPLACE}->Scrolled('Pane',
					 -sticky     => 'nsew',
					 -scrollbars => 'e',
					);

    # configure the scrollbar's appearance.
    $_->Subwidget('yscrollbar')->configure(-borderwidth => 1) for $f, $g, $h;

    # save the frames.
    $CONFDATA{FORMS}{$projid}{$name} = [$f, $g, $h];

    # populate the widget options frame
    {
      my $f = $f->Frame->pack(qw/-side top -fill x/);

      { # The name
	my $name2 = $name;

	my $label = ZooZ::Options->addOptionGrid('Name',
						 'Name',
						 $f,
						 0,
						 0,
						 \$name2,
						 'tan',
						);

	Tie::Watch->new(
			-variable => \$name2,
			-store    => [\&changeWidgetName,
				      $project,
				      \$name,
				      $label,
				      $projid,
				      'tan'],
		       );
      }

      # If it's a toplevel, add a title.
      if (ref($widget) eq 'Tk::Toplevel') { # The name
	my $title = $widget->title;#$project->{PROJNAME};

	my $label = ZooZ::Options->addOptionGrid('Title',
						 'Title',
						 $f,
						 1,
						 0,
						 \$title,
						 'tan',
						);

	Tie::Watch->new(
			-variable => \$title,
			-store    => sub {
			  my ($self, $v) = @_;

			  $self->Store($v);
			  $widget->title($title);
			},
			#[\&changeWidgetName,
			#	      $project,
			#	      \$name,
			#	      $label,
			#	      $projid,
			#	      'tan'],
		       );
      }
      #$f->gridRowconfigure(1, -minsize => 10);

      my @conf = grep @$_ > 2, $widget->configure;
      my $row  = 2;
      for my $c (@conf) {
	my $option = $c->[0];

	next if exists $ignoreOptions{$option};

	# default value.
	$Woptions->{$option} ||= $c->[4];

	###
	### IMPORTANT: If it's -variable, then reset the value to nothing.
	###            This prevents a 'panic' crash in ptk.
	###            Not sure I understand why.

	$Woptions->{$option} = '' if $option eq '-variable' || $option eq '-textvariable';

	my @extra;   # additional options to be passed to ZooZ::Options::addOptionGrid

#	if ($option eq '-font') {
#	  $widget->configure(-font => 'Default');
#	  @extra = ($::FONTOBJ);

#	} elsif ($option eq '-command') {
#	  @extra = ($::CALLBACKOBJ);

#	} elsif ($option =~ /^-(?:text)?variable$/) {
#	  @extra = ($::VARREFOBJ);

#	} else {
#	  @extra = ();
#	}

	if ($option eq '-textvariable') {
	  @extra = (\$Woptions->{-text});
	}

	my $label = ZooZ::Options->addOptionGrid($option,
						 $option,   # might want to change this?
						 $f,
						 $row,
						 0,
						 \$Woptions->{$option},
						 @extra,
						);

	# Now tie the variable so we can instantly see the changes.
	tie $Woptions->{$option} =>
	  'ZooZ::TiedVar', $widget, $c->[4], 'configure', $option, $label;

	$row++;
      }

      $f->gridColumnconfigure(0,      -weight => 1);

      # Handle special tabs for special widgets.
      # For notebooks, add tab to add/delete pages.
      if (main::NOTEBOOK_SUPPORT && ref($widget) eq 'Tk::NoteBook') {
	# add one tab.
	# A notebook is allowed to have at least one tab.
	my $defaultTabName  = 'Tab1';
	my $defaultTabLabel = 'Tab 1';
	my $tab1 = $widget->add($defaultTabName => -label => $defaultTabLabel);

	# make room for it in the preview.
	$tab1  ->GeometryRequest(100, 100);
	$widget->Resize;

	# create the toplevel.
	$f->Button(-text    => 'Manage Pages',
		   -command => sub {
		     unless (exists $CONFDATA{NBCONF}{$projid}{$name}) {
		       my $t = $f->toplevel->Toplevel;
		       $t->withdraw;
		       $t->title   ("Notebook Configuration - $name");
		       $t->protocol(WM_DELETE_WINDOW => [$t => 'withdraw']);

		       # populate it.
		       my $lf = $t->Labelframe(-text => 'Current Pages',
					      )->pack(qw/-fill both -side left -expand 1/);
		       my $rf = $t->Labelframe(-text => 'Add Page',
					      )->pack(qw/-fill both -side right -expand 1/);

		       my $lb = $lf->Scrolled(Listbox     =>
					      -scrollbars => 'se',
					      -selectmode => 'single',
					     )->pack(qw/-fill both -expand 1/);

		       $lf->Button(-text    => 'Delete Selected Page',
				   -command => sub {
				     my ($ind) = $lb->curselection;
				     defined $ind or return;
				     my $sel   = $lb->get($ind);

				     my @pages = $widget->pages;

				     print "There are ", scalar @pages, " pages ($ind).\n";
				     # Can't delete if there is only one page.
				     if (@pages == 1) {
				       ZooZ::Generic::popMessage
					   (-over  => $::MW,
					    -msg   => "Must keep at least one tab!",
					    -font  => 'Level',
					    -bg    => 'White',
					    -delay => 1500);
				       return;
				     }

				     # delete the page.
				     # should I prompt the user to confirm?
				     # this will delete all children of the page.

				     delete $CONFDATA{NBCONF}{$projid}{$name}{TABS}{$sel};
				     $widget->delete($sel);

				     # remove it from the lb.
				     $lb->delete($ind);

				     @pages = $widget->pages;
				     print "Now there are ", scalar @pages, " pages.\n";
				   })->pack(qw/-fill x -expand 1/);

		       $CONFDATA{NBCONF}{$projid}{$name} = {
							    TOP   => $t,
							    LB    => $lb,
							    OPTS  => {},
							    TABS  => {
								      $defaultTabName => [$defaultTabLabel, $tab1],
								     }
							   };

		       my $o = $CONFDATA{NBCONF}{$projid}{$name}{OPTS};

		       my $p = $rf->Scrolled('Pane',
					     -sticky     => 'nsew',
					     -scrollbars => 'e',
					    )->pack(qw/-fill both -expand 1/);

		       my $row = 0;
		       for my $option (Name => @TAB_OPTIONS) {

			 ZooZ::Options->addOptionGrid($option,
						      $option,
						      $p,
						      $row++,
						      0,
						      \$o->{$option},
						     );
		       }

		       $rf->Button(-text    => 'Add Page',
				   -command => sub {
				     return unless $o->{Name};

				     # does the page exist?
				     my @pages = $widget->pages;
				     if (grep $_ eq $o->{Name}, @pages) {
				       ZooZ::Generic::popMessage
					   (-over  => $::MW,
					    -msg   => "Page '$o->{Name}' already exists!",
					    -font  => 'Level',
					    -bg    => 'White',
					    -delay => 1500);
				       return;
				     }

				     # add it.
				     my $tab = $widget->add($o->{Name}, map {
				       $_ ne 'Name' && $o->{$_} ? ($_ => $o->{$_}) : ()
				     } keys %$o);

				     # make room for it in the preview.
				     $tab   ->GeometryRequest(100, 100);
				     $widget->Resize;

				     $CONFDATA{NBCONF}{$projid}{$name}{TABS}{$o->{Name}} = [$o->{-label}, $tab];
				     $lb->insert(end => $o->{Name});

				   })->pack(qw/-fill x/);

		       # When a user clicks on a listbox entry, the options are updated.
		       $lb->bind('<1>' => sub {
				   my ($sel) = $lb->curselection;
				   defined $sel or return;
				   $sel    = $lb->get($sel);

				   #my $tabs = $CONFDATA{NBCONF}{$projid}{$name}{TABS};
				   $o->{Name} = $sel;
				   $o->{$_}   = $widget->pagecget($sel, $_) for @TAB_OPTIONS;
				 });

		       $p->gridRowconfigure($row, -weight => 1);

		       ZooZ::Generic::BindMouseWheel($t, $p);
		     }

		     # update the listbox.
		     my $ref = $CONFDATA{NBCONF}{$projid}{$name};
		     $ref->{LB}->delete(qw/0 end/);
		     $ref->{LB}->insert(end => $_) for keys %{$ref->{TABS}};

		     $ref->{TOP}->deiconify;
		     #$top->waitVisibility;

		   })->grid(-row        => $row,
			    -column     => 0,
			    -sticky     => 'nsew',
			    -columnspan => 3,
			    -pady       => 10,
			    -pady       => 5,
			   );

	# Check if we have menu builder support enabled.
      } elsif (main::MENU_BUILDER_SUPPORT && ref($widget) eq 'Tk::Toplevel') {
	$MENUS[$projid]{ENABLED} = 0;

	my $lf;
	my $cb = $f->Checkbutton(-text     => 'Add Menu',
				 -variable => \$MENUS[$projid]{ENABLED},
				 -command  => sub {
				   if ($MENUS[$projid]{ENABLED}) {
				     $_->configure(-state => 'normal')   for $lf->children;
				   } else {
				     $_->configure(-state => 'disabled') for $lf->children;
				   }
				 });

	$lf = $f->Labelframe(#-text => 'Menus',
			     -labelwidget => $cb,
			     -relief      => 'ridge',
			    )->grid(-row        => $row+1,
				    -column     => 0,
				    -sticky     => 'nsew',
				    -columnspan => 3,
				   );

	$lf->Button(-text    => 'Configure Menu',
		    -command => [\&configureMenu, __PACKAGE__, $project, $projid, $name, $widget],
		   )->pack(qw/-fill both -expand 1/);

	# initially .. set everything to disabled state.
	$_->configure(-state => 'disabled') for $lf->children;
      }

    }

    # populate the placement options frame.
    if (defined $Poptions) {
      my $f1 = $g->Labelframe(-text => "Stick to Which Container's Edge",
			     )->pack(qw/-side top -fill both -expand 0/);
      my $f2 = $g->Labelframe(-text => "Internal Padding",
			     )->pack(qw/-side top -fill both -expand 0/);
      my $f3 = $g->Labelframe(-text => "External Padding",
			     )->pack(qw/-side top -fill both -expand 0/);
      my $f4 = $g->Labelframe(-text => 'Apply Same Settings to ...',
			     )->pack(qw/-side top -fill both -expand 0/);

      for my $ref ([qw/North n/],
		   [qw/South s/],
		   [qw/East  e/],
		   [qw/West  w/]
		  ) {

	$Poptions->{$ref->[1]} ||= '';

	$f1->Checkbutton(-text        => $ref->[0],
			 -onvalue     => $ref->[1],
			 -offvalue    => '',
			 -borderwidth => 1,
			 -variable    => \$Poptions->{$ref->[1]},
			 -font        => 'OptionText',
			 -command  => sub {
			   $Poptions->{-sticky} = join '' => @{$Poptions}{qw/n s e w/};
			 })->pack(qw/-side top -anchor w/);
      }

      tie $Poptions->{-sticky} =>
	'ZooZ::TiedVar', $widget, '', 'grid', '-sticky';

      my $row = 0;
      for my $ref (['Horizontal', '-ipadx'],
		   ['Vertical',   '-ipady'],
		  ) {

	$Poptions->{$ref->[1]} ||= 0;

	my $label = ZooZ::Options->addOptionGrid(
						 $ref->[1],
						 $ref->[0],
						 $f2,
						 $row,
						 0,
						 \$Poptions->{$ref->[1]},
						);

	tie $Poptions->{$ref->[1]} =>
	  'ZooZ::TiedVar', $widget, 0, 'grid', $ref->[1], $label;

	$row++;
      }

      $row = 0;
      for my $ref (['Horizontal', '-padx'],
		   ['Vertical',   '-pady'],
		  ) {

	$Poptions->{$ref->[1]} ||= 0;

	my $label = ZooZ::Options->addOptionGrid(
						 $ref->[1],
						 $ref->[0],
						 $f3,
						 $row,
						 0,
						 \$Poptions->{$ref->[1]},
						);

	tie $Poptions->{$ref->[1]} =>
	  'ZooZ::TiedVar', $widget, 0, 'grid', $ref->[1], $label;

	$row++;
      }

      $_->gridColumnconfigure(0, -weight => 1) for $f2, $f3;
      $_->gridColumnconfigure(1, -weight => 5) for $f2, $f3;

      my $duplicate = 'All Widgets';
      $f4->BrowseEntry(
		       -choices => [
				    'All Widgets',
				    'Similar Widgets',
				    'All Widgets in Same Row',
				    'All Widgets in Same Column',
				    'Similar Widgets in Same Row',
				    'Similar Widgets in Same Column',
				   ],
		       -state   => 'readonly',
		       -variable => \$duplicate,
		       -disabledforeground => 'black',
		      )->pack(qw/-side top -fill x -padx 10 -pady 10/);
      $f4->Button(-text    => 'Apply',
		  -command => [$project, 'duplicatePlacementOptions', \$duplicate],
		 )->pack(qw/-fill x/);
    }

    # populate the extra options frame
    if (defined $Eoptions) {
      # First, the scrollbars options.
      my $f1 = $h->Labelframe(-text => 'Scrollbars',
			     )->pack(qw/-side top -fill both -expand 0/);

      $Eoptions->{$_} = 0  for qw/SCROLLON HOPTIONAL VOPTIONAL/;
      $Eoptions->{$_} = '' for qw/HSCROLLLOC VSCROLLLOC/;

      my $scrollCB = $f1->Checkbutton(-text     => 'Enable Scrollbars',
				      -variable => \$Eoptions->{SCROLLON},
				      -font     => 'OptionText',
				     )->pack(qw/-side top/);

      my $f11 = $f1->Frame(-relief      => 'sunken',
			   -borderwidth => 1,
			  )->pack(qw/-side top -fill both -expand 1/);

      $f11->Label(-text => 'Horizontal',
		 )->grid(-column => 0, -row => 1, -sticky => 'w');

      $f11->Checkbutton(-text     => 'Display Only if Needed',
			-variable => \$Eoptions->{HOPTIONAL},
			-font     => 'OptionText',
		       )->grid(-column => 1,
			       -row    => 1,
			       -sticky => 'w',
			       -columnspan => 3,
			      );
      $f11->Radiobutton(-text     => 'North',
			-value    => 'n',
			-variable => \$Eoptions->{HSCROLLLOC},
			-font     => 'OptionText',
		       )->grid(-column => 1,
			       -row    => 2,
			       -sticky => 'ew');
      $f11->Radiobutton(-text     => 'South',
			-value    => 's',
			-variable => \$Eoptions->{HSCROLLLOC},
			-font     => 'OptionText',
		       )->grid(-column => 2,
			       -row    => 2,
			       -sticky => 'ew');
      $f11->Radiobutton(-text     => 'None',
			-value    => '',
			-variable => \$Eoptions->{HSCROLLLOC},
			-font     => 'OptionText',
		       )->grid(-column => 3,
			       -row    => 2,
			       -sticky => 'ew');

      $f11->Label(-text => 'Vertical',
		 )->grid(-column => 0, -row => 3, -sticky => 'w');

      $f11->Checkbutton(-text     => 'Display Only if Needed',
			-variable => \$Eoptions->{VOPTIONAL},
			-font     => 'OptionText',
		       )->grid(-column => 1,
			       -row    => 3,
			       -sticky => 'w',
			       -columnspan => 3,
			      );
      $f11->Radiobutton(-text     => 'East',
			-value    => 'e',
			-variable => \$Eoptions->{VSCROLLLOC},
			-font     => 'OptionText',
		       )->grid(-column => 1,
			       -row    => 4,
			       -sticky => 'ew');
      $f11->Radiobutton(-text     => 'West',
			-value    => 'w',
			-variable => \$Eoptions->{VSCROLLLOC},
			-font     => 'OptionText',
		       )->grid(-column => 2,
			       -row    => 4,
			       -sticky => 'ew');
      $f11->Radiobutton(-text     => 'None',
			-value    => '',
			-variable => \$Eoptions->{VSCROLLLOC},
			-font     => 'OptionText',
		       )->grid(-column => 3,
			       -row    => 4,
			       -sticky => 'ew');

      $f11->gridColumnconfigure(0, -weight => 1);

      # start with all disabled.
      $_->configure(-state => 'disabled') for $f11->children;

      # Tie the variables.
      # Whenever the SCROLLON value changes, enable/disable the options.
      Tie::Watch->new(
		      -variable => \$Eoptions->{SCROLLON},
		      -store    => [\&scrollState, $Eoptions, $widget, $f11],
		     );

      # Show appropriate scrollbars when chosen.
      Tie::Watch->new(
		      -variable => \$Eoptions->{HSCROLLLOC},
		      -store    => [\&addScrolls, $Eoptions, $widget],
		     );

      Tie::Watch->new(
		      -variable => \$Eoptions->{VSCROLLLOC},
		      -store    => [\&addScrolls, $Eoptions, $widget],
		     );

      # is it scrollable?
      $scrollCB->configure(-state => 'disabled') unless $scroll;
    }

  }

  # configure the window title
  my $top = $TOPLEVEL{configureWidget};
  $top->title("Configure Widget - Project $projid");

  return if $noforce && !$top->ismapped;

  # display the correct frames in the notebook.
  $_->packForget for map $_->packSlaves => (
					    $CONFDATA{NBPLACE},
					    $CONFDATA{NBWIDGET},
					    $CONFDATA{NBEXTRA}
					   );

  $_->pack(qw/-fill both -expand 1/) for @{$CONFDATA{FORMS}{$projid}{$name}};

  # set the state of the tabs.
  $CONFDATA{NB}->pageconfigure(NBPLACE => -state => defined $Poptions ? 'normal' : 'disabled');
  $CONFDATA{NB}->pageconfigure(NBEXTRA => -state => defined $Eoptions ? 'normal' : 'disabled');

  # pop-up the window if we have to.
  unless ($top->ismapped) {
    $top->deiconify;
    $top->geometry($top->reqwidth . 'x500');
  }
  $top->raise;
}

sub scrollState {
  my ($self, $val) = @_;

  $self->Store($val);

  my $args = $self->Args('-store');
  my $o    = shift @$args;
  my $w    = shift @$args;

  $_->configure(-state => $val ? 'normal' : 'disabled')
    for map $_->children => @$args;

  $w->configure(-scrollbars => $val ? "$o->{HSCROLLLOC}$o->{VSCROLLLOC}" : '');
}

sub addScrolls {
  my ($self, $val) = @_;

  $self->Store($val);
  my $args = $self->Args('-store');

  my ($o, $w) = @$args;
  my $h = $o->{HSCROLLLOC};
  my $v = $o->{VSCROLLLOC};

  $w->configure(-scrollbars => "$h$v");
}

sub chooseFont {
  my ($class, $ref) = @_;

  # update the list.
  {
    $FONTDATA{list}->delete(qw/0 end/);
    $FONTDATA{list}->insert(end => $_) for
      'Default', grep $_ ne 'Default' => sort $::FONTOBJ->listAll;
  }

  $FONTDATA{localReturn} = '';
  $TOPLEVEL{chooseFont}->deiconify;
  $TOPLEVEL{chooseFont}->grab;
  $TOPLEVEL{chooseFont}->waitVariable(\$FONTDATA{localReturn});
  $TOPLEVEL{chooseFont}->grabRelease;
  $TOPLEVEL{chooseFont}->withdraw;

  return $FONTDATA{localReturn};
}

sub chooseVar {
  my ($class, $ref) = @_;

  # update the list.
  {
    $VARDATA{list}->delete(qw/0 end/);
    $VARDATA{list}->insert(end => $_) for $::VARREFOBJ->listAll;
  }

  $VARDATA {localReturn} = '';
  $TOPLEVEL{chooseVarRef}->deiconify;
  $TOPLEVEL{chooseVarRef}->grab;
  $TOPLEVEL{chooseVarRef}->waitVariable(\$VARDATA{localReturn});
  $TOPLEVEL{chooseVarRef}->grabRelease;
  $TOPLEVEL{chooseVarRef}->withdraw;

  return $VARDATA{localReturn};
}

sub chooseCallback {
  my ($class, $ref) = @_;

  # update the list.
  {
    $CBDATA{list}->delete(qw/0 end/);
    $CBDATA{list}->insert(end => $_) for $::CALLBACKOBJ->listAll;
  }

  $CBDATA  {localReturn} = '';
  $TOPLEVEL{chooseCallback}->deiconify;
  $TOPLEVEL{chooseCallback}->grab;
  $TOPLEVEL{chooseCallback}->waitVariable(\$CBDATA{localReturn});
  $TOPLEVEL{chooseCallback}->grabRelease;
  $TOPLEVEL{chooseCallback}->withdraw;

  return $CBDATA{localReturn};
}

sub configureSampleFont {
  my $sample = shift;

  $sample->configure(
		     -font => [$FONTDATA{family},
			       $FONTDATA{size},
			       $FONTDATA{weight},
			       $FONTDATA{slant},
			       $FONTDATA{underline}  ? 'underline'  : (),
			       $FONTDATA{overstrike} ? 'overstrike' : ()],
		    );

}

sub cancelForm {
  my $h = shift;

  $h->{localReturn} = '';
}

sub cancelAllForms {
  cancelForm($_) for \%VARDATA, \%CBDATA, \%FONTDATA;
}

sub setup_configureRowCol {
  my ($class, $top) = @_;

  $ROWCOLDATA{title} =
    $top->Label(-font   => [helvetica => 12],
		-fg     => 'darkolivegreen',
		-bg     => 'white',
		-bd     => 1,
		-relief => 'ridge',
		-pady   => 5,
	       );
}

sub configureRowCol {
  my ($class,
      $projid,    # project id.
      $hier,      # current hierarchy
      $widget,    # preview top.
      $rowORcol,  # whether 'row' or 'col'
      $index,     # row or col number.
      $options,   # options hash
     ) = @_;

  unless (exists $ROWCOLDATA{$projid}{$hier}{$rowORcol}[$index]) {
    my $f = $TOPLEVEL{configureRowCol}->Frame;

    # populate it.
    my $row = 0;
    for my $ref (
		 ['Extra Space Greediness', '-weight',  0],
		 ['Minimum Size',           '-minsize', 0],
		 ['Extra Padding',          '-pad',     0],
		) {

      $options->[$index]{$ref->[1]} ||= $ref->[2];

      my $label = ZooZ::Options->addOptionGrid($ref->[1],
					       $ref->[0],
					       $f,
					       $row,
					       0,
					       \$options->[$index]{$ref->[1]},
					      );

      my $default = $options->[$index]{$ref->[1]};

      tie $options->[$index]{$ref->[1]}, 'ZooZ::TiedVar', $widget, $default,
	($rowORcol eq 'row' ? 'gridRowconfigure' :
	 'gridColumnconfigure'),
	   $ref->[1], $label, [$index];

      # update the value. This will call the callback.
      $options->[$index]{$ref->[1]} = $options->[$index]{$ref->[1]};

      $row++;
    }

    $ROWCOLDATA{$projid}{$hier}{$rowORcol}[$index] = $f;
  }

  my $top = $TOPLEVEL{configureRowCol};
  $_->packForget for $top->packSlaves;

  # fix and pack the title.
  $ROWCOLDATA{title}->pack(qw/-fill both -expand 1/);
  $ROWCOLDATA{title}->configure(-text => "Configuring $hier \u$rowORcol $index");

  # now pack the form.
  $ROWCOLDATA{$projid}{$hier}{$rowORcol}[$index]->pack(qw/-fill both -expand 1/);
  $top->title("Configure \u$rowORcol $index - Project $projid");

  $top->deiconify;
  $top->update;
  $top->geometry($top->reqwidth . 'x' . $top->reqheight);
  $top->raise;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

ZooZ::Forms

=head1 VERSION

version 1.9.1

=head1 AUTHOR

Ala Qumsieh, faraco <skelic3@gmail.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2004-2005, 2018 by Ala Qumsieh, faraco.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut
