Sent in months ago as well. Missing in action since that idiot locked the source code in the middle of the GUI updates. Laziness or stupidity or an insidious combination of both?
In bin/mh:
print "Creating Modules Menu\n";
$Tk_objects{menu_modules} = $Tk_objects{menu_bar}->Menubutton(-text => 'Modules', -borderwidth => 2, -underline => 0)->pack(-side => 'left', -padx => 0) unless $Tk_objects{menu_modules};
$Tk_objects{menu_modules}->menu->delete(0, 'end'); # Delete old menus
&configure_element('window', \$Tk_objects{menu_modules});
&configure_element('window', \$Tk_objects{menu_modules}->menu); # this one
$Tk_objects{menu_help} = $Tk_objects{menu_bar}->
Menubutton(-text => 'Help',
-borderwidth => 2, -underline => 0)->pack(-side => 'left', -padx => 0);
&configure_element('window', \$Tk_objects{menu_help});
&configure_element('window', \$Tk_objects{menu_help}->menu); # and this one
&configure_element('window', \$Tk_objects{menu_file});
&configure_element('window', \$Tk_objects{menu_file}->menu); # and this one
&configure_element('window', \$Tk_objects{menu_view});
&configure_element('window', \$Tk_objects{menu_view}->menu); # and this one
&configure_element('window', \$Tk_objects{menu_tools});
&configure_element('window', \$Tk_objects{menu_tools}->menu); # etc.
&configure_element('window', \$Tk_objects{menu_items}) if $Tk_objects{menu_items}; # both of these
&configure_element('window', \$Tk_objects{menu_items}->menu) if $Tk_objects{menu_items};
And as far as this goes:
elsif ($type ne 'toolbar' and $type ne 'progress') {
# Get this error: Can't set -font to `Times 10 bold' for Tk::Frame=HASH(0x73b0928): unknown option "-font" at C:/Perl/site/lib/Tk/Configure.pm line 46.
# $$p_element->configure(-font => $font) if $font;
}
I never had this font problem, but try this in the test version:
elsif ($type ne 'toolbar' and $type ne 'progress' and $type ne 'button') {
print '*** Class: $type \n';
print '*** REF of ELEMENT: $widget_type \n';
$$p_element->configure(-font => $font) if $font and $widget_type !~ /frame/i;
}
I know this sub is still botched in SVN:
sub tk_radiobutton {
return unless $Reload;
# print "db5 Debug doing the radiobutton thing, l=@_, r=$Reload\n";
# Allow web widgets, even with -no_tk
push(@Tk_widgets, [$Category, 'radiobutton', @_]);
return unless $MW and $Tk_objects{grid};
my ($label, $pvar, $pvalue, $ptext, $callback, $widget) = @_;
$Tk_objects{radiobutton}{$pvar}->destroy if $Tk_objects{radiobutton}{$pvar} and Exists($Tk_objects{radiobutton}{$pvar});
my @widgets;
my @text = @$ptext if $ptext; # Copy, so we can do shift and still have the origial $ptext array available for html widget
for my $value (@$pvalue) {
my $text = shift @text;
$text = $value unless defined $text;
# Check to see if $pvar is an object with the set method
# - use set if we can, so state_now works on tk changes
if (ref $pvar ne 'SCALAR' and $pvar->can('set')) {
$widget = $Tk_objects{grid}->Radiobutton(-text => $text, -variable => \$$pvar{state}, -value => $value,
-command => sub { $Tk_results{$label} = $$pvar{state}; $pvar->set($$pvar{state}, 'tk') });
}
else {
$widget = $Tk_objects{grid}->Radiobutton(-text => $text, -variable => $pvar, -value => $value);
}
push(@widgets, $widget);
&configure_element('edit', \$widget);
}
$Tk_objects{radiobutton}{$pvar} = $Tk_objects{grid}->Label(-text => $label);
&configure_element('frame', \$Tk_objects{radiobutton}{$pvar});
$Tk_objects{radiobutton}{$pvar}->grid(@widgets[0], -sticky => 'w');
for (1..$#widgets) {
@widgets[$_ - 1]->grid(@widgets[$_], -sticky => 's');
}
}
This one is new:
sub tk_browse_entry {
return unless $Reload;
# Allow web widgets, even with -no_tk
push(@Tk_widgets, [$Category, 'entry', @_]);
return unless $MW and $Tk_objects{grid};
my @data = @_;
my @widgets;
for (@data) {
my $label = shift @data;
my $pvar = shift @data;
$Tk_objects{entry}{$label}->destroy if $Tk_objects{entry}{$label} and Exists($Tk_objects{entry}{$label});
$Tk_objects{entry}{$pvar} ->destroy if $Tk_objects{entry}{$pvar} and Exists($Tk_objects{entry}{$pvar});
$Tk_objects{entry}{$label} = $Tk_objects{grid}->Label(-text => $label, -anchor => 'w');
&configure_element('label', \$Tk_objects{entry}{$label});
if (ref $pvar ne 'SCALAR' and $pvar->can('set')) {
$Tk_objects{entry}{$pvar} = $Tk_objects{grid}->BrowseEntry(-textvariable => \$$pvar{state}, -width => 12, -command => sub {$pvar->set($$pvar{state}, 'tk')});
$Tk_objects{entry}{$pvar}->bind('<Return>', sub { $Tk_results{$label} = $$pvar{state}; $pvar->set($$pvar{state}, 'tk') } ) ;
}
else {
$Tk_objects{entry}{$pvar} = $Tk_objects{grid}->BrowseEntry(-textvariable => $pvar, -width => 12);
$Tk_objects{entry}{$pvar}->bind('<Return>', sub { $Tk_results{$label} = $$pvar } );
}
my $entry = $Tk_objects{entry}{$pvar}->Subwidget('entry');
&configure_element('edit', \$entry);
push(@widgets, $Tk_objects{entry}{$label});
push(@widgets, $Tk_objects{entry}{$pvar});
}
# if (@widgets > 2) {
$widgets[0]->grid(@widgets[1..$#widgets], -sticky => 'w');
# }
# else {
# $widgets[0]->grid(@widgets[1..$#widgets], -columnspan => 2, -sticky => 'w');
# }
return $widgets[1];
}
There is an image widget as well that displays in the status bar with a tooltip. I didn't do its Web counterpart, but that is a no-brainer. I'll post that one as soon as the rest of this stuff is fixed.
As you may have read a few months back, there is also a skin API that allows for floating interface elements and many other possibilities. All elements can be hidden/shown from the View menu and window settings are persisted. It is really a slick app at this point. Too bad I am the only one who has run it. Get these updates in and I will post the updated Display.pm, display sub and tk_widgets with skin support. Or keep the half-finished BS that is up there now. Nobody will ever do anything with it as they don't have a clue about it (every line of this new tk code is mine.)
