Perl/Tk FBox.pm filled with hidden items (some 50 items in front of the other ones)
Home --- Description --- Create --- Install
This change affects the getOpenFile and getSaveFile methods of the Perl/Tk toolkit on Linux, which are used to pop up a dialog box to select a file to open or save, respectively the underlying FBox.pm module.
The enhanced FBox.pm module provides the following 'new' features: The enhanced FBox.pm module provides a new property named showhidden that enables or disables the listing of hidden items by setting it's value to 'on' or 'off':
$File = $w->getOpenFile(-title => "Sample Window", -showhidden => 'off');
If the showhidden property is omitted, the FBox.pm works in the usual way, which means, that you can still use all your programs as they are, after you installed the enhanced FBox.pm module.
The enhanced FBox.pm module provides a new property named msgfont that you can use to set the font for feedbacks, just like this:
$File = $w->getSaveFile(-title => "Sample Window", -msgfont => '{My FontName} 10 bold');
If the msgfont property is omitted, feedback works with no font specified (i.e. the message shows up with 'some' font), which means, that you can still use all your programs as they are, after you installed the enhanced FBox.pm module.
With the enhanced version these selections now appear in the file name entry. Thus they can be utilised for example, when it is used for a Save As dialog. With a click on a file name that is similar to the desired name the file name entry will be provided with an editable template.
Important:
To use the file name entry value, you have to hit the <ENTER> key, do not click a mouse button respectively don't click the Button on the right side which replaces the (edited) entry with the original List Box Selection.
$w->ConfigSpecs(-defaultextension => ['PASSIVE', undef, undef, undef],
-filetypes => ['PASSIVE', undef, undef, undef],
-initialdir => ['PASSIVE', undef, undef, undef],
-initialfile => ['PASSIVE', undef, undef, undef],
# -sortcmd => ['PASSIVE', undef, undef, sub { lc($a) cmp lc($b) }],
-sortcmd => ['PASSIVE', undef, undef, sub { lc($_[0]) cmp lc($_[1]) }],
-title => ['PASSIVE', undef, undef, undef],
-type => ['PASSIVE', undef, undef, 'open'],
-filter => ['PASSIVE', undef, undef, '*'],
-force => ['PASSIVE', undef, undef, 0],
-multiple => ['PASSIVE', undef, undef, 0],
-msgfont => ['PASSIVE', undef, undef, 0],
-showhidden => ['PASSIVE', undef, undef, 0],
'DEFAULT' => [$icons],
);
my $reply = $w->messageBox
(-icon => 'warning',
-font => $msgfont,
-type => 'YesNo',
-message => "File \"$selectFilePath\" already exists.\nDo you want to overwrite it?");
return unless (lc($reply) eq 'yes');
sub Done {
my $w = shift;
my $msgfont = $w->cget(-msgfont);
.
.
.
# Make the dir & file list within the sub Update and there first create a local variable for the showhidden property and then add the evaluation code as shown in the following code snippet: # Make the dir & file list
my $cwd = _cwd();
my $showhidden = $w->cget(-showhidden);
local *FDIR;
if (opendir(FDIR, $cwd)) {
my @files;
my $sortcmd = sub { $w->cget(-sortcmd)->($a,$b) };
my $flt = $w->cget(-filter);
my $fltcb;
if (ref $flt eq 'CODE') {
$fltcb = $flt;
} else {
$flt = _rx_to_glob($flt);
}
my $type_dir = $w->cget(-type) eq 'dir';
foreach my $f (sort $sortcmd readdir(FDIR)) {
next if $f eq '.' or $f eq '..';
#
# Evaluate showhidden property:
if ($showhidden eq 'off'){
next if substr($f, 0, 1) eq '.';
}
.
.
.
$w->OnDestroy(['CancelCmd', $w]); $w->protocol('WM_DELETE_WINDOW', ['CancelCmd', $w]);
$w->OnDestroy(['CancelCmd', $w]);
$w -> bind('<Button-1>', [sub{\&FBSetFileNam($w)}]);
# Build the focus group for all the entries
$w->FG_Create;
$w->FG_BindIn($ent, ['EntFocusIn', $w]);
.
.
.
sub UpDirCmd { # Gets called when user presses the "parent directory" button
#
sub UpDirCmd {
my $w = shift;
my $ent = $w->{'ent'};
$w->SetPath(File::Basename::dirname($w->_get_select_path))
unless ($w->_get_select_path eq '/');
$ent->delete(0, 'end');
}
sub _encode_filename { sub _encode_filename {
my($w, $filename) = @_;
$filename = $w->{encoding}->encode($filename);
$filename;
}
sub FBSetFileNam {
my $w = shift;
my $ent = $w->{'ent'};
$ent->delete(0, 'end');
my @indexes = $w->{'icons'}->Curselection;
my $text = $w->_get_from_icons(@indexes[0]);
#
# We don't want to see directory names in this entry...
my $file = JoinFile($w->_get_select_path, $text);
my $IsDir = -d $file;
$ent->configure(-text => $text) if !$IsDir;
}
1;
WARNING:
While this file replacement may work in a similar way on other platforms too, you could encounter trouble with the implementation. While the code for the msgfont property will run as is, the one for the showhidden property is os-dependent (For Windows the use of an additional module is needed). Moreover on Windows 2000 and ActiveState Perl v5.8.8, Perl/Tk version 804.027 for example, you can run a program with a changed FBox.pm module as long, as you use legacy calls with getOpenFile resp. getSaveFile. If you incorporate the new properties in the method call you'll end up with a 'bad option' error. There seems to be a controlling mechanism concerning the options which I didn't yet understand, maybe the option database is the right suspect... Unfortunately this is a rather tricky thing, and since I am not using Windows...
Home --- Description --- Create --- Install
AjvG is programmer of
vGShop the managed Online Shop System