line
stmt
bran
cond
sub
pod
time
code
1
##################################################
2
##################################################
3
## ##
4
## JFileDialog v. 1.34 - a reusable Tk-widget ##
5
## (c) 1996-2007 by Jim Turner ##
6
## --Derived 12/11/96 by Jim W. Turner-- ##
7
## --from FileDialog ##
8
## ##
9
## by: Brent B. Powers ##
10
## Merrill Lynch ##
11
## powers@swaps-comm.ml.com ##
12
## ##
13
##################################################
14
##################################################
15
16
=head1 NAME
17
18
Tk::JFileDialog - A highly configurable File Dialog widget for Perl/Tk.
19
20
=head1 DESCRIPTION
21
22
The widget is composed of a number
23
of sub-widgets, namely, a listbox for files and (optionally) directories, an entry
24
for filename, an (optional) entry for pathname, an entry for a filter pattern, a 'ShowAll'
25
checkbox (for enabling display of .* files and directories), and three buttons, namely
26
OK, Rescan, and Cancel. Note that the labels for all subwidgets (including the text
27
for the buttons and Checkbox) are configurable for foreign language support.
28
29
=head1 SYNOPSIS
30
31
my $LoadDialog = $main->JFileDialog(
32
-Title =>'Please select a file:',
33
-Create => 0
34
);
35
36
=head2 Usage Description
37
38
To use FileDialog, simply create your FileDialog objects during initialization (or at
39
least before a Show). When you wish to display the FileDialog, invoke the 'Show' method
40
on the FileDialog object; The method will return either a file name, a path name, or
41
undef. undef is returned only if the user pressed the Cancel button.
42
43
=head2 Example Code
44
45
The following code creates a FileDialog and calls it. Note that perl5.002gamma is
46
required.
47
48
=item
49
50
#!/usr/local/bin/perl -w
51
52
use Tk;
53
use Tk::JFileDialog;
54
use strict;
55
56
my($main) = MainWindow->new;
57
my($Horiz) = 1;
58
my($fname);
59
60
my($LoadDialog) = $main->JFileDialog(-Title =>'This is my title',
61
-Create => 0);
62
63
$LoadDialog->configure(-FPat => '*pl',
64
-ShowAll => 'NO');
65
66
$main->Entry(-textvariable => \$fname)
67
->pack(-expand => 1,
68
-fill => 'x');
69
70
$main->Button(-text => 'Kick me!',
71
-command => sub {
72
$fname = $LoadDialog->Show(-Horiz => $Horiz);
73
if (!defined($fname)) {
74
$fname = "Fine,Cancel, but no Chdir anymore!!!";
75
$LoadDialog->configure(-Chdir =>'NO');
76
}
77
})
78
->pack(-expand => 1,
79
-fill => 'x');
80
81
$main->Checkbutton(-text => 'Horizontal',
82
-variable => \$Horiz)
83
->pack(-expand => 1,
84
-fill => 'x');
85
86
$main->Button(-text => 'Exit',
87
-command => sub {
88
$main->destroy;
89
})
90
->pack(-expand => 1,
91
-fill => 'x');
92
93
MainLoop;
94
95
print "Exit Stage right!\n";
96
97
exit;
98
99
=head1 METHODS
100
101
The following non-standard method may be used with a FileDialog object
102
103
=head2 Show
104
105
=over 4
106
107
Displays the file dialog box for the user to operate. Additional configuration
108
items may be passed in at Show-time In other words, this code snippet:
109
110
$fd->Show(-Title => 'Ooooh, Preeeeeety!');
111
112
is the same as this code snippet:
113
114
$fd->configure(-Title => 'Ooooh, Preeeeeety!');
115
$fd->Show;
116
117
=head1 CONFIGURATION
118
119
Any of the following configuration items may be set via the configure (or Show) method,
120
or retrieved via the cget method.
121
122
=head2 I
123
124
Flags may be configured with either 1,'true', or 'yes' for 1, or 0, 'false', or 'no'
125
for 0. Any portion of 'true', 'yes', 'false', or 'no' may be used, and case does not
126
matter.
127
128
=head2 -Chdir
129
130
Enable the user to change directories. The default is 1. If disabled, the directory
131
list box will not be shown.
132
133
=head2 -Create
134
135
Enable the user to specify a file that does not exist. If not enabled, and the user
136
specifies a non-existent file, a dialog box will be shown informing the user of the
137
error (This Dialog Box is configurable via the EDlg* switches, below).
138
139
default: 1
140
141
=head2 -ShowAll
142
143
Determines whether hidden files (.*) are displayed in the File and Directory Listboxes.
144
The default is 0. The Show All Checkbox reflects the setting of this switch.
145
146
=head2 -DisableShowAll
147
148
Disables the ability of the user to change the status of the ShowAll flag. The default
149
is 0 (the user is by default allowed to change the status).
150
151
=head2 -DisableFPat
152
153
Disables the ability of the user to change the file selection pattern. The default
154
is 0 (the user is by default allowed to change the status).
155
156
=head2 -Grab
157
158
Enables the File Dialog to do an application Grab when displayed. The default is 1.
159
160
=head2 -History
161
162
Used with the "-HistFile" option. Specifies how many files to retain in the
163
history list. The default is 0 (keep all).
164
165
=head2 -HistDeleteOk
166
167
If set, allows user to delete items from the history dropdown list and thus the
168
history file.
169
170
=head2 -HistUsePath
171
172
If set, the path is set to that of the last file selected from the history.
173
174
=head2 -HistUsePathButton
175
176
If set, the path is set to that of the last file selected from the history.
177
178
=head2 -HistFile
179
180
Enables the keeping of a history of the previous files / directories selected.
181
The file specified must be writable. If specified, a history of up to
182
"-History" number of files will be kept and will be displayed in a "JBrowseEntry"
183
combo-box permitting user selection.
184
185
=head2 -PathFile
186
187
Specifies a file containing a list of "favorite paths" bookmarks to show in a
188
dropdown list allowing quick-changes in directories.
189
190
=head2 -Horiz
191
192
True sets the File List box to be to the right of the Directory List Box. If 0, the
193
File List box will be below the Directory List box. The default is 1.
194
195
=head2 -QuickSelect
196
197
Default 1, if set to 0, user must invoke the "OK" button to complete selection.
198
If 1 or 2, clicking item in the history menu automatically completes the
199
selection. If 2, single-clicking a file in the file list completes selection
200
(otherwise, a double-click is required).
201
202
=head2 -SelDir
203
204
If 1 or 2, enables selection of a directory rather than a file, and disables the
205
actions of the File List Box. Setting to 2 allows selection of either a file OR a directory. The default is 0.
206
207
=head2 I
208
209
=head2 -FPat
210
211
Sets the default file selection pattern. The default is '*'. Only files matching
212
this pattern will be displayed in the File List Box.
213
214
=head2 -Geometry
215
216
Sets the geometry of the File Dialog. Setting the size is a dangerous thing to do.
217
If not configured, or set to '', the File Dialog will be centered.
218
219
=head2 -SelHook
220
221
SelHook is configured with a reference to a routine that will be called when a file
222
is chosen. The file is called with a sole parameter of the full path and file name
223
of the file chosen. If the Create flag is disabled (and the user is not allowed
224
to specify new files), the file will be known to exist at the time that SelHook is
225
called. Note that SelHook will also be called with directories if the SelDir Flag
226
is enabled, and that the FileDialog box will still be displayed. The FileDialog box
227
should B be destroyed from within the SelHook routine, although it may generally
228
be configured.
229
230
SelHook routines return 0 to reject the selection and allow the user to reselect, and
231
any other value to accept the selection. If a SelHook routine returns non-zero, the
232
FileDialog will immediately be withdrawn, and the file will be returned to the caller.
233
234
There may be only one SelHook routine active at any time. Configuring the SelHook
235
routine replaces any existing SelHook routine. Configuring the SelHook routine with
236
0 removes the SelHook routine. The default SelHook routine is undef.
237
238
=head2 I
239
240
The following two switches may be used to set default variables, and to get final
241
values after the Show method has returned (but has not been explicitly destroyed
242
by the caller)
243
244
=head2 -SelectMode
245
246
Sets the selectmode of the File Dialog. If not configured it will be defaulted
247
to 'single'. If set to 'multiple', then the user may select more than one file
248
and a comma-delimited list of all selected files is returned. Otherwise, only
249
a single file may be selected.
250
251
B<-File> The file selected, or the default file. The default is ''.
252
253
B<-Path> The path of the selected file, or the initial path. The default is $ENV{'HOME'}.
254
255
=head2 I
256
257
For support of internationalization, the text on any of the subwidgets may be
258
changed.
259
260
B<-Title> The Title of the dialog box. The default is 'Select File:'.
261
262
B<-DirLBCaption> The Caption above the Directory List Box. The default is 'Directories'.
263
264
B<-FileLBCaption> The Caption above the File List Box. The default is 'Files'.
265
266
B<-FileEntryLabel> The label to the left of the File Entry. The Default is 'Filename:'.
267
268
B<-PathEntryLabel> The label to the left of the Path Entry. The default is 'Pathname:'.
269
270
B<-FltEntryLabel> The label to the left of the Filter entry. The default is 'Filter:'.
271
272
B<-ShowAllLabel> The text of the Show All Checkbutton. The default is 'Show All'.
273
274
=head2 I
275
276
For support of internationalization, the text on the three buttons may be changed.
277
278
B<-OKButtonLabel> The text for the OK button. The default is 'OK'.
279
280
B<-RescanButtonLabel> The text for the Rescan button. The default is 'Refresh'.
281
282
B<-CancelButtonLabel> The text for the Cancel button. The default is 'Cancel'.
283
284
B<-HomeButtonLabel> The text for the Home directory button. The default is 'Home'.
285
286
B<-CWDButtonLabel> The text for the Current Working Directory button.
287
The default is 'C~WD'.
288
289
B<-SortButton> Whether or not to display a checkbox to change file box list sort order (default=1 show).
290
291
B<-SortButtonLabel> The text for the Sort/Atime button. The default is 'Atime'.
292
293
B<-SortOrder> Order to display files in the file list box ('Name' or 'Date' default=Name).
294
If 'Date', then the day and time is displayed in the box before the name,
295
(but not included when selected)
296
297
=head2 I
298
299
If the Create switch is set to 0, and the user specifies a file that does not exist,
300
a dialog box will be displayed informing the user of the error. These switches allow
301
some configuration of that dialog box.
302
303
=head2 -EDlgTitle
304
305
The title of the Error Dialog Box. The default is 'File does not exist!'.
306
307
=head2 -EDlgText
308
309
The message of the Error Dialog Box. The variables $path, $file, and $filename
310
(the full path and filename of the selected file) are available. The default
311
is I<"You must specify an existing file.\n(\$filename not found)">
312
313
=head1 Author
314
315
B
316
317
turnerjw at mesh . net
318
319
A derived work from Tk::FileDialog, by:
320
321
B
322
323
powers@ml.com
324
325
This code may be distributed under the same conditions as Perl itself.
326
327
=cut
328
329
package Tk::JFileDialog;
330
331
1
1
1447
use vars qw($VERSION);
1
2
1
57
332
$VERSION = '1.62';
333
334
require 5.002;
335
1
1
895
use Tk;
0
0
336
use Tk::Dialog;
337
use Tk::JBrowseEntry;
338
use Carp;
339
use strict;
340
use Cwd;
341
use File::Glob;
342
my $useAutoScroll = 0;
343
eval 'use Tk::Autoscroll; $useAutoScroll = 1; 1';
344
345
my $Win32 = 0;
346
$Win32 = ($^O =~ /Win/i) ? 1 : 0;
347
348
my $driveletter = '';
349
350
@Tk::JFileDialog::ISA = qw(Tk::Toplevel);
351
352
Tk::Widget->Construct('JFileDialog');
353
354
### Global Variables (Convenience only)
355
my(@topPack) = (-side => 'top', -anchor => 'center');
356
my(@rightPack) = (-side => 'right', -anchor => 'center');
357
my(@leftPack) = (-side => 'left', -anchor => 'center');
358
my(@xfill) = (-fill => 'x');
359
my(@yfill) = (-fill => 'y');
360
my(@bothFill) = (-fill => 'both');
361
my(@expand) = (-expand => 1);
362
my(@raised) = (-relief => 'raised');
363
my(@sunken) = (-relief => 'sunken');
364
my (@driveletters);
365
my ($cwdDfltDrive);
366
367
368
sub Populate
369
{
370
## File Dialog constructor, inherits new from Toplevel
371
my($FDialog, @args) = @_;
372
373
$FDialog->SUPER::Populate(@args);
374
$FDialog->{Configure}{-SortButton} = 1; #DEFAULT UNLESS SET BY USER TO ZERO!
375
foreach my $i (keys %{$args[0]})
376
{
377
#x if ($i eq '-HistFile' || $i eq '-History' || $i eq 'QuickSelect'
378
#x || $i eq '-PathFile' || $i eq '-HistDeleteOk'
379
#x || $i eq '-HistUsePath' || $i eq '-HistUsePathButton')
380
if ($i =~ /^\-(?:HistFile|History|QuickSelect|PathFile|HistDeleteOk|HistUsePath|HistUsePathButton|SortButton|SelDir)$/)
381
{
382
$FDialog->{Configure}{$i} = $args[0]->{$i};
383
}
384
}
385
$FDialog->bind("",sub
386
{
387
my $self = shift;
388
$self->focusPrev();
389
Tk->break;
390
});
391
392
$FDialog->withdraw;
393
394
if ($^O =~ /Win/i)
395
{
396
$cwdDfltDrive = substr(&cwd(),0,2);
397
$cwdDfltDrive ||= substr(&getcwd(),0,2);
398
}
399
else
400
{
401
$FDialog->protocol('WM_DELETE_WINDOW' => sub
402
{
403
if (defined($FDialog->{'Can'}) && $FDialog->{'Can'}->IsWidget )
404
{
405
$FDialog->{'Can'}->invoke;
406
}
407
}
408
);
409
#JWT??? $FDialog->transient($FDialog->toplevel);
410
}
411
## Initialize variables that won't be initialized later
412
$FDialog->{'Retval'} = -1;
413
$FDialog->{'DFFrame'} = 0;
414
415
$FDialog->{Configure}{-Horiz} = 1;
416
$FDialog->{Configure}{-SortOrder} = 'Name';
417
418
$FDialog->BuildFDWindow;
419
#$FDialog->{'activefore'} = $FDialog->{'SABox'}->cget(-foreground);
420
$FDialog->{'inactivefore'} = $FDialog->{'SABox'}->cget(-disabledforeground);
421
422
$FDialog->ConfigSpecs(-Chdir => ['PASSIVE', undef, undef, 1],
423
-Create => ['PASSIVE', undef, undef, 1],
424
-DisableShowAll => ['PASSIVE', undef, undef, 0],
425
-DisableFPat => ['PASSIVE', undef, undef, 0],
426
-FPat => ['PASSIVE', undef, undef, '*'],
427
-File => ['PASSIVE', undef, undef, ''],
428
-Geometry => ['PASSIVE', undef, undef, undef],
429
-Grab => ['PASSIVE', undef, undef, 1],
430
-Horiz => ['PASSIVE', undef, undef, 1],
431
-Path => ['PASSIVE', undef, undef, "$ENV{'HOME'}"],
432
-SelDir => ['PASSIVE', undef, undef, 0],
433
-SortButton => ['PASSIVE', undef, undef, 1],
434
-SortOrder => ['PASSIVE', undef, undef, 'Name'],
435
-DirLBCaption => ['PASSIVE', undef, undef, 'Directories:'],
436
-FileLBCaption => ['PASSIVE', undef, undef, 'Files:'],
437
-FileEntryLabel => ['METHOD', undef, undef, 'Filename:'],
438
-PathEntryLabel => ['METHOD', undef, undef, 'Pathname:'],
439
-HistEntryLabel => ['METHOD', undef, undef, 'History:'],
440
-FavEntryLabel => ['METHOD', undef, undef, 'Favorite Paths:'],
441
-FltEntryLabel => ['METHOD', undef, undef, 'Filter:'],
442
-ShowAllLabel => ['METHOD', undef, undef, 'ShowAll'],
443
-OKButtonLabel => ['METHOD', undef, undef, '~OK'],
444
-RescanButtonLabel => ['METHOD', undef, undef, '~Refresh'],
445
-SortButtonLabel => ['METHOD', undef, undef, '~Atime'],
446
-CancelButtonLabel => ['METHOD', undef, undef, '~Cancel'],
447
-HomeButtonLabel => ['METHOD', undef, undef, '~Home'],
448
-CWDButtonLabel => ['METHOD', undef, undef, 'C~WD'],
449
-SelHook => ['PASSIVE', undef, undef, undef],
450
-SelectMode => ['PASSIVE', undef, undef, 'single'], #ADDED 20050416 TO PERMIT MULTIFILE SELECTIONS, THANKS TO Paul Falbe FOR THIS PATCH!
451
-ShowAll => ['PASSIVE', undef, undef, 0],
452
-Title => ['PASSIVE', undef, undef, "Select File:"],
453
-EDlgTitle => ['PASSIVE', undef, undef,
454
'File does not exist!'],
455
-History => ['PASSIVE', undef, undef, 0],
456
-HistFile => ['PASSIVE', undef, undef, undef],
457
-HistDeleteOk => ['PASSIVE', undef, undef, undef],
458
-HistUsePath => ['PASSIVE', undef, undef, undef],
459
-HistUsePathButton => ['PASSIVE', undef, undef, 0],
460
-PathFile => ['PASSIVE', undef, undef, undef],
461
-QuickSelect => ['PASSIVE', undef, undef, 1],
462
-DestroyOnHide => ['PASSIVE', undef, undef, 0],
463
-EDlgText => ['PASSIVE', undef, undef,
464
"You must specify an existing file.\n"
465
. "(\$filename not found)"]);
466
}
467
468
### A few methods for configuration
469
sub OKButtonLabel
470
{
471
&SetButton('OK',@_);
472
}
473
sub RescanButtonLabel
474
{
475
&SetButton('Rescan',@_);
476
}
477
sub SortButtonLabel
478
{
479
my $self = $_[0];
480
&SetButton('SortxButton',@_) if (defined $self->{'SortxButton'}) ;
481
}
482
sub CancelButtonLabel
483
{
484
&SetButton('Can',@_);
485
}
486
sub HomeButtonLabel
487
{
488
&SetButton('Home',@_);
489
}
490
sub CWDButtonLabel
491
{
492
&SetButton('Current',@_);
493
}
494
495
sub SetButton
496
{
497
my($widg, $self, $title) = @_;
498
if (defined($title))
499
{
500
my ($underlinepos) = ($title =~ s/^(.*)~/$1/) ? length($1): undef;
501
## This is a configure
502
$self->{$widg}->configure(-text => $title);
503
if (defined($underlinepos) && $underlinepos >= 0)
504
{
505
$self->{$widg}->configure(-underline => $underlinepos);
506
my ($mychar) = substr($title,$underlinepos,1);
507
$self->bind("",sub {$self->{$widg}->Invoke;});
508
}
509
}
510
## Return the current value
511
$self->{$widg}->cget(-text);
512
$self->{$widg}->bind("",sub {$self->{$widg}->Invoke;});
513
}
514
515
sub HistEntryLabel
516
{
517
&SetLabel('HEF', @_);
518
}
519
sub FavEntryLabel
520
{
521
&SetLabel('FAV', @_);
522
}
523
sub FileEntryLabel
524
{
525
&SetLabel('FEF', @_);
526
}
527
sub PathEntryLabel
528
{
529
&SetLabel('PEF', @_);
530
}
531
sub FltEntryLabel
532
{
533
&SetLabel('patFrame', @_);
534
}
535
sub ShowAllLabel
536
{
537
&SetButton('SABox', @_);
538
}
539
sub SetLabel
540
{
541
my($widg, $self, $title) = @_;
542
if (defined($title))
543
{
544
## This is a configure
545
$self->{$widg}->{'Label'}->configure(-text => $title);
546
}
547
## Return the current value
548
$self->{$widg}->{'Label'}->cget(-text);
549
}
550
551
sub SetFlag
552
{
553
## Set the given flag to either 1 or 0, as appropriate
554
my($self, $flag, $dflt) = @_;
555
556
$flag = "-$flag";
557
558
## We know it's defined as there was a ConfigDefault call after the Populate
559
## call. Therefore, all we have to do is parse the non-numerics
560
if (&IsNum($self->{Configure}{$flag}))
561
{
562
$self->{Configure}{$flag} = 1 unless $self->{Configure}{$flag} == 0;
563
}
564
else
565
{
566
my($val) = $self->{Configure}{$flag};
567
568
my($fc) = lc(substr($val,0,1));
569
570
if (($fc eq 'y') || ($fc eq 't'))
571
{
572
$val = 1;
573
}
574
elsif (($fc eq 'n') || ($fc eq 'f'))
575
{
576
$val = 0;
577
}
578
else
579
{
580
## bad value, complain about it
581
carp ("\"$val\" is not a valid flag ($flag)!");
582
$dflt = 0 if !defined($dflt);
583
$val = $dflt;
584
}
585
$self->{Configure}{$flag} = $val;
586
}
587
return $self->{Configure}{$flag};
588
}
589
590
sub Show
591
{
592
my ($self) = shift;
593
594
my $old_focus = $self->focusSave;
595
my $old_grab = $self->grabSave;
596
$self->configure(@_);
597
598
## Clean up flag variables
599
$self->SetFlag('Chdir');
600
$self->SetFlag('Create');
601
$self->SetFlag('ShowAll');
602
$self->SetFlag('DisableShowAll');
603
$self->SetFlag('DisableFPat'); #ADDED 20050126.
604
$self->SetFlag('Horiz');
605
$self->SetFlag('Grab');
606
#$self->SetFlag('SelDir');
607
608
## Set up, or remove, the directory box
609
&BuildListBoxes($self);
610
## Enable, or disable, the show all box
611
if ($self->{Configure}{-DisableShowAll})
612
{
613
$self->{'SABox'}->configure(-state => 'disabled');
614
}
615
else
616
{
617
$self->{'SABox'}->configure(-state => 'normal');
618
}
619
$self->{'FPat'}->configure(-state => ($self->{Configure}{-DisableFPat})
620
? 'disabled' : 'normal'); #ADDED 20050126.
621
## Enable or disable the file entry box
622
if ($self->{Configure}{-SelDir} == 1)
623
{
624
$self->{Configure}{-File} = '';
625
$self->{'FileEntry'}->configure(-state => 'disabled',
626
-foreground => $self->{'inactivefore'});
627
$self->{'FileList'}->configure(-selectforeground => $self->{'inactivefore'});
628
$self->{'FileList'}->configure(-foreground => $self->{'inactivefore'});
629
}
630
## Set the title
631
$self->title($self->{Configure}{-Title});
632
633
## Create window position (Center unless configured)
634
$self->update;
635
if (defined($self->{Configure}{-Geometry}))
636
{
637
$self->geometry($self->{Configure}{-Geometry});
638
}
639
else
640
{
641
my($x,$y);
642
$x = int(($self->screenwidth - $self->reqwidth)/2 - $self->parent->vrootx);
643
$y = int(($self->screenheight - $self->reqheight)/2 - $self->parent->vrooty);
644
$self->geometry("+$x+$y");
645
}
646
647
## Fill the list boxes
648
&RescanFiles($self);
649
## Restore the window, and go
650
$self->update;
651
$self->deiconify;
652
653
## Set up the grab
654
$self->grab if ($self->{Configure}{-Grab});
655
656
## Initialize status variables
657
$self->{'Retval'} = 0;
658
$self->{'RetFile'} = "";
659
660
if ($self->{Configure}{-SelDir} == 1) # !!!
661
{
662
$self->{'DirEntry'}->focus;
663
}
664
else
665
{
666
$self->{'FileEntry'}->focus;
667
}
668
select(undef, undef, undef, 0.1) if ($ENV{DESKTOP_SESSION} =~ /AfterStep version 2.2.1[2-9]/i); #JWT:ADDED FANCY SLEEP FUNCTION 20140606 B/C TO GET AFTERSTEP TO GIVE "TRANSIENT" WINDOWS THE FOCUS?!;
669
my($i) = 0;
670
while (!$i)
671
{
672
$self->tkwait('variable',\$self->{'Retval'});
673
$i = $self->{'Retval'};
674
if ($i != -1)
675
{
676
## No cancel, so call the hook if it's defined
677
if (defined($self->{Configure}{-SelHook}))
678
{
679
## The hook returns 0 to ignore the result,
680
## non-zero to accept. Must release the grab before calling
681
$self->grab('release') if (defined($self->grab('current')));
682
683
$i = &{$self->{Configure}{-SelHook}}($self->{'RetFile'});
684
685
$self->grab if ($self->{Configure}{-Grab});
686
}
687
}
688
else
689
{
690
$self->{'RetFile'} = undef;
691
}
692
}
693
694
$self->grab('release') if (defined($self->grab('current')));
695
&$old_focus;
696
&$old_grab;
697
# $self->parent->focus();
698
($self->{Configure}{-DestroyOnHide} == 1) ? $self->destroy : $self->withdraw;
699
return $self->{'RetFile'};
700
}
701
702
sub getLastPath
703
{
704
my ($self) = shift;
705
706
my $path = $self->{Configure}{-Path};
707
$path = $driveletter . $path if ($driveletter && $^O =~ /Win/i);
708
return $path;
709
}
710
711
sub getHistUsePathButton
712
{
713
my ($self) = shift;
714
715
return 0 unless (defined $self->{"histToggleVal"});
716
return $self->{"histToggleVal"};
717
}
718
719
#### PRIVATE METHODS AND SUBROUTINES ####
720
sub IsNum
721
{
722
my($parm) = @_;
723
my($warnSave) = $_;
724
$_ = 0;
725
my($res) = (($parm + 0) eq $parm);
726
$_ = $warnSave;
727
return $res;
728
}
729
730
sub BuildListBox
731
{
732
my($self, $fvar, $flabel, $listvar,$hpack, $vpack) = @_;
733
734
## Create the subframe
735
#$self->{"$fvar"} = $self->{'DFFrame'}->Frame(-setgrid => 1)
736
$self->{"$fvar"} = $self->{'DFFrame'}->Frame
737
->pack(-side => $self->{Configure}{-Horiz} ? $hpack : $vpack,
738
-anchor => 'center',
739
-padx => '4m', # !!!
740
-pady => '2m',
741
@bothFill, @expand);
742
743
## Create the label
744
$self->{"$fvar"}->Label(-text => "$flabel")
745
->pack(@topPack, @xfill);
746
747
## Create the frame for the list box
748
my($fbf) = $self->{"$fvar"}->Frame
749
->pack(@topPack, @bothFill, @expand);
750
751
## And the scrollbar and listbox in it
752
# $self->{"$listvar"} = $fbf->Listbox(@raised, -exportselection => 0)
753
# ->pack(@leftPack, @expand, @bothFill);
754
755
# $fbf->AddScrollbars($self->{"$listvar"});
756
# $fbf->configure(-scrollbars => 'se');
757
$self->{"$listvar"} = $fbf->Scrolled('Listbox', -scrollbars => 'se', @raised,
758
-exportselection => 0)->pack(@leftPack, @expand, @bothFill);
759
760
$self->{"$listvar"}->Subwidget('xscrollbar')->configure(-takefocus => 0);
761
$self->{"$listvar"}->Subwidget('yscrollbar')->configure(-takefocus => 0);
762
Tk::Autoscroll::Init($self->{"$listvar"}) if ($useAutoScroll);
763
$self->{"$listvar"}->bind('', sub { $self->bind('', [ sub { $self->{"$listvar"}->yview('scroll',-($_[1]/120)*1,'units') }, Tk::Ev("D")]); });
764
$self->{"$listvar"}->bind('', sub { $self->bind('', [ sub { Tk->break; }]) });
765
766
#NEXT LINE ADDED 20050416 TO PERMIT MULTIFILE SELECTIONS, THANKS TO Paul Falbe FOR THIS PATCH!
767
$self->{"$listvar"}->configure(-selectmode => $self->{Configure}{-SelectMode});
768
}
769
770
sub BindDir
771
{
772
### Set up the bindings for the directory selection list box
773
my($self) = @_;
774
775
my($lbdir) = $self->{'DirList'};
776
#$lbdir->bind("" => sub
777
$lbdir->bind("", sub #CHGD. 20020122 TO MAKE SINGLE-CLICK CHDIR.
778
{
779
my($np) = $lbdir->curselection;
780
return if !defined($np);
781
$np = $lbdir->get($np);
782
if ($np eq '..')
783
{
784
## Moving up one directory
785
$_ = $self->{Configure}{-Path};
786
chop if m!/$!;
787
s!(.*/)[^/]*$!$1!;
788
$self->{Configure}{-Path} = $_;
789
}
790
elsif ($np eq "/")
791
{
792
## Moving to root directory
793
$self->{Configure}{-Path} = $np;
794
}
795
else
796
{
797
## Going down into a directory
798
$self->{Configure}{-Path} .= "/" . "$np/" unless ($np eq '.');
799
}
800
$self->{Configure}{-Path} =~ s!//*!/!g;
801
\&RescanFiles($self);
802
}
803
);
804
$lbdir->bind("" => sub
805
{
806
my($np) = $lbdir->index('active');
807
return if !defined($np);
808
$np = $lbdir->get($np);
809
if ($np eq "..")
810
{
811
## Moving up one directory
812
$_ = $self->{Configure}{-Path};
813
chop if m!/$!;
814
s!(.*/)[^/]*$!$1!;
815
$self->{Configure}{-Path} = $_;
816
}
817
elsif ($np eq "/")
818
{
819
## Moving to root directory
820
$self->{Configure}{-Path} = $np;
821
}
822
else
823
{
824
## Going down into a directory
825
$self->{Configure}{-Path} .= "/" . "$np/" unless ($np eq '.');
826
}
827
$self->{Configure}{-Path} =~ s!//*!/!g;
828
\&RescanFiles($self);
829
}
830
);
831
$self->{'DirEntry'}->bind('' => [\&keyFn,\$self->{Configure}{'Path'},$self->{'DirList'}]);
832
}
833
834
sub BindFile
835
{
836
### Set up the bindings for the file selection list box
837
my($self) = @_;
838
839
## A single click selects the file...
840
$self->{'FileList'}->bind("", sub
841
{
842
if ($self->{Configure}{-SelDir} != 1)
843
{
844
# $self->{Configure}{-File} =
845
# $self->{'FileList'}->get($self->{'FileList'}->curselection);
846
#PREV. CHGD. TO NEXT 20050416 TO PERMIT MULTIFILE SELECTIONS, THANKS TO Paul Falbe FOR THIS PATCH!
847
$self->{Configure}{-File} = join ",", map { (my $f = $self->{'FileList'}->get($_)) =~ s/^\d\d\d\d\d\d\d\d \d\d\d\d //o; $f }
848
$self->{'FileList'}->curselection;
849
}
850
}
851
);
852
## A double-click selects the file for good
853
if ($self->{Configure}{-QuickSelect} == 2)
854
{
855
$self->{'FileList'}->bind("<1>", sub
856
{
857
if ($self->{Configure}{-SelDir} != 1)
858
{
859
my($f) = $self->{'FileList'}->curselection;
860
return if !defined($f);
861
#$self->{'File'} = $self->{'FileList'}->get($f);
862
($self->{Configure}{-File} = $self->{'FileList'}->get($f)) =~ s/^\d\d\d\d\d\d\d\d \d\d\d\d //o;
863
$self->{'OK'}->invoke;
864
}
865
}
866
);
867
}
868
elsif ($self->{Configure}{-QuickSelect})
869
{
870
$self->{'FileList'}->bind("", sub
871
{
872
if ($self->{Configure}{-SelDir} != 1)
873
{
874
my($f) = $self->{'FileList'}->curselection;
875
return if !defined($f);
876
($self->{'File'} = $self->{'FileList'}->get($f)) =~ s/^\d\d\d\d\d\d\d\d \d\d\d\d //o;
877
$self->{'OK'}->invoke;
878
}
879
}
880
);
881
}
882
$self->{'FileList'}->bind("", sub
883
{
884
if ($self->{Configure}{-SelDir} != 1)
885
{
886
my($f) = $self->{'FileList'}->index('active');
887
return if !defined($f);
888
($self->{'File'} = $self->{'FileList'}->get($f)) =~ s/^\d\d\d\d\d\d\d\d \d\d\d\d //o;
889
# $self->{Configure}{-File} = $self->{'FileList'}->get($f);
890
#PREV. CHGD. TO NEXT 20050416 TO PERMIT MULTIFILE SELECTIONS, THANKS TO Paul Falbe FOR THIS PATCH!
891
$self->{Configure}{-File} = join ",", map { (my $f = $self->{'FileList'}->get($_)) =~ s/^\d\d\d\d\d\d\d\d \d\d\d\d //o; $f }
892
$self->{'FileList'}->curselection;
893
$self->{Configure}{-File} ||= $self->{'File'};
894
$self->{'OK'}->focus;
895
# $self->{'OK'}->invoke;
896
}
897
}
898
);
899
$self->{'FileList'}->bind("", sub
900
{
901
if ($self->{Configure}{-SelDir} != 1)
902
{
903
my($f) = $self->{'FileList'}->index('active');
904
return if !defined($f);
905
($self->{'File'} = $self->{'FileList'}->get($f)) =~ s/^\d\d\d\d\d\d\d\d \d\d\d\d //o;
906
# $self->{Configure}{-File} = $self->{'FileList'}->get($f);
907
#PREV. CHGD. TO NEXT 20050416 TO PERMIT MULTIFILE SELECTIONS, THANKS TO Paul Falbe FOR THIS PATCH!
908
$self->{Configure}{-File} = join ",", map { (my $f = $self->{'FileList'}->get($_)) =~ s/^\d\d\d\d\d\d\d\d \d\d\d\d //o; $f }
909
$self->{'FileList'}->curselection;
910
}
911
}
912
);
913
$self->{'FileList'}->bind("", sub
914
{
915
if ($self->{Configure}{-SelDir} != 1)
916
{
917
my($f) = $self->{'FileList'}->index('active');
918
return if !defined($f);
919
($self->{'File'} = $self->{'FileList'}->get($f)) =~ s/^\d\d\d\d\d\d\d\d \d\d\d\d //o;
920
# $self->{Configure}{-File} = $self->{'FileList'}->get($f);
921
#PREV. CHGD. TO NEXT 20050416 TO PERMIT MULTIFILE SELECTIONS, THANKS TO Paul Falbe FOR THIS PATCH!
922
$self->{Configure}{-File} = join ",", map { (my $f = $self->{'FileList'}->get($_)) =~ s/^\d\d\d\d\d\d\d\d \d\d\d\d //o; $f }
923
$self->{'FileList'}->curselection;
924
}
925
}
926
);
927
#$self->{'FileList'}->configure(-selectforeground => 'blue');
928
$self->{'FileEntry'}->bind('' => [\&keyFn,\$self->{Configure}{'File'},$self->{'FileList'}]);
929
}
930
931
sub BuildEntry
932
{
933
### Build the entry, label, and frame indicated. This is a
934
### convenience routine to avoid duplication of code between
935
### the file and the path entry widgets
936
my($self, $LabelVar, $entry) = @_;
937
my($LabelType) = $LabelVar;
938
$LabelVar = "-$LabelVar";
939
940
## Create the entry frame
941
my $eFrame = $self->Frame(@raised)
942
->pack(-padx => '4m', -ipady => '2m',@topPack, @xfill); # !!!
943
944
## Now create and pack the title and entry
945
$eFrame->{'Label'} = $eFrame->Label->pack(@leftPack); # !!!
946
947
# $self->{"$entry"} = $eFrame->Entry(@sunken,
948
# -textvariable => \$self->{Configure}{$LabelVar})
949
# ->pack(@rightPack, @expand, @xfill);
950
951
if ($LabelType eq 'Path') #NEXT 26 ADDED 20010130 TO ADD DRIVE-LETTER SELECTION IN WINDOZE!
952
{
953
if ($Win32)
954
{
955
$_ = Win32::GetNextAvailDrive();
956
s/\W//g;
957
#my (@driveletters);
958
# @driveletters = ();
959
unless ($#driveletters >= 0)
960
{
961
for my $i ('A'..'Z')
962
{
963
last if ($i eq $_);
964
# push (@driveletters, "~$i:");
965
push (@driveletters, "$i:");
966
}
967
}
968
$driveletter ||= 'C:';
969
# $self->{"driveMenu"} = $eFrame->JOptionmenu(
970
# -textvariable => \$driveletter,
971
# -command => [\&chgDriveLetter, $self],
972
# #-relief => 'raised',
973
# #-highlightthickness => 2,
974
# -indicatoron => 0,
975
# -takefocus => 1,
976
# -options => \@driveletters)
977
# ->pack(@rightPack);
978
$self->{"driveMenu"} = $eFrame->JBrowseEntry(
979
-textvariable => \$driveletter,
980
-state => 'normal',
981
-browsecmd => [\&chgDriveLetter, $self],
982
#-highlightthickness => 2,
983
#-altbinding => 'Down=Popup,Return=Next',
984
-takefocus => 1,
985
-browse => 1,
986
-choices => \@driveletters)
987
->pack(@leftPack);
988
}
989
else
990
{
991
$driveletter = '';
992
}
993
}
994
$self->{"$entry"} = $eFrame->Entry(@sunken,
995
-textvariable => \$self->{Configure}{$LabelVar})
996
->pack(@leftPack, @expand, @xfill);
997
if ($LabelType eq 'File' && (!defined($self->{Configure}{-SelDir}) || $self->{Configure}{-SelDir} != 1))
998
{
999
$self->{"$entry"}->bind("",sub
1000
{
1001
#&RescanFiles($self);
1002
$self->{'OK'}->Invoke;
1003
});
1004
}
1005
#elsif ($LabelType eq 'Path' && $self->{Configure}{-SelDir})
1006
elsif ($LabelType eq 'Path')
1007
{
1008
if ($self->{Configure}{-SortButton})
1009
{
1010
$self->{'SortxButton'} = $eFrame->Checkbutton( -variable => \$self->{Configure}{-SortOrder},
1011
-onvalue => 'Date', -offvalue => 'Name',
1012
-text => 'Atime',
1013
-command => sub { &SortFiles($self);})
1014
->pack(@leftPack);
1015
}
1016
$self->{"$entry"}->bind("",sub
1017
{
1018
&RescanFiles($self);
1019
$self->{"$entry"}->SetCursor('end'); ###
1020
#$self->{'OK'}->focus;
1021
}
1022
);
1023
}
1024
$self->{"$entry"}->bind("",sub {$self->{'Can'}->Invoke;});
1025
1026
my ($whichlist) = 'FileList';
1027
$whichlist = 'DirList' if ($LabelType eq 'Path');
1028
1029
$self->{"$entry"}->bind("",sub
1030
{
1031
my ($oldval,$currentval);
1032
$currentval = $self->{"$entry"}->get;
1033
if (length($currentval)) #ADDED 20010131
1034
{
1035
$oldval = $currentval;
1036
$currentval = '' unless ($currentval =~ m#\/#o);
1037
$currentval =~ s#(.*\/)(.*)$#$1#;
1038
($_ = $self->{$whichlist}->get('active')) =~ s/^\d\d\d\d\d\d\d\d \d\d\d\d //o;
1039
my ($restofsel) = $currentval;
1040
if ($_ && $_ ne '.' && $_ ne '..' && $_ ne '/') #IF ADDED 20010131.
1041
{
1042
($_ = $self->{$whichlist}->get('active')) =~ s/^\d\d\d\d\d\d\d\d \d\d\d\d //o;
1043
$restofsel .= $_;
1044
}
1045
# elsif ($_ eq '..' && $restofsel ne $oldval)
1046
# {
1047
# $restofsel =~ s!(.*/)[^/]*/\.\./?$!$1!;
1048
# }
1049
$self->{$entry}->delete('0.0','end');
1050
$self->{$entry}->insert('end',$restofsel);
1051
Tk->break unless ($restofsel eq $oldval);
1052
}
1053
});
1054
$self->{"$entry"}->bind("",sub
1055
{
1056
my ($currentval);
1057
$currentval = $self->{"$entry"}->get;
1058
$currentval = '' unless ($currentval =~ m#\/#);
1059
$currentval =~ s#(.*\/)(.*)$#$1#;
1060
$self->{$whichlist}->UpDown(-1);
1061
my ($restofsel) = $currentval;
1062
($_ = $self->{$whichlist}->get('active')) =~ s/^\d\d\d\d\d\d\d\d \d\d\d\d //o;
1063
$restofsel .= $_;
1064
$self->{$entry}->delete('0.0','end');
1065
$self->{$entry}->insert('end',$restofsel);
1066
Tk->break;
1067
}
1068
);
1069
$self->{"$entry"}->bind("",sub
1070
{
1071
my ($currentval);
1072
$currentval = $self->{"$entry"}->get;
1073
$currentval = '' unless ($currentval =~ m#\/#);
1074
$currentval =~ s#(.*\/)(.*)$#$1#;
1075
$self->{$whichlist}->UpDown(1);
1076
my ($restofsel) = $currentval;
1077
($_ = $self->{$whichlist}->get('active')) =~ s/^\d\d\d\d\d\d\d\d \d\d\d\d //o;
1078
$restofsel .= $_;
1079
$self->{$entry}->delete('0.0','end');
1080
$self->{$entry}->insert('end',$restofsel);
1081
Tk->break;
1082
}
1083
);
1084
1085
return $eFrame;
1086
}
1087
1088
sub BuildBrowse
1089
{
1090
### Build the entry, label, and frame indicated. This is a
1091
### convenience routine to avoid duplication of code between
1092
### the file and the path entry widgets
1093
my($self, $LabelVar, $entry) = @_;
1094
my($LabelType) = $LabelVar;
1095
$LabelVar = "-$LabelVar";
1096
1097
## Create the entry frame
1098
my $eFrame = $self->Frame(@raised)
1099
->pack(-padx => '4m', -ipady => '2m',@topPack, @xfill); # !!!
1100
1101
## Now create and pack the title and entry
1102
$eFrame->{'Label'} = $eFrame->Label->pack(@leftPack); # !!!
1103
1104
push (@{$self->{Configure}{HistList}}, '');
1105
if ($self->{Configure}{-HistFile} && open(TEMP, $self->{Configure}{-HistFile}))
1106
{
1107
while ()
1108
{
1109
chomp;
1110
push (@{$self->{Configure}{HistList}}, $_) if ($_);
1111
}
1112
}
1113
1114
if ($LabelVar eq '-Hist')
1115
{
1116
$self->{"histToggleVal"} = (defined($self->{Configure}{-HistUsePathButton}) && $self->{Configure}{-HistUsePathButton} == 1) ? 1 : 0;
1117
if ($self->{Configure}{-HistUsePath} && $self->{Configure}{-HistUsePath} != 1)
1118
{
1119
my $pathLabel = $self->{Configure}{-HistUsePath};
1120
$pathLabel = 'Keep Path' if ($self->{Configure}{-HistUsePath} =~ /^\-?\d/);
1121
$self->{"histToggle"} = $eFrame->Checkbutton(
1122
-text => $pathLabel,
1123
-variable=> \$self->{"histToggleVal"}
1124
)->pack(@rightPack);
1125
}
1126
}
1127
$self->{"$entry"} = $eFrame->JBrowseEntry(@raised,
1128
-label => '',
1129
-state => 'readonly',
1130
-variable => \$self->{Configure}{$LabelVar},
1131
-choices => \@{$self->{Configure}{HistList}},
1132
-deleteitemsok => $self->{Configure}{-HistDeleteOk}||0,
1133
-browsecmd => sub {
1134
$self->{'OK'}->invoke unless (!$self->{Configure}{-QuickSelect} or $_[2] =~ /space$/);
1135
$self->{'FileEntry'}->delete('0.0','end');
1136
$self->{'FileEntry'}->insert('end', $self->{Configure}{$LabelVar});
1137
$self->{'FileEntry'}->focus;
1138
if ($self->{Configure}{-HistUsePath} == 1 || ($self->{Configure}{-HistUsePath} && $self->{"histToggleVal"}))
1139
{
1140
$self->{Configure}{-Path} = $self->{Configure}{$LabelVar};
1141
$self->{Configure}{-Path} =~ s#\/[^\/]+$## unless (-d $self->{Configure}{-Path});
1142
$driveletter = $1 if ($^O =~ /Win/i && $self->{Configure}{-Path} =~ s/^(\w\:)//);
1143
&RescanFiles($self);
1144
}
1145
$self->{Configure}{$LabelVar} = '';
1146
},
1147
-listrelief => 'flat')
1148
->pack(@rightPack, @expand, @xfill);
1149
1150
$eFrame->packForget unless ($self->{Configure}{-HistFile});
1151
#DOESN'T WORK?! $self->{"$entry"}->bind('', sub {
1152
# $self->{'FileEntry'}->delete('0.0','end');
1153
# $self->{'FileEntry'}->insert('end',\$self->{Configure}{$LabelVar});
1154
# Tk->break;
1155
# });
1156
1157
return $eFrame;
1158
}
1159
1160
sub BuildFAV
1161
{
1162
### Build the entry, label, and frame indicated. This is a
1163
### convenience routine to avoid duplication of code between
1164
### the file and the path entry widgets
1165
my($self, $LabelVar, $entry) = @_;
1166
my($LabelType) = $LabelVar;
1167
$LabelVar = "-$LabelVar";
1168
1169
## Create the entry frame
1170
my $eFrame = $self->Frame(@raised)
1171
->pack(-padx => '4m', -ipady => '2m',@topPack, @xfill); # !!!
1172
1173
## Now create and pack the title and entry
1174
$eFrame->{'Label'} = $eFrame->Label->pack(@leftPack); # !!!
1175
1176
${$self->{Configure}{PathList}}{''} = '';
1177
my ($l, $r, $s, $dir);
1178
if ($Win32 && -d $self->{Configure}{-PathFile}) #ADDED 20081029 TO ALLOW USAGE OF WINDOWS' "FAVORITES" (v1.4)
1179
{
1180
(my $pathDir = $self->{Configure}{-PathFile}) =~ s#\\#\/#go;
1181
chop($pathDir) if ($pathDir =~ m#\/$#);
1182
my ($f, %favHash);
1183
if (opendir (FAVDIR, $pathDir))
1184
{
1185
while (defined($f = readdir(FAVDIR)))
1186
{
1187
if ($f =~ /\.lnk$/o)
1188
{
1189
# print "-file=$f=\n";
1190
if (open (LNKFILE, "<${pathDir}/$f"))
1191
{
1192
while (defined($s = ))
1193
{
1194
if ($s =~ /(\w\:\\\w[\w\\\_\-\. ]+)/o)
1195
{
1196
($dir = $1) =~ s#\\#\/#gso;
1197
$dir =~ s/\s+#//gso;
1198
if (-d $dir)
1199
{
1200
$f =~ s/\.lnk//io;
1201
$favHash{$f} = $dir;
1202
last;
1203
}
1204
}
1205
}
1206
close LNKFILE;
1207
}
1208
}
1209
}
1210
closedir FAVDIR;
1211
foreach $f (sort keys %favHash)
1212
{
1213
${$self->{Configure}{PathList}}{$favHash{$f}} = $f;
1214
}
1215
}
1216
}
1217
elsif ($self->{Configure}{-PathFile} && open(TEMP, $self->{Configure}{-PathFile}))
1218
{
1219
while ()
1220
{
1221
chomp;
1222
if ($_)
1223
{
1224
$l = $_;
1225
$r = '';
1226
($l,$r) = split(/\;/o);
1227
$r ||= $l;
1228
${$self->{Configure}{PathList}}{$l} = $r;
1229
}
1230
}
1231
}
1232
1233
$self->{"$entry"} = $eFrame->JBrowseEntry(@raised,
1234
-label => '',
1235
-state => 'readonly',
1236
-variable => \$self->{Configure}{$LabelVar},
1237
-choices => \%{$self->{Configure}{PathList}},
1238
-browsecmd => sub {
1239
$self->{Configure}{-Path} = $self->{$entry}->dereference($self->{Configure}{$LabelVar});
1240
&RescanFiles($self) unless (!$self->{Configure}{-QuickSelect} or $_[2] =~ /space$/);
1241
$self->{'FileEntry'}->focus;
1242
},
1243
-listrelief => 'flat')
1244
->pack(@rightPack, @expand, @xfill);
1245
$eFrame->packForget unless ($self->{Configure}{-PathFile} && -r $self->{Configure}{-PathFile});
1246
return $eFrame;
1247
}
1248
1249
sub BuildListBoxes
1250
{
1251
my($self) = shift;
1252
1253
## Destroy both, if they're there
1254
if ($self->{'DFFrame'} && $self->{'DFFrame'}->IsWidget)
1255
{
1256
$self->{'DFFrame'}->destroy;
1257
}
1258
1259
$self->{'DFFrame'} = $self->Frame;
1260
$self->{'DFFrame'}->pack(-before => $self->{'FEF'},
1261
@topPack, @bothFill, @expand);
1262
1263
## Build the file window before the directory window, even
1264
## though the file window is below the directory window, we'll
1265
## pack the directory window before.
1266
&BuildListBox($self, 'FileFrame',
1267
$self->{Configure}{-FileLBCaption},
1268
'FileList','right','bottom');
1269
## Set up the bindings for the file list
1270
&BindFile($self);
1271
1272
if ($self->{Configure}{-Chdir})
1273
{
1274
&BuildListBox($self,'DirFrame',$self->{Configure}{-DirLBCaption},
1275
'DirList','left','top');
1276
&BindDir($self);
1277
}
1278
}
1279
1280
sub BuildFDWindow
1281
{
1282
### Build the entire file dialog window
1283
my($self) = shift;
1284
### Build the filename entry box
1285
$self->{'FEF'} = &BuildEntry($self, 'File', 'FileEntry');
1286
1287
### Build the pathname directory box
1288
$self->{'PEF'} = &BuildEntry($self, 'Path','DirEntry');
1289
1290
### JWT:Build the History Dropdown list.
1291
$self->{'HEF'} = &BuildBrowse($self, 'Hist', 'HistEntry');
1292
1293
### Now comes the multi-part frame
1294
my $patFrame = $self->Frame->pack(-padx => '4m', -pady => '2m', @topPack, @xfill); # !!!
1295
1296
## Label first...
1297
$self->{'patFrame'}->{'Label'} = $patFrame->Label->pack(@leftPack); # !!!
1298
1299
## Now the entry...
1300
$self->{'FPat'} = $patFrame->Entry(-textvariable => \$self->{Configure}{-FPat})
1301
->pack(@leftPack, @expand, @xfill);
1302
$self->{'FPat'}->bind("",sub { &RescanFiles($self);});
1303
1304
## and the radio box
1305
$self->{'SABox'} = $patFrame->Checkbutton(-variable => \$self->{Configure}{-ShowAll},
1306
-command => sub { &RescanFiles($self);})
1307
->pack(@leftPack);
1308
1309
### JWT:Build the Favorites Dropdown list.
1310
$self->{'FAV'} = &BuildFAV($self, 'FAV', 'FavEntry');
1311
1312
### FINALLY!!! the button frame
1313
my $butFrame = $self->Frame(@raised);
1314
$butFrame->pack(-padx => '2m', -pady => '2m', @topPack, @xfill);
1315
1316
$self->{'OK'} = $butFrame->Button(-command => sub
1317
{
1318
&GetReturn($self);
1319
}
1320
)
1321
->pack(-padx => '2m', -pady => '2m', @leftPack, @expand, @xfill);
1322
1323
$self->{'Rescan'} = $butFrame->Button(-command => sub
1324
{
1325
&RescanFiles($self);
1326
}
1327
)
1328
->pack(-padx => '2m', -pady => '2m', @leftPack, @expand, @xfill);
1329
1330
$self->{'Can'} = $butFrame->Button(-command => sub
1331
{
1332
$self->{'Retval'} = -1;
1333
}
1334
)->pack(-padx => '2m', -pady => '2m', @leftPack, @expand, @xfill);
1335
1336
$self->{'Home'} = $butFrame->Button(
1337
-text => 'Home',
1338
-underline => 0,
1339
-command => sub
1340
{
1341
$self->{Configure}{-Path} = $ENV{HOME} || $ENV{LOGDIR};
1342
$self->{Configure}{-Path} =~ s#\\#\/#go;
1343
$self->{Configure}{-Path} = (getpwuid($<))[7]
1344
unless ($Win32 || !$< || $self->{Configure}{-Path});
1345
$self->{Configure}{-Path} ||= &cwd() || &getcwd();
1346
&RescanFiles($self);
1347
}
1348
)->pack(-padx => '2m', -pady => '2m', @leftPack, @expand, @xfill);
1349
1350
$self->{'Current'} = $butFrame->Button(
1351
-text => 'CWD',
1352
-underline => 1,
1353
-command => sub
1354
{
1355
$self->{Configure}{-Path} = &cwd() || &getcwd();
1356
$self->{Configure}{-Path} =~ s#\\#\/#go;
1357
&RescanFiles($self);
1358
}
1359
)->pack(-padx => '2m', -pady => '2m', @leftPack, @expand, @xfill);
1360
1361
if (-e "$ENV{HOME}/.cdout")
1362
{
1363
my $cdir0 = &cwd() || &getcwd();
1364
my $cdir = $cdir0;
1365
open (CD, "$ENV{HOME}/.cdout") || last;
1366
$cdir = ;
1367
chomp($cdir);
1368
close CD;
1369
if ($cdir ne $cdir0) {
1370
$self->{'CDOUT'} = $butFrame->Button(
1371
-text => 'Cdir',
1372
-underline => 1,
1373
-command => sub
1374
{
1375
$self->{Configure}{-Path} = $cdir;
1376
$self->{Configure}{-Path} =~ s#\\#\/#go;
1377
&RescanFiles($self);
1378
}
1379
)->pack(-padx => '2m', -pady => '2m', @leftPack, @expand, @xfill);
1380
}
1381
}
1382
}
1383
1384
sub RescanFiles
1385
{
1386
### Fill the file and directory boxes
1387
my($self) = shift;
1388
1389
my($fl) = $self->{'FileList'};
1390
my($dl) = $self->{'DirList'};
1391
my($path) = $self->{Configure}{-Path};
1392
my($show) = $self->{Configure}{-ShowAll};
1393
my($chdir) = $self->{Configure}{-Chdir};
1394
### Remove a final / if it is there, and add it
1395
$path = '' unless (defined($path));
1396
$_ = &cwd() || &getcwd();
1397
if ($path !~ /\S/)
1398
{
1399
$self->{Configure}{-Path} = $path if ($path eq '/');
1400
}
1401
$path =~ s/^\./$_/;
1402
$driveletter = $1 if ($path =~ s/^(\w\:)(.*)$/$2/);
1403
$driveletter =~ tr/a-z/A-Z/;
1404
$path =~ s!(.*/)[^/]*/\.\./?$!$1!
1405
&& $self->{Configure}{-Path} =~ s!(.*/)[^/]*/\.\./?$!$1!;
1406
if ($^O =~ /Win/i)
1407
{
1408
if (length($path) && substr($path,-1,1) ne '/')
1409
{
1410
$path .= '/';
1411
}
1412
$self->{Configure}{-Path} = $path;
1413
$path = $driveletter . $path if ($driveletter);
1414
#$path =~ s!^/([a-zA-Z]\:)!$1!;
1415
}
1416
else
1417
{
1418
if ($path =~ /^~/o)
1419
{
1420
$path = `ls -d $path`; # !!! HANDLES DIRS W/ A TILDE!
1421
chomp($path);
1422
}
1423
if ((length($path) == 0) || (substr($path,-1,1) ne '/'))
1424
{
1425
$path .= '/';
1426
$self->{Configure}{-Path} = $path;
1427
}
1428
}
1429
### path now has a trailing / no matter what
1430
1431
unless (($path =~ /^~/o) || -d $path)
1432
{
1433
print STDERR "-JFileDialog: =$path= is NOT a directory\n";
1434
carp "$path is NOT a directory\n";
1435
return 0;
1436
}
1437
1438
$self->configure(-cursor => 'watch');
1439
my($OldGrab) = $self->grab('current');
1440
$self->{'Rescan'}->grab;
1441
$self->{'Rescan'}->configure(-state => 'disabled');
1442
$self->update;
1443
my (@allfiles);
1444
if (opendir(ALLFILES,$path))
1445
{
1446
@allfiles = readdir(ALLFILES);
1447
closedir(ALLFILES);
1448
}
1449
my($direntry);
1450
1451
## First, get the directories...
1452
if ($chdir)
1453
{
1454
my ($parentfound) = 0;
1455
$dl->delete(0,'end');
1456
$dl->insert('end', '/') unless ($path eq '/');
1457
foreach $direntry (sort @allfiles)
1458
{
1459
next if !-d "$path$direntry";
1460
next if $direntry eq ".";
1461
if ( !$show
1462
&& (substr($direntry,0,1) eq ".")
1463
&& $direntry ne "..")
1464
{
1465
next;
1466
}
1467
next if ($direntry eq '..' && $path eq '/');
1468
$dl->insert('end',$direntry);
1469
$parentfound = 1 if ($direntry =~ /^\.\./o);
1470
}
1471
$dl->insert(1,'..') #ADDED 20010130 JWT TO FIX MISSING ".." CHOICE!
1472
unless ($parentfound || $path eq '/' || ($path =~ m#^\w\:\/?$#o));
1473
$dl->insert(1,'.') if ($path eq '/' || ($path =~ m#^\w\:\/?$#o));
1474
}
1475
1476
## Now, get the files
1477
$fl->delete(0,'end');
1478
1479
$_ = $self->{Configure}{-FPat};
1480
s/^\s*|\s*$//;
1481
$_ = $self->{Configure}{-FPat} = '*' if $_ eq '';
1482
1483
my($pat) = $_;
1484
undef @allfiles;
1485
1486
@allfiles = <$path.$pat> if $show;
1487
1488
my ($cmd) = $path . $pat;
1489
if (opendir(DIR, $path))
1490
{
1491
@allfiles = grep { /\.${pat}$/i } readdir(DIR);
1492
closedir DIR;
1493
}
1494
if ($self->{Configure}{-SortOrder} =~ /^N/o)
1495
{
1496
foreach $direntry (sort @allfiles)
1497
{
1498
if (-f "${path}$direntry")
1499
{
1500
$direntry =~ s!.*/([^/]*)$!$1!;
1501
next if (!$show && $direntry =~ /^\./o); #SKIP ".-FILES" EVEN ON WINDOWS!
1502
$fl->insert('end',$direntry);
1503
}
1504
}
1505
}
1506
else
1507
{
1508
1509
my @sortedFiles;
1510
foreach $direntry (@allfiles)
1511
{
1512
if (-f "${path}$direntry")
1513
{
1514
my (@timestuff, @stats, $atime);
1515
@stats = stat "${path}$direntry";
1516
@timestuff = localtime($stats[9]);
1517
$atime = ($timestuff[5] + 1900);
1518
$atime .= '0' if ($timestuff[4] < 9);
1519
$atime .= ($timestuff[4] + 1);
1520
$atime .= '0' if ($timestuff[3] < 10);
1521
$atime .= $timestuff[3];
1522
$atime .= ' ';
1523
$atime .= '0' if ($timestuff[2] < 10);
1524
$atime .= $timestuff[2];
1525
$atime .= '0' if ($timestuff[1] < 10);
1526
$atime .= $timestuff[1];
1527
$direntry =~ s!.*/([^/]*)$!$1!;
1528
next if (!$show && $direntry =~ /^\./o); #SKIP ".-FILES" EVEN ON WINDOWS!
1529
push @sortedFiles, ($atime . ' ' . $direntry);
1530
}
1531
}
1532
my @stats;
1533
foreach $direntry (sort @sortedFiles)
1534
{
1535
$fl->insert('end',$direntry);
1536
}
1537
}
1538
1539
$self->configure(-cursor => 'top_left_arrow');
1540
1541
if ($^O =~ /Win/i)
1542
{
1543
my $foundit = 0;
1544
for (my $i=0;$i<=$#driveletters;$i++)
1545
{
1546
if ($driveletters[$i] eq $driveletter)
1547
{
1548
$foundit = 1;
1549
last;
1550
}
1551
}
1552
unless ($foundit)
1553
{
1554
my @l = @driveletters;
1555
push (@l, $driveletter);
1556
@driveletters = sort @l;
1557
$self->{"driveMenu"}->choices(\@driveletters);
1558
}
1559
1560
}
1561
$self->{'Rescan'}->grab('release') if $self->grab('current') == $self->{'Rescan'};
1562
$OldGrab->grab if defined($OldGrab);
1563
$self->{'Rescan'}->configure(-state => 'normal');
1564
$self->update;
1565
return 1;
1566
}
1567
1568
sub add2Hist
1569
{
1570
my $self = shift;
1571
my $fname = shift;
1572
1573
if ($self->{Configure}{HistList} && $self->{Configure}{-HistFile}
1574
&& open(TEMP, ">$self->{Configure}{-HistFile}"))
1575
{
1576
shift (@{$self->{Configure}{HistList}});
1577
print TEMP "$fname\n";
1578
my $i = 1;
1579
my $t;
1580
while (@{$self->{Configure}{HistList}})
1581
{
1582
$t = shift(@{$self->{Configure}{HistList}});
1583
unless ($t eq $fname)
1584
{
1585
print TEMP "$t\n";
1586
++$i;
1587
last if ($self->{Configure}{-History}
1588
&& $i >= $self->{Configure}{-History});
1589
}
1590
}
1591
close TEMP;
1592
if ($self->{Configure}{-HistUsePath} == 1 || ($self->{Configure}{-HistUsePath} && $self->{"histToggleVal"}))
1593
{
1594
#$fname = 'v:/dev/.propval/html/x.pl';
1595
$self->{Configure}{-Path} = $fname;
1596
$self->{Configure}{-Path} =~ s#\/[^\/]+$## unless (-d $self->{Configure}{-Path});
1597
$driveletter = $1 if ($^O =~ /Win/i && $self->{Configure}{-Path} =~ s/^(\w\:)//);
1598
#"=".$fname."=".$driveletter."=".$xxx."="
1599
}
1600
}
1601
}
1602
1603
sub GetReturn
1604
{
1605
my ($self) = @_;
1606
1607
## Construct the filename
1608
my $path = $self->{Configure}{-Path};
1609
my $fname;
1610
if ($self->{Configure}{-Hist})
1611
{
1612
$fname = $self->{Configure}{-Hist};
1613
@{$self->{Configure}{HistList}} = $self->{HistEntry}->choices();
1614
&add2Hist($self, $fname);
1615
}
1616
elsif ($^O =~ /Win/i)
1617
{
1618
$path = $driveletter . $path if ($driveletter);
1619
$path .= "/" if (substr($path, -1, 1) ne '/');
1620
$path .= "/" if (length($path) && substr($path, -1, 1) ne '/');
1621
1622
if ($self->{Configure}{-SelDir})
1623
{
1624
$fname = $self->{'DirList'};
1625
if (defined($fname->curselection))
1626
{
1627
$fname = $fname->get($fname->curselection);
1628
$fname =~ s/^\d\d\d\d\d\d\d\d \d\d \d\d//o;
1629
if ($fname =~ /^\.\.$/) # !!!
1630
{
1631
$path =~ s/\/$//;
1632
$path =~ s#/[^/]*$#/#;
1633
}
1634
}
1635
else
1636
{
1637
$fname = '';
1638
}
1639
if ($fname =~ /^\.\.$/)
1640
{
1641
$fname = $path;
1642
$fname = '/' if ($fname le ' ');
1643
}
1644
else
1645
{
1646
$fname = $path . $fname;
1647
}
1648
$fname =~ s/\/$// unless ($fname =~ /^\/$/);
1649
}
1650
if ($self->{Configure}{-SelDir} != 1)
1651
{
1652
if (!$self->{Configure}{-SelDir} && $self->{Configure}{-File} le ' ')
1653
{
1654
$self->{'RetFile'} = undef;
1655
$self->{'Retval'} = -1;
1656
return;
1657
}
1658
elsif (substr($self->{Configure}{-File},0,1) eq '/') # !!!
1659
{
1660
$fname = $self->{Configure}{-File}; #!!!
1661
}
1662
elsif ($self->{Configure}{-SelDir} != 2 || $self->{Configure}{-File} gt ' ')
1663
{
1664
#WINNT: $fname = $path . $self->{Configure}{-File};
1665
$fname = $path unless ($self->{Configure}{-File} =~ /^[a-zA-Z]\:/);
1666
$fname .= $self->{Configure}{-File};
1667
}
1668
## Make sure that the file exists, if the user is not allowed
1669
## to create
1670
if (!$self->{Configure}{-Create} && $self->{Configure}{-File} gt ' ' && !(-f $fname) && !((-d $fname) && $self->{Configure}{-SelDir}))
1671
{
1672
## Put up no create dialog
1673
my($path) = $self->{Configure}{-Path};
1674
$path = $driveletter . $path if ($driveletter);
1675
my($file) = $self->{Configure}{-File};
1676
my($filename) = $fname;
1677
eval "\$fname = \"$self->{Configure}{-EDlgText}\"";
1678
$self->Dialog(-title => $self->{Configure}{-EDlgTitle},
1679
-text => $fname,
1680
-bitmap => 'error')
1681
->Show;
1682
return;
1683
}
1684
}
1685
1686
&add2Hist($self, $fname);
1687
}
1688
else
1689
{
1690
my $fnamex;
1691
1692
if ($path =~ /^~/)
1693
{
1694
#$path = `rksh 'ls -d $path'`; # !!! HANDLES DIRS W/ A TILDE!
1695
$path = `ls -d $path`; # !!! HANDLES DIRS W/ A TILDE!
1696
chomp($path);
1697
}
1698
$path .= "/" if (substr($path, -1, 1) ne '/');
1699
if ($self->{Configure}{-SelDir})
1700
{
1701
$fname = $self->{'DirList'};
1702
if (defined($fname->curselection))
1703
{
1704
$fname = $fname->get($fname->curselection);
1705
if ($fname =~ /^\.\.$/) # !!!
1706
{
1707
$path =~ s/\/$//;
1708
$path =~ s#/[^/]*$#/#;
1709
}
1710
$fname =~ s/^\d\d\d\d\d\d\d\d \d\d\d\d //o;
1711
}
1712
else
1713
{
1714
$fname = '';
1715
}
1716
if ($fname =~ /^\.\.$/)
1717
{
1718
$fname = $path;
1719
$fname = '/' if ($fname le ' ');
1720
}
1721
elsif ($fname =~ /^~/) # !!!
1722
{
1723
#$fname = `rksh 'ls -d $fname'`; # !!! HANDLES FILES W/ A TILDE!
1724
$fname = `ls -d $fname`; # !!! HANDLES FILES W/ A TILDE!
1725
chomp($fname);
1726
}
1727
else
1728
{
1729
$fname = $path . $fname;
1730
}
1731
$fname =~ s/\/$// unless ($fname =~ /^\/$/);
1732
}
1733
if ($self->{Configure}{-SelDir} != 1)
1734
{
1735
if (!$self->{Configure}{-SelDir} && $self->{Configure}{-File} le ' ')
1736
{
1737
$self->{'RetFile'} = undef;
1738
$self->{'Retval'} = -1;
1739
return;
1740
}
1741
$fnamex = $self->{Configure}{-File};
1742
if ($fnamex =~ /^~/) # !!!
1743
{
1744
#$fnamex = `rksh 'ls -d $fnamex'`; # !!! HANDLES FILES W/ A TILDE!
1745
$fnamex = `ls -d $fnamex`;
1746
chomp($fnamex);
1747
$fname = $fnamex;
1748
}
1749
elsif (substr($fnamex,0,1) eq '/') # !!!
1750
{
1751
$fname = $fnamex; #!!!
1752
}
1753
elsif ($self->{Configure}{-SelDir} != 2 || $self->{Configure}{-File} gt ' ')
1754
{
1755
#$fname = $path . $self->{Configure}{-File}; #CHGD. TO NEXT 20050417 PER PATCH FROM Paul Falbe.
1756
($fname = $path . $self->{Configure}{-File}) =~ s/,/,$path/g;
1757
}
1758
## Make sure that the file exists, if the user is not allowed
1759
## to create
1760
if (!$self->{Configure}{-Create} && $self->{Configure}{-File} gt ' ' && !(-f $fname) && !((-d $fname) && $self->{Configure}{-SelDir}))
1761
{
1762
## Put up no create dialog
1763
my($path) = $self->{Configure}{-Path};
1764
$path = $driveletter . $path if ($driveletter);
1765
my($file) = $self->{Configure}{-File};
1766
my($filename) = $fname;
1767
eval "\$fname = \"$self->{Configure}{-EDlgText}\"";
1768
$self->Dialog(-title => $self->{Configure}{-EDlgTitle},
1769
-text => $fname,
1770
-bitmap => 'error')
1771
->Show;
1772
## And return
1773
return;
1774
}
1775
}
1776
&add2Hist($self, $fname);
1777
}
1778
$self->{'RetFile'} = $fname;
1779
$self->{'Retval'} = 1;
1780
}
1781
1782
sub keyFn #JWT: TRAP LETTERS PRESSED AND ADJUST SELECTION ACCORDINGLY.
1783
{
1784
my ($e,$w,$l) = @_;
1785
my $mykey = $e->XEvent->A;
1786
# if ($w->cget( "-state" ) eq "readonly") #TEXT FIELD HAS FOCUS.
1787
# {
1788
if ($mykey)
1789
{
1790
my ($entryval) = $e->get;
1791
$entryval =~ s#(.*/)(.*)$#$2#;
1792
&LbFindSelection($l,$entryval);
1793
}
1794
# }
1795
# else #LISTBOX HAS FOCUS.
1796
# {
1797
# &LbFindSelection($w) if ($mykey);
1798
# }
1799
}
1800
1801
sub LbFindSelection
1802
{
1803
my ($l, $var_ref, $srchval) = @_;
1804
1805
#my $var_ref;
1806
1807
unless ($srchval)
1808
{
1809
#my $var_ref = $w->cget( "-textvariable" );
1810
#my $var_ref = \$w->{Configure}{$LabelVar};
1811
$srchval = $var_ref;
1812
}
1813
#my $l = $w;
1814
#$l->configure(-selectmode => 'browse'); #CHGD. TO NEXT. 20050418 TO ALLOW MULTIPLE SELECTIONS.
1815
$l->configure(-selectmode => 'browse')
1816
if ($l->{Configure}{-selectmode} eq 'single');
1817
my (@listsels) = $l->get('0','end');
1818
if ($#listsels >= 0 && $listsels[0] =~ /^\d\d\d\d\d\d\d\d \d\d\d\d /)
1819
{
1820
foreach my $i (0..$#listsels)
1821
{
1822
$listsels[$i] =~ s/^\d\d\d\d\d\d\d\d \d\d\d\d //o;
1823
}
1824
}
1825
foreach my $i (0..$#listsels)
1826
{
1827
if ($listsels[$i] eq $srchval)
1828
{
1829
$l->selectionClear('0','end');
1830
$l->activate($i);
1831
$l->selectionSet($i);
1832
$l->see($i);
1833
#my $var_ref = $w->cget("-listok") || undef;;
1834
#$$var_ref = 1 if (defined($var_ref));
1835
return $i;
1836
}
1837
}
1838
foreach my $i (0..$#listsels)
1839
{
1840
if ($listsels[$i] =~ /^$srchval/)
1841
{
1842
$l->selectionClear('0','end');
1843
$l->activate($i);
1844
$l->selectionSet($i);
1845
$l->see($i);
1846
#$var_ref = $w->cget("-listok") || undef;;
1847
#$$var_ref = 1 if (defined($var_ref));
1848
return $i;
1849
}
1850
}
1851
foreach my $i (0..$#listsels)
1852
{
1853
if ($listsels[$i] =~ /^$srchval/i)
1854
{
1855
$l->selectionClear('0','end');
1856
$l->activate($i);
1857
$l->selectionSet($i);
1858
$l->see($i);
1859
#$var_ref = $w->cget("-listok") || undef;;
1860
#$$var_ref = 1 if (defined($var_ref));
1861
return $i;
1862
}
1863
}
1864
#$var_ref = $w->cget("-listok") || undef;;
1865
#$$var_ref = 0 if (defined($var_ref));
1866
return -1;
1867
}
1868
1869
sub chgDriveLetter #ADDED 20010130 BY JWT.
1870
{
1871
my ($self) = shift;
1872
1873
#$_ = $self->{Configure}{-Path};
1874
#s!^\w\:!$driveletter! if ($driveletter =~ /\w\:/);
1875
#$self->{Configure}{-Path} = $driveletter if ($driveletter =~ /\w\:/);
1876
$driveletter =~ tr/a-z/A-Z/;
1877
$driveletter = substr($driveletter,0,1) . ':' if (length($driveletter) >= 2 || $driveletter =~ /^[A-Z]$/);
1878
$self->{Configure}{-Path} = '' if ($_[2] =~ /(?:listbox|key\.\w)/);
1879
$self->{Configure}{-Path} = &cwd() || &getcwd()
1880
if (!$self->{Configure}{-Path} && $driveletter =~ /$cwdDfltDrive/i);
1881
&RescanFiles($self);
1882
}
1883
1884
sub SortFiles
1885
{
1886
my ($self) = shift;
1887
1888
&RescanFiles($self);
1889
}
1890
1891
### Return 1 to the calling use statement ###
1892
1;
1893
### End of file FileDialog.pm ###
1894
__END__