# Implements the "TK" standard file selection dialog box. This
# dialog box is used on the Unix platforms whenever the tk_strictMotif
# The "TK" standard file selection dialog box is similar to the
# file selection dialog box on Win95(TM). The user can navigate
# the directories by clicking on the folder icons or by
# selectinf the "Directory" option menu. The user can select
# files by clicking on the file icons or by entering a filename
# in the "Filename:" entry.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# Translated to perk/Tk by Slaven Rezic <eserte@cs.tu-berlin.de>.
#----------------------------------------------------------------------
# This is a pseudo-widget that implements the icon list inside the
#----------------------------------------------------------------------
# Creates an IconList widget.
$VERSION = '3.005'; # $Id: //depot/Tk8/Tk/IconList.pm#5 $
Construct Tk::Widget 'IconList';
# Creates an IconList widget by assembling a canvas widget and a
# scrollbar widget. Sets all the bindings necessary for the IconList's
$w->SUPER::Populate($args);
my $sbar = $w->Component('Scrollbar' => 'sbar',
-highlightthickness => 0,
my $canvas = $w->Component('Canvas' => 'canvas',
$sbar->pack(-side => 'bottom', -fill => 'x', -padx => 2);
$canvas->pack(-expand => 'yes', -fill => 'both');
$sbar->configure(-command => ['xview', $canvas]);
$canvas->configure(-xscrollcommand => ['set', $sbar]);
# Initializes the max icon/text width and height and other variables
# Creates the event bindings.
$canvas->Tk::bind('<Configure>', sub { $w->Arrange } );
$w->Btn1($Ev->x, $Ev->y);
$canvas->Tk::bind('<B1-Motion>',
$w->Motion1($Ev->x, $Ev->y);
$canvas->Tk::bind('<Double-ButtonRelease-1>',
$w->Double1($Ev->x,$Ev->y);
$canvas->Tk::bind('<ButtonRelease-1>', sub { $w->CancelRepeat });
$canvas->Tk::bind('<B1-Leave>',
$w->Leave1($Ev->x, $Ev->y);
$canvas->Tk::bind('<B1-Enter>', sub { $w->CancelRepeat });
$canvas->Tk::bind('<Up>', sub { $w->UpDown(-1) });
$canvas->Tk::bind('<Down>', sub { $w->UpDown(1) });
$canvas->Tk::bind('<Left>', sub { $w->LeftRight(-1) });
$canvas->Tk::bind('<Right>', sub { $w->LeftRight(1) });
$canvas->Tk::bind('<Return>', sub { $w->ReturnKey });
$canvas->Tk::bind('<KeyPress>',
$canvas->Tk::bind('<Control-KeyPress>', 'NoOp');
$canvas->Tk::bind('<Alt-KeyPress>', 'NoOp');
$canvas->Tk::bind('<FocusIn>', sub { $w->FocusIn });
$w->ConfigSpecs(-browsecmd =>
['CALLBACK', 'browseCommand', 'BrowseCommand', undef],
['CALLBACK', 'command', 'Command', undef],
['PASSIVE', 'font', 'Font', undef],
['PASSIVE', 'foreground', 'Foreground', undef],
# This procedure is invoked when the mouse leaves an entry window
# with button 1 down. It scrolls the window up, down, left, or
# right, depending on where the mouse left the window, and reschedules
# itself as an "after" command so that the window continues to scroll until
# the mouse moves back into the window or the mouse button is released.
# w - The IconList window.
return unless ($w->exists);
return if ($w->{'noScroll'});
my $canvas = $w->Subwidget('canvas');
if ($x >= $canvas->width) {
$canvas->xview('scroll', 1, 'units');
$canvas->xview('scroll', -1, 'units');
} elsif ($y >= $canvas->height) {
$w->RepeatId($w->after(50, ['AutoScan', $w]));
# Deletes all the items inside the canvas subwidget and reset the IconList's
my $canvas = $w->Subwidget('canvas');
$w->Subwidget('sbar')->set(0.0, 1.0);
$canvas->xview('moveto', 0);
# Adds an icon into the IconList with the designated image and text
my($w, $image, $text) = @_;
my $canvas = $w->Subwidget('canvas');
my $iTag = $canvas->createImage(0, 0, -image => $image, -anchor => 'nw');
my $font = $w->cget(-font);
my $fg = $w->cget(-foreground);
my $tTag = $canvas->createText(0, 0, -text => $text, -anchor => 'nw',
(defined $fg ? (-fill => $fg) : ()),
(defined $font ? (-font => $font) : ()),
my $rTag = $canvas->createRectangle(0, 0, 0, 0,
my(@b) = $canvas->bbox($iTag);
$w->{'maxIW'} = $iW if ($w->{'maxIW'} < $iW);
$w->{'maxIH'} = $iH if ($w->{'maxIH'} < $iH);
@b = $canvas->bbox($tTag);
$w->{'maxTW'} = $tW if ($w->{'maxTW'} < $tW);
$w->{'maxTH'} = $tH if ($w->{'maxTH'} < $tH);
push @{ $w->{'list'} }, [$iTag, $tTag, $rTag, $iW, $iH, $tW, $tH,
$w->{'itemList'}{$rTag} = [$iTag, $tTag, $text, $w->{'numItems'}];
$w->{'textList'}{$w->{'numItems'}} = lc($text);
# Places the icons in a column-major arrangement.
my $canvas = $w->Subwidget('canvas');
my $sbar = $w->Subwidget('sbar');
unless (exists $w->{'list'}) {
if (defined $canvas && Tk::Exists($canvas)) {
$sbar->configure(-command => sub { });
my $pad = $canvas->cget(-highlightthickness) + $canvas->cget(-bd);
my $dx = $w->{'maxIW'} + $w->{'maxTW'} + 8;
if ($w->{'maxTH'} > $w->{'maxIH'}) {
my $shift = $w->{'maxIW'} + 4;
foreach my $sublist (@{ $w->{'list'} }) {
my($iTag, $tTag, $rTag, $iW, $iH, $tW, $tH) = @$sublist;
my $i_dy = ($dy - $iH) / 2;
my $t_dy = ($dy - $tH) / 2;
$canvas->coords($iTag, $x, $y + $i_dy);
$canvas->coords($tTag, $x + $shift, $y + $t_dy);
$canvas->coords($tTag, $x + $shift, $y + $t_dy);
$canvas->coords($rTag, $x, $y, $x + $dx, $y + $dy);
$canvas->configure(-scrollregion => [$pad, $pad, $sW, $H]);
$sbar->configure(-command => sub { });
$canvas->xview(moveto => 0);
$canvas->configure(-scrollregion => [$pad, $pad, $sW, $H]);
$sbar->configure(-command => ['xview', $canvas]);
$w->{'itemsPerColumn'} = ($H - $pad) / $dy;
$w->{'itemsPerColumn'} = 1 if ($w->{'itemsPerColumn'} < 1);
$w->Select($w->{'list'}[$w->{'curItem'}][2], 0)
if (exists $w->{'curItem'});
# Gets called when the user invokes the IconList (usually by double-clicking
# or pressing the Return key).
$w->Callback(-command => $w->{'selected'}) if (exists $w->{'selected'});
# If the item is not (completely) visible, scroll the canvas so that
return if ($w->{'noScroll'});
return unless (exists $w->{'itemList'}{$rTag});
my $canvas = $w->Subwidget('canvas');
my(@sRegion) = @{ $canvas->cget('-scrollregion') };
return unless (@sRegion);
my(@bbox) = $canvas->bbox($rTag);
my $pad = $canvas->cget(-highlightthickness) + $canvas->cget(-bd);
my $cW = $canvas->width - $pad * 2;
my $scrollW = $sRegion[2] - $sRegion[0] + 1;
my $dispX = int(($canvas->xview)[0] * $scrollW);
# check if out of the right edge
$dispX = $x2 - $cW if ($x2 - $dispX >= $cW);
# check if out of the left edge
$dispX = $x1 if ($x1 - $dispX < 0);
if ($oldDispX != $dispX) {
my $fraction = $dispX / $scrollW;
$canvas->xview('moveto', $fraction);
my $canvas = $w->Subwidget('canvas');
$w->Select($canvas->find('closest',
my $callBrowse = (@_ ? shift : 1);
return unless (exists $w->{'itemList'}{$rTag});
my($iTag, $tTag, $text, $serial) = @{ $w->{'itemList'}{$rTag} };
my $canvas = $w->Subwidget('canvas');
$w->{'rect'} = $canvas->createRectangle(0, 0, 0, 0, -fill => '#a0a0ff',
unless (exists $w->{'rect'});
$canvas->lower($w->{'rect'});
my(@bbox) = $canvas->bbox($tTag);
$canvas->coords($w->{'rect'}, @bbox);
$w->{'curItem'} = $serial;
$w->{'selected'} = $text;
$w->Callback(-browsecmd => $text);
my $canvas = $w->Subwidget('canvas');
if (exists $w->{'rect'}) {
$canvas->delete($w->{'rect'});
delete $w->{'selected'} if (exists $w->{'selected'});
# Returns the selected item
if (exists $w->{'selected'}) {
$w->Subwidget('canvas')->focus;
# Gets called on button-1 motions
$w->Invoke if (exists $w->{'curItem'});
return unless (exists $w->{'list'});
unless (exists $w->{'curItem'}) {
my $rTag = $w->{'list'}[0][2];
# Moves the active element up or down by one element
# w - The IconList widget.
# amount - +1 to move down one item, -1 to move back one item.
return unless (exists $w->{'list'});
unless (exists $w->{'curItem'}) {
$rTag = $w->{'list'}[0][2];
my $oldRTag = $w->{'list'}[$w->{'curItem'}][2];
$rTag = $w->{'list'}[($w->{'curItem'} + $amount)][2];
$rTag = $oldRTag unless defined $rTag;
# tkIconList_LeftRight --
# Moves the active element left or right by one column
# w - The IconList widget.
# amount - +1 to move right one column, -1 to move left one column.
return unless (exists $w->{'list'});
unless (exists $w->{'curItem'}) {
$rTag = $w->{'list'}[0][2];
my $oldRTag = $w->{'list'}[$w->{'curItem'}][2];
my $newItem = $w->{'curItem'} + $amount * $w->{'itemsPerColumn'};
$rTag = $w->{'list'}[$newItem][2];
$rTag = $oldRTag unless (defined $rTag);
#----------------------------------------------------------------------
# Accelerator key bindings
#----------------------------------------------------------------------
# Gets called when user enters an arbitrary key in the listbox.
$w->{'_ILAccel'} .= $key;
$w->Goto($w->{'_ILAccel'});
$w->afterCancel($w->{'_ILAccel_afterid'});
$w->{'_ILAccel_afterid'} = $w->after(500, ['Reset', $w]);
return unless (exists $w->{'list'});
return if (not defined $text or $text eq '');
my $start = (!exists $w->{'curItem'} ? 0 : $w->{'curItem'});
# Search forward until we find a filename whose prefix is an exact match
my $sub = substr($w->{'textList'}{$i}, 0, $len);
$i = 0 if ($i == $w->{'numItems'});
my $rTag = $w->{'list'}[$theIndex][2];