File Coverage

blib/lib/Tk/FileEntry.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package Tk::FileEntry;
2            
3 2     2   38121 use 5.008008;
  2         8  
  2         75  
4 2     2   11 use strict;
  2         4  
  2         80  
5 2     2   11 use warnings;
  2         8  
  2         62  
6 2     2   854 use Tk;
  0            
  0            
7             use Tk::widgets qw/ Frame Derived Widget Label Entry Button /;
8             use base qw/ Tk::Derived Tk::Frame /;
9            
10             our $VERSION = '2.2';
11            
12             Construct Tk::Widget 'FileEntry';
13            
14             my $FILEBITMAP = undef;
15            
16             =head1 NAME
17            
18             Tk::FileEntry - FileEntry widget with optional file selection box
19            
20             =head1 SYNOPSIS
21            
22             use Tk::FileEntry;
23            
24             $fileentry = $parent->FileEntry(
25             -filebitmap => BITMAP,
26             -command => CALLBACK,
27             -variable => SCALARREF,
28             );
29            
30             =head1 DESCRIPTION
31            
32             FileEntry is a composite widget for choosing files.
33             It features a L, L, and a L.
34            
35             When the button is clicked, a dialog for choosing a file will show up.
36             The path of the chosen file will be inserted into the entry widget.
37             The label is intended as caption fot the entry widget.
38            
39             This is useful if you want to provide a convenient way to select a
40             file path.
41            
42            
43            
44            
45             =head1 WIDGET-SPECIFIC OPTIONS
46            
47             =over 4
48            
49             =item C B<-filebitmap>
50            
51             =item C B
52            
53             =item C B
54            
55             Specifies the bitmap to be used for the button that invokes the File Dialog.
56            
57             =item B<-command>
58            
59             A callback that is executed when a file is chosen.
60            
61             Pressing enter in the entry widget will execute this callback. See L.
62            
63             =item B<-variable>
64            
65             Reference to variable that will be bound to the value of the entry widget.
66             See C for more details on C<-variable>.
67            
68             =item B<-label>
69            
70             Defines the label text. Defaults to I.
71            
72             =back
73            
74             =cut
75            
76            
77             # METHODS
78            
79             sub ClassInit {
80             my ($class, $mw) = @_;
81            
82             return if defined $FILEBITMAP; # needed for several MainWindows
83             $FILEBITMAP = __PACKAGE__ . '::OPENFOLDER';
84            
85             my $bits = pack("b16"x10,
86             "...111111.......",
87             "..1......11.....",
88             ".1.........1....",
89             ".1..........1...",
90             ".1...11111111111",
91             ".1..1.1.1.1.1.1.",
92             ".1.1.1.1.1.1.1..",
93             ".11.1.1.1.1.1...",
94             ".1.1.1.1.1.1....",
95             ".1111111111.....",
96             );
97            
98             $mw->DefineBitmap($FILEBITMAP => 16,10, $bits);
99            
100             }
101            
102             sub Populate {
103             my ($w,$args) = @_;
104            
105             $w->SUPER::Populate($args);
106            
107             my $l = $w->Label()->pack(-side=>'left');
108             my $e = $w->Entry()->pack(-side=>'left', -expand=>'yes', -fill=>'x');
109             my $b = $w->Button(
110             -command => [\&_selectfile, $w, $e],
111             -takefocus => 0,
112             )->pack(
113             -side => 'left',
114             -fill => 'y',
115             );
116            
117             $e->bind('', [$w, '_invoke_command', $e]);
118            
119             $w->Advertise('entry' => $e);
120             $w->Advertise('button' => $b);
121            
122             $w->Delegates(
123             'get' => $e,
124             'insert' => $e,
125             'delete' => $e,
126             DEFAULT => $w,
127             );
128            
129             $w->ConfigSpecs(
130             -background => [qw(CHILDREN background Background), Tk::NORMAL_BG()],
131             -foreground => [qw(CHILDREN foreground Foreground), Tk::BLACK() ],
132             -state => [qw(CHILDREN state State normal) ],
133             -label => [{-text => $l}, 'label', 'Label', 'File:'],
134             -filebitmap => [{-bitmap => $b}, 'fileBitmap', 'FileBitmap', $FILEBITMAP,],
135             -command => ['CALLBACK', undef, undef, undef],
136             -variable => ['METHOD', undef, undef, undef],
137             );
138            
139             return $w;
140             } # /populate
141            
142            
143            
144            
145             sub _selectfile {
146             my $w = shift;
147             my $e = shift;
148            
149             my $file = $w->getOpenFile();
150            
151             return unless defined $file && length $file;
152             $e->delete(0,'end');
153             $e->insert('end',$file);
154             $w->Callback(-command => $w, $file);
155             }
156            
157            
158             sub _invoke_command {
159             my $w = shift;
160             my $e = shift;
161             my $file = $e->get();
162             return unless defined $file && length $file;
163             $w->Callback(-command => $w, $e->get);
164             }
165            
166            
167             # variable( $v ) is listed as method in ConfigSpecs
168            
169             sub variable {
170             my $e = shift->Subwidget('entry');
171             my $v = shift;
172             $e->configure(-textvariable => $v);
173             }
174            
175            
176            
177            
178             =head1 BINDINGS
179            
180             C has default bindings to allow the execution of the callback when a user presses enter in the entry widget.
181            
182            
183            
184            
185             =head1 EXAMPLE
186            
187             use strict;
188             use warnings;
189             use Tk;
190             use Tk::FileEntry;
191            
192             my $mw = tkinit();
193            
194             $mw->FileEntry->pack(-expand => 1, -fill => 'x');
195            
196             $mw->MainLoop();
197            
198            
199            
200             =head1 BUGS
201            
202             None yet. If you find one, please consider creating a bug report, e.g. via L.
203            
204            
205            
206            
207             =head1 SEE ALSO
208            
209             =over
210            
211             =item * L for details about the file selection dialog
212            
213             =item * L for details about the Entry widget
214            
215             =item * L for details about the Perl/Tk GUI library
216            
217             =back
218            
219             There is a wiki for Tcl/Tk stuff on the web: L
220            
221            
222            
223            
224             =head1 KEYWORDS
225            
226             fileentry, tix, widget, file selector
227            
228            
229            
230            
231             =head1 AUTHOR
232            
233             Alex Becker, Ec a p f a n `a`t` g m x `d`o`t` d e - i n v a l i dE
234            
235             Original Author was Achim Bohnet .
236            
237             This code is inspired by the documentation of FileEntry.n of the Tix4.1.0 distribution by Ioi Lam.
238             The bitmap data are also from Tix4.1.0. For everything else:
239            
240             =head1 COPYRIGHT
241            
242             Copyright (C) 2013 by Alex Becker
243            
244             Copyright (c) 1997-1998 Achim Bohnet. All rights reserved.
245            
246             =head1 LICENSE
247            
248             This library is free software; you can redistribute it and/or modify
249             it under the same terms as Perl itself, either Perl version 5.16.3 or,
250             at your option, any later version of Perl 5 you may have available.
251            
252            
253             =cut
254            
255            
256             1; # /Tk::FileEntry