#!/usr/lib/perl
##              -w -d:ptkdb

=pod

=head1 ctkWidgetLib

	Class ctkWidgetLib models a widget class library in the ctk environment.
	It controls all widgets which may be generated by ctk,
	in order to keep them ready to be used (accessed) while
	ctk sessions.

	That means it registers, loads and saves the widget definitions,
	whereby

	'register' a widget means make it known to ctk,
	'save' means make the widget definitions persistent into a dedicated folder of ctk,
	'load' means make the saved widget accessable while a ctk session for use.

	Standard TK-widget are automatically registered.

	Derived or composite widget should be individually and explicitely registered.

=head2 Widget class properties

	classname the name of the widget class: valid class name,
	          optional, default file name whithout extension

	filename  the file name of the widget definition: valid file name,
	          optional, default classname.'.pl'

	defaultwidgetoptions list of the default widget options,
	                     optional, no default.

	geom       the widget needs the geometry manager, mandatory,
	           0 | 1

	defaultgeometrymanager name of the geometry manager to be be proposed,
	                       default 'pack' .

	defaultgeometryoptions list of the default options, optional.

	use        package name to be given in the use statement, optional,
	           default 'Tk::'.classname,
	           '  ' suppress tne generation of the use statement for the widget.

	balloon    set up an hint to the widget, mandatory,
	           0 | 1

	icon       name of the image file to be used as icon
	           (may be any file supported by widget Photo),
	           default (missing.gif)

	attr       supported widget's attribute list.

=head2 Syntax

	$widgetClassLib = ctkWidgetLib->new(widgetlib => <widget library folder>, widgets => <ref to widget list>);

	$widgetClassLib->create(<classname>);

	$widgetClassLib->createNonVisualClass(<classname>);

	$widgetClassLib->loadAll();

	$widgetList = $widgetClassLib->widgets;

	$pathToWidgetLib = $widgetClassLib->widgetlib;

	$widgetClassLib->register(<ref to parent widget>[,<classname>]);


	$widgetClassDef = $widgetClassLib->load(<classname>);

	$widgetClassLib->saveAll();

	$widgetClassLib->save(<widgetClass>)

	$widgetClassLib->dlg_widgetRegistrationsParam(<ref to parent widget>,<classname>);

	$widgetClassLib->registerWidgetClassDefinition();

	$widgetClassLib->editWidgetOptions(<ref to dialog widget>,<classname>,<useFileName>,<attr>);

	$widgetClassLib->deleteWidgetClass(<widgetClass>);

	$widgetClassLib->validateUseName(<use>,<askuser>);

=head2 Programming notes

=over

=item Actually the individual class definitions are ref to HASH.

=item Run time environment

	Almost all methods need the active run time env of ctk_w.
		- cwd must be the clickTk folder
		- widget library
		- widget class definition list

=back

=head2 Maintenance

	Author: mam
	date:   01.01.2005
	History
	        01.01.2005 MO000xx mam First draft
	        25.10.2005 MO00704 version 1.02
	        28.10.2005 MO00705 version 1.03
	        15.09.2006 version 1.04
			02.10.2006 version 1.05
			05.10.2006 version 1.06
			20.11.2007 version 1.07
			14.03.2008 version 1.09

=head1 Methods

=cut

package ctkWidgetLib;

use strict;
use base (qw/ctkBase/);

our $VERSION = 1.09;

my $FS = ($^O =~ /^mswin/i) ? '\\' : '/';

sub widgetlib { shift->{widgetlib} }
sub widgets {shift->{widgets}}
sub class {shift->{class}}
sub use {return shift->use}

sub new {
	my $class = shift;
	my (%args) = @_;
	$class = ref($class) || $class ;
	my $self = $class->SUPER::new(%args);
	bless  $self, $class;
	$self->_init(%args);

	return $self
}

sub destroy {
	my $self = shift;
	$self ={}
}

## --------------------------------------------------------

sub _init {
	my $self = shift;
	my (%args) = @_;
	if (exists $args{widgetlib}) {
			$self->{widgetlib} = delete $args{widgetlib}
	} else {
		$self->{widgetlib} = 'widgets';
	}
	if (exists $args{widgets}) {
			$self->{widgets} = delete $args{widgets}
	} else {
		$self->{widgets} = {};
	}
	if (exists $args{widget}) {
			$self->{widget} = delete $args{widget}
	} else {
		$self->{widget} = {};
	}
	return 1
}

=head2 fileName

	Build the standard file name of a widget class definition.
	It returns the file name corresponding to the given widget class

	Note : this method doesn't check whether the file exists.

=cut

sub fileName {
	my $self = shift;
	my ($widgetClass) = @_;
	my $rv ='';
	my $fName = $self->widgets->{$widgetClass}->{'file'} if (exists $self->widgets->{$widgetClass});
	$fName =~ s/\.pl$//;
	$fName = $widgetClass unless ($fName);
	my $p = $self->widgetlib();
	$p .= $FS unless $p =~ /[\\\/]$/;
	$rv = $p . $fName . '.pl';
	return $rv
}

=head2 _backup

	move the widget definition file to a backup image.

	That is done unlinking the actually existing backup and 
	renaming the existing file to <fileName>.bak .

	It returns true if the rename worked fine.

=cut

sub _backup {
	my $self = shift;
	my ($className) = @_;
	my $rv;
	my $fName = $self->fileName($className);
	unlink "$fName.bak" if (-f "$fName.bak");
	$rv = rename "$fName","$fName.bak";
	return $rv
}

=head2 register

	- Register a single widget class to ctk_w .
	- send message registerWidgetClassDefinition to do the job.

=cut

sub register {
	my $self = shift;
	my ($hwnd,$type) = @_;
	my $rv ;
	if (defined($type)) {
		$rv = $self->registerWidgetClassDefinition($hwnd,$type);
	} else {
		$rv = $self->registerWidgetClassDefinition($hwnd);
	}
	return $rv;
}

=head2 create

	This method returns a ref to HASH which contains all data members
	of a widgetLib intance. All memeber but classname are initialized
	to their default values.
	Classname is given the value passed to as argument.

		geom        = 1,
		nonVisual   = 0,
		balloon     = 1,
		use         = '',
		file        = '',
		classname   = ,
		defaultgeometrymanager = 'pack',
		defaultgeometryoptions = '',
		defaultwidgetoptions   = '',
		icon        = 'default',
		attr        = {}

=over

=item Arguments

	class name

=item Returns

	ref to HASH.

=item Notes

	None.

=back

=cut

sub create {
	my $self = shift;
	my ($type) = @_;
	my $rv = {
		'geom'		=> 1,
		'nonVisual'	=> 0,
		'balloon'	=> 1,
		'use'		=> '',
		'file'		=> '',
		'classname'	=> "$type",
		'defaultgeometrymanager' => 'pack',
		'defaultgeometryoptions' => '',
		'defaultwidgetoptions'	=> '',
		'icon'		=> 'default',
		'attr'		=> {}
		};
	return $rv;
}

=head2 createNonVisualClass

	Same as create but specialized for nonvisual classes.

=cut

sub createNonVisualClass {
	my $self = shift;
	my ($class) = @_;
	my $rv = $self->create($class);
	$rv->{'nonVisual'} = 1;
	$rv->{'geom'} = 0;
	$rv->{'icon'} = 'nonvisual';
	$rv->{use} = $class;
	return $rv;
}

=head2 loadAll - load all widget into memory

	This method returns ref to hash containing all actually registered widgets.

	It creates the widget list and always saves a ref to that list into
	the property 'widgets'.

	Additionally it returns that ref to the issuer.

	Note: this method scans the widgets folder for file names ending with '.pl'
	      which are assumed to be class definitions.
	      Once loaded the definition are stored using the value of the item 'classname'
	      If this item doesn't exists then the file name without extension is used as class name instead.

=cut

sub loadAll {
	my $self = shift;
	my $rv = {};
	local *DIR;
	opendir(DIR, $self->{widgetlib});
	my @wDefs;
	@wDefs = grep {
			/\w+\.pl$/
			} readdir(DIR);
	closedir DIR;
	foreach my $def (@wDefs) {
		my $w = $self->load($def);
		my $id =$def; $id =~ s/\.pl$//;
		$id = $w->{'classname'} if(exists $w->{'classname'});
		if (exists $w->{'use'}) {
			unless ($w->{'use'} =~ /^\s*$/) { ## empty value suppresses use
				my $n = $w->{'use'};
				$n = 'Tk::'.$id unless $n =~ /\S+/;
				unless ($self->validateUseName($n,0)) {
					&main::Log('Widget class '.$n.' does not exist yet, discarded');
					next
				}
			}
		} else {
			my $n = 'Tk::'.$id;
			unless ($self->validateUseName($n,0)) {
				&main::Log('Widget class '.$n.' does not exist yet, discarded');
				next
			}
		}
		$w->{'filename'} = $def;
		if (!exists($rv->{$id})) {
			$rv->{$id} = $w if(defined($w));
		} else {
			&main::Log("There are more than one def for '$id', '$def' skipped, pls check.");
		}
	}
	$self->{widgets} = $rv;
	return $rv
}

=head2 load - Load a definition into memory

	This method returns a ref to an instance of type ctkWidgetLib
	if the job has been well done, undef otherwise.

	Arguments

		self
		file name of the def

	Return

	ref to the definition or
	UNDEF in case of errors.

=cut

sub load {
	my $self = shift;
	my ($fName) = @_;
	my $rv;
	local *WD;
	my $path = $self->widgetlib;
	$path .= $FS unless($path =~ /[\\\/]$/);
	open (WD,"<$path$fName");
	unless (*WD) {
		&std::ShowDialog(-title=>'Error:',-text=>"Could not open '$fName',\ncannot save widget!",-buttons=>['Continue']);
		};
	my @s = <WD>;
	close WD;
	
	$rv = eval 'my '.join '',@s;
	if ($@) {
		&main::log("Could not load widget def '$fName' because of ",$@,'definition ignored ');
		$rv = undef
	}
	$rv->{nonVisual} = 0 unless exists $rv->{nonVisual};
	return $rv
}

=head2 save - save  widget definition

	The method save saves the currently active widget class definition
	into the persistent widget definition's library.

	To do that task it accesses the widget class list applying the given classname and uses Data::Dumper->Dump and returns
	the file name.

=cut

sub save {
	my $self = shift;
	my ($w) = @_;
	my $w_attr = $self->widgets;

	return undef unless exists $w_attr->{$w};

	my $file = $self->fileName($w);

	$self->_backup("$w") if (-f $file);

	require Data::Dumper;
	open (WD,">$file");
	unless (*WD) {
			&std::ShowDialog(-title=>'Error:',-text=>"Could not open '$file',\ncannot save work!",-buttons=>['Continue']);
			return undef;
		};
	$Data::Dumper::Indent = 1;		# turn indentation to a minimum
	my $s = Data::Dumper->Dump([$w_attr->{$w}],['rDef']);
	print WD $s;
	close WD;
	return $file;
}


=head2 saveAll - Save widgets persistently to disk

	Method saveAll returns true if the job has been well done
	undef otherwise.

=cut

sub saveAll {
	my $self = shift;
	my $rv = 1;
	my $w_attr = $self->{widgets};
	foreach my $w (keys %$w_attr) {
		my $f = $self->save($w);
		if (defined($f)) {
			&main::Log("Widget definition '$w' saved into 'widget$FS$f'");
		} else {
			$rv = undef;
		}
	}
	return $rv
}

=head2 dlg_widgetRegistrationsParam

	This method sets up modal dialog to enter options.

	It returns a ref to HASH containing all definition's options,
	or undef if the user dismissed the action.

=cut

sub dlg_widgetRegistrationsParam {
my $self = shift;
my ($hwnd,$type) = @_;
my $rv;
##
my $db = $hwnd->ctkDialogBox(
   -title=> 'Enter widget registration parameters',
   -buttons=> ['OK','Cancel']);


my ($attr,$geom,$nonVisual,$balloon, $geomManager,$geomOptions,$widgetOptions,$defFileName,$useFileName,$className,$iconName);

	if (defined($type)) {
		my $w_attr = $self->widgets;
		$geom          = $w_attr->{$type}->{'geom'};
		$nonVisual     = $w_attr->{$type}->{'nonVisual'};
		$balloon       = $w_attr->{$type}->{'balloon'};
		$useFileName   = $w_attr->{$type}->{'use'};
		$defFileName   = $w_attr->{$type}->{'file'};
		$className     = $w_attr->{$type}->{'classname'};
		$geomManager   = $w_attr->{$type}->{'defaultgeometrymanager'};
		$geomOptions   = $w_attr->{$type}->{'defaultgeometryoptions'};
		$widgetOptions = $w_attr->{$type}->{'defaultwidgetoptions'};
		$iconName      = $w_attr->{$type}->{'icon'};
		$attr          = $w_attr->{$type}->{'attr'};
		$className = $type unless ($className);
	} else {
		$attr = {}; $geom = $balloon = 0;
		$geomManager = 'pack';
		$defFileName = $useFileName = $className = '';
		$iconName = 'default';
	}
## ctk: gcode

## ctk: gcode
## ctk: code generated by ctk_w version '2.018'
## ctk: lexically scoped variables for widgets

my $rW001 ;
my $rW013 ;
my $rW017 ;
my $rW002 ;
my $rW011 ;
my $rW_register ;
my $rW_widgetOptionsList ;
my $rWgeomMan ;
my $rW_geomOpt ;
my $rW_widgetOpt ;
my $rW_geom ;
my $rW_nonVisual ;
my $rW_balloon ;
my $rW_defFile ;
my $rW_use ;
my $rW_classname ;
my $rW_icon ;

## ctk: instantiate and display widgets

$rW001 = $db -> LabFrame ( -label=>'Widget definition options', -borderwidth=>1, -relief=>'ridge', -labelside=>'acrosstop' ) -> pack(-anchor=>'nw', -fill=>'both', -side=>'top', -expand=>1);
$rW017 = $rW001 -> Frame ( -relief=>'solid' ) -> pack(-anchor=>'nw', -pady=>10, -fill=>'x', -side=>'top', -expand=>1);
$rW013 = $rW001 -> Frame ( -borderwidth=>2, -relief=>'flat' ) -> pack(-anchor=>'nw', -fill=>'y', -side=>'top', -expand=>1);
$rW002 = $db -> LabFrame ( -label=>'Default options', -borderwidth=>1, -relief=>'ridge', -labelside=>'acrosstop' ) -> pack(-anchor=>'nw', -pady=>3, -fill=>'both', -side=>'top', -expand=>1, -padx=>5);
$rW011 = $db -> Frame ( -relief=>'flat' ) -> pack(-anchor=>'nw', -pady=>2, -fill=>'both', -side=>'top', -expand=>1, -padx=>5);

$rW_widgetOptionsList = $rW011 -> Button ( -background=>'#ffffff', -command=>sub{
					$useFileName = "Tk::$className" unless ($useFileName);
					my $attrNew = ($nonVisual) ?
					$self->editNonVisualClassOptions($db,$className,$useFileName,$attr)
					:
					$self->editWidgetOptions($db,$className,$useFileName,$attr);
					$attr = $attrNew if defined($attrNew);
					}, -state=>'normal', -text=>'Widgets options list' ) -> pack(-anchor=>'nw', -fill=>'x', -side=>'left', -expand=>1);

$rWgeomMan = $rW002 -> BrowseEntry ( -background=>'#ffffff', -label=>'geometry manager', -labelPack=>[-side,'left',-anchor,'nw'], -state=>'normal', -justify=>'left', -variable=>\$geomManager, -choices => [qw/pack grid place form/] ) -> grid(-row=>0, -pady=>10, -column=>0, -sticky=>'we', -padx=>20);
$rW_geomOpt = $rW002 -> LabEntry ( -background=>'#ffffff', -label=>'geometry options', -labelPack=>[-side,'left',-anchor,'nw'], -state=>'normal', -justify=>'left', -relief=>'sunken', -textvariable=>\$geomOptions ) -> grid(-row=>1, -pady=>10, -column=>0, -sticky=>'we', -padx=>20);
$rW_widgetOpt = $rW002 -> LabEntry ( -background=>'#ffffff', -label=>'widget options', -labelPack=>[-side,'left',-anchor,'nw'], -state=>'normal', -justify=>'left', -relief=>'sunken', -textvariable=>\$widgetOptions ) -> grid(-row=>2, -pady=>10, -column=>0, -sticky=>'we', -padx=>20);
$rW_nonVisual = $rW013 -> Checkbutton ( -state=>'normal', -justify=>'left', -text=>'non-visual class', -relief=>'flat', -onvalue=>1 , -variable => \$nonVisual) -> grid(-row=>2, -pady=>5, -column=>0, -sticky=>'w');
$rW_geom = $rW013 -> Checkbutton ( -state=>'normal', -justify=>'left', -text=>'needs geometry manager', -relief=>'flat', -onvalue=>1 , -variable => \$geom) -> grid(-row=>1, -pady=>5, -column=>0, -sticky=>'w');
$rW_balloon = $rW013 -> Checkbutton ( -state=>'normal', -justify=>'left', -text=>'show widget code as balloon', -relief=>'flat', -variable => \$balloon ) -> grid(-row=>0, -pady=>5, -column=>0, -sticky=>'w');
$rW_classname = $rW017 -> LabEntry ( -background=>($className) ? '#E4E4E4':'#ffffff', -label=>'class name', -labelPack=>[-side,'left',-anchor,'n'], -state=>($className)? 'disabled':'normal', -justify=>'left', -relief=>'sunken', -textvariable=>\$className ) -> pack(-anchor=>'nw', -pady=>3, -fill=>'x', -side=>'top', -expand=>1);
$rW_defFile = $rW017 -> LabEntry ( -background=>'#ffffff', -label=>'definitions file name', -labelPack=>[-side,'left',-anchor,'n'], -state=>'normal', -justify=>'left', -relief=>'sunken', -textvariable=>\$defFileName ) -> pack(-anchor=>'nw', -pady=>3, -fill=>'x', -side=>'top', -expand=>1);
$rW_use = $rW017 -> LabEntry ( -background=>'#ffffff', -label=>'use name', -labelPack=>[-side,'left',-anchor,'n'], -state=>'normal', -justify=>'left', -relief=>'sunken', -textvariable=>\$useFileName ) -> pack(-anchor=>'nw', -pady=>3, -fill=>'x', -side=>'top', -expand=>1);
$rW_icon = $rW017 -> LabEntry ( -background=>'#ffffff', -label=>'icon name', -labelPack=>[-side,'left',-anchor,'n'], -state=>'normal', -justify=>'left', -relief=>'sunken', -textvariable=>\$iconName ) -> pack(-anchor=>'nw', -pady=>3, -fill=>'x', -side=>'top', -expand=>1);

$rW_geomOpt->Subwidget('label')->configure(-width => 20);
$rW_widgetOpt->Subwidget('label')->configure(-width => 20);
$rW_classname->Subwidget('label')->configure(-width => 20);
$rW_defFile->Subwidget('label')->configure(-width => 20);
$rW_use->Subwidget('label')->configure(-width => 20);
$rW_icon->Subwidget('label')->configure(-width => 20);

## ctk: end of gened Tk-code

$rv =  $db->Show();

return undef if($rv =~ /Cancel/i);

$useFileName = "Tk::$className" unless ($useFileName);
$defFileName = $className unless ($defFileName);
$iconName = "$className" unless ($iconName);
$geomManager ='' unless ($geom);

if ($self->validateUseName($useFileName,1)) {
	$rv = {
		'geom' => $geom,
		'nonVisual' => $nonVisual,
		'balloon' => $balloon,
		'use' => $useFileName,
		'file' => $defFileName,
		'classname' => $className,
		'defaultgeometrymanager' => $geomManager,
		'defaultgeometryoptions' => $geomOptions,
		'defaultwidgetoptions' => $widgetOptions,
		'icon' => $iconName,
		'attr' => $attr};
} else {
	$rv = undef
}
return $rv;

} ## end of dlg_widgetRegistrationsParam

=head2 validateUseName

	Method validateUseName validates the existence of the given widget class.

	It returns true if the widget class can be used or required
	false otherwise.

	Arguments

		- name to be used for use or require statement (mandatory)
		- ask user for decision on error (optional)

		  1 ask user to decide
		  0 don't ask the user (default)

	Notes

		- use names prefixed by 'Tk::' are used

		- other names are first suffixed with '.pm' and
		  then required.

=cut

sub validateUseName {
	my $self = shift;
	my ($useFileName,$askUser) = @_;
	my $rv;

	return $rv unless ($useFileName);

	if ($useFileName =~ /^Tk::/) {
		eval "use $useFileName;";
		if ($@) {
			$rv = &std::askYN("Could not use '$useFileName',\n\n$@,\n\nsave anyway?") if ($askUser);
		} else {
			$rv = 1
		}
	} else {
		my $w = $useFileName.'.pm' unless $useFileName =~ /\.pm$/;
		$w =~ s/::/\//g;
		eval "require \"$w\";";
		if ($@) {
			$rv = &std::askYN("Could not require '$useFileName',\n\n$@,\n\nsave anyway?") if ($askUser);
		} else {
			$rv = 1;
		}
	}
	return $rv
}

=head2 registerWidgetClassDefinition

	This method executes an registration process.

	First it sends dlg_widgetRegistrationsParam to
	accept options and than depending on the user's action
	saves the definition.

	It returns true if the definition has been save , false otherwise.

=cut

sub registerWidgetClassDefinition {
	my $self = shift;
	my $rv;
	$rv = $self->dlg_widgetRegistrationsParam(@_);
	if (defined($rv)) {
		my $wlib = $self->widgets;
		my $className = $rv->{'classname'};
		if (exists ($wlib->{$className})) {
			if (&std::askYN("Widget class '$className' already exists, do you want to overwrite?")) {
				$wlib->{$className} = $rv;
				$rv = $self->save($className);
			} else {
				$rv = undef;
			}
		} else {
			$wlib->{$className} = $rv;
			$rv = $self->save($className);
		}
	}
	$rv = (defined($rv)) ? 1 : 0;
	return $rv
}

=head2 editWidgetOptions

	This method edit the options of a widget definition.

=cut

sub editWidgetOptions {
	my $self = shift;
	my ($hwnd,$className,$useFileName,$attr) = @_;
	my $rv;
	$useFileName = $className unless($useFileName);
	##
	## get widget options for element attr: setup widget ;  $TkAnalysis->getOptions($widget)
	my $mw = MainWindow->new();
	## $useFileName .= '.pm' unless ($useFileName =~ /\.p[ml]$/);
	eval "use $useFileName";
	if ($@) {
		&std::ShowWarningDialog("Could not use '$useFileName' because of\n\n$@ .");
		return undef
	} else {}
	my $o = eval "\$mw->$className()";
	if ($@) {
		&std::ShowWarningDialog("Could not instantiate '$className' because of\n\n$@ .");
		$hwnd->Subwidget('B_OK')->configure(-state => 'disabled');
		return undef;
	} else {
		$hwnd->Subwidget('B_OK')->configure(-state => 'normal')
	}

	return undef unless (defined($o));
	my @opt = $o->configure();

	$mw->DESTROY();

	my @dropDown = sort (qw/int int+ text color float callback file text- text+ menu() variable relief widget justify anchor side photo/);
	unshift @dropDown, 'default';

	my %val = ();
	my %wOptions=();
	foreach my $o (@opt) {
		$val{$o->[0]} = (exists $attr->{$o->[0]}) ? $attr->{$o->[0]} : 'default';
		my @w = eval "(-textvariable , \\\$val{'$o->[0]'},-width ,14,-options ,[\@dropDown],-bg , 'white')";
		$wOptions{$o->[0]} = \@w;
	}
	foreach my $o (keys %$attr) {
		unless (exists $val{$o}) {
			$val{$o} = $attr->{$o};
			my @w = eval "(-textvariable , \\\$val{'$o'},-width ,14,-options ,[\@dropDown],-bg , 'white')";
			$wOptions{$o} = \@w;
		}
	}

	my $db=$hwnd->ctkDialogBox(-title=>"Widget options of $className",-buttons=>['Accept','Cancel']);
	
	my $db_lf = $db->LabFrame(-labelside=>'acrosstop',-label=>"Widget ".$className." options:")->pack();
	my $db_lft = $db_lf->Scrolled('Tiler', -columns => 1, -scrollbars=>'oe')->pack;
	map {
		my $f = $db_lft->Frame();
		$db_lft->Manage($f);
		$f->Label(-text,$_)->pack(-padx,3,-pady,3,-side,'left');
		$f->Optionmenu(@{$wOptions{$_}})->pack(-side,'right',-padx,3);
	} sort keys %wOptions;
	my $reply=$db->Show();

	return undef if($reply eq 'Cancel');
	map {delete $val{$_} if ($val{$_} =~ /default/)} keys %val;
	$rv = \%val;
	return $rv
}
=head2 editWidgetOptions

	This method edit the options of a widget definition.

=cut

sub editNonVisualClassOptions { 						
	my $self = shift;
	my ($hwnd,$className,$useFileName,$attr) = @_;
	my $rv;
	$useFileName = $className unless($useFileName);

	my @dropDown = sort (qw/int int+ text color float callback file text- text+ menu() variable relief widget justify anchor side/);
		unshift @dropDown, 'default';
	my @right_pack=(qw/-side right -padx 7/);
	my $db=$hwnd->ctkDialogBox(-title=>"Widget options of $className",-buttons=>['Accept','Cancel']);

	my $db_lf = $db->LabFrame(-labelside=>'acrosstop',-label=>"Widget ".$className." options:")->pack();
	my $db_lft = $db_lf->Scrolled('Tiler', -columns => 1, -scrollbars=>'oe')->pack;
	my %val = ();
	my @w;

	foreach my $o (keys %$attr) {
		my $f = $db_lft->Frame();
		$db_lft->Manage( $f );
		$val{$o} = $attr->{$o};
		@w = eval "(-text , '$o') " ; $f->Label(@w)->pack(-padx=>7,-pady=>10,-side=>'left');
		@w = eval "(-variable , \\\$val{'$o'},-width ,14,-choices , \\\@dropDown)";
		$f->BrowseEntry(@w)->pack(@right_pack);
	}
	my $reply=$db->Show();

	return undef if($reply eq 'Cancel');
	map {delete $val{$_} if ($val{$_} =~ /default/)} keys %val;
	$rv = \%val;
	return $rv
}

=head2 deleteWidgetClass

	This method deletes a widget class definition from the
	registration's library.
	The definition is deleted from the library actually in memory
	and the persistent instance is simply turned to a backup copy.

	This method always returns true.

	Note: this message can be issued only while a ctk_w session!

=cut

sub deleteWidgetClass {			
	my $self = shift;
	my ($widgetClass) = @_;
	my $rv;
	my $w_attr = $self->widgets;
	delete $w_attr->{$widgetClass};
	$rv = $self->_backup($widgetClass); 
	return $rv
}

1; ## -----------------------------------
