projects / OpenSPARC-T2-DV / blame
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Initial commit of OpenSPARC T2 design and verification files.
[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / sun4-solaris / Tk / IconList.pm
CommitLineData
86530b38
AT		 1# -*- perl -*-
2#
3# tkfbox.tcl --
4#
5# Implements the "TK" standard file selection dialog box. This
6# dialog box is used on the Unix platforms whenever the tk_strictMotif
7# flag is not set.
8#
9# The "TK" standard file selection dialog box is similar to the
10# file selection dialog box on Win95(TM). The user can navigate
11# the directories by clicking on the folder icons or by
12# selectinf the "Directory" option menu. The user can select
13# files by clicking on the file icons or by entering a filename
14# in the "Filename:" entry.
15#
16# Copyright (c) 1994-1996 Sun Microsystems, Inc.
17#
18# See the file "license.terms" for information on usage and redistribution
19# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
20#
21# Translated to perk/Tk by Slaven Rezic <eserte@cs.tu-berlin.de>.
22#
23
24#----------------------------------------------------------------------
25#
26# I C O N L I S T
27#
28# This is a pseudo-widget that implements the icon list inside the
29# tkFDialog dialog box.
30#
31#----------------------------------------------------------------------
32# tkIconList --
33#
34# Creates an IconList widget.
35#
36
37package Tk::IconList;
38require Tk::Frame;
39use strict;
40
41use vars qw($VERSION);
42$VERSION = '3.005'; # $Id: //depot/Tk8/Tk/IconList.pm#5 $
43
44use base 'Tk::Frame';
45
46Construct Tk::Widget 'IconList';
47
48# tkIconList_Create --
49#
50# Creates an IconList widget by assembling a canvas widget and a
51# scrollbar widget. Sets all the bindings necessary for the IconList's
52# operations.
53#
54sub Populate {
55 my($w, $args) = @_;
56 $w->SUPER::Populate($args);
57
58 my $sbar = $w->Component('Scrollbar' => 'sbar',
59 -orient => 'horizontal',
60 -highlightthickness => 0,
61 -takefocus => 0,
62 );
63 my $canvas = $w->Component('Canvas' => 'canvas',
64 -bd => 2,
65 -relief => 'sunken',
66 -width => 400,
67 -height => 120,
68 -takefocus => 1,
69 );
70 $sbar->pack(-side => 'bottom', -fill => 'x', -padx => 2);
71 $canvas->pack(-expand => 'yes', -fill => 'both');
72 $sbar->configure(-command => ['xview', $canvas]);
73 $canvas->configure(-xscrollcommand => ['set', $sbar]);
74
75 # Initializes the max icon/text width and height and other variables
76 $w->{'maxIW'} = 1;
77 $w->{'maxIH'} = 1;
78 $w->{'maxTW'} = 1;
79 $w->{'maxTH'} = 1;
80 $w->{'numItems'} = 0;
81 delete $w->{'curItem'};
82 $w->{'noScroll'} = 1;
83
84 # Creates the event bindings.
85 $canvas->Tk::bind('<Configure>', sub { $w->Arrange } );
86 $canvas->Tk::bind('<1>',
87 sub {
88 my $c = shift;
89 my $Ev = $c->XEvent;
90 $w->Btn1($Ev->x, $Ev->y);
91 }
92 );
93 $canvas->Tk::bind('<B1-Motion>',
94 sub {
95 my $c = shift;
96 my $Ev = $c->XEvent;
97 $w->Motion1($Ev->x, $Ev->y);
98 }
99 );
100 $canvas->Tk::bind('<Double-ButtonRelease-1>',
101 sub {
102 my $c = shift;
103 my $Ev = $c->XEvent;
104 $w->Double1($Ev->x,$Ev->y);
105 }
106 );
107 $canvas->Tk::bind('<ButtonRelease-1>', sub { $w->CancelRepeat });
108 $canvas->Tk::bind('<B1-Leave>',
109 sub {
110 my $c = shift;
111 my $Ev = $c->XEvent;
112 $w->Leave1($Ev->x, $Ev->y);
113 }
114 );
115 $canvas->Tk::bind('<B1-Enter>', sub { $w->CancelRepeat });
116 $canvas->Tk::bind('<Up>', sub { $w->UpDown(-1) });
117 $canvas->Tk::bind('<Down>', sub { $w->UpDown(1) });
118 $canvas->Tk::bind('<Left>', sub { $w->LeftRight(-1) });
119 $canvas->Tk::bind('<Right>', sub { $w->LeftRight(1) });
120 $canvas->Tk::bind('<Return>', sub { $w->ReturnKey });
121 $canvas->Tk::bind('<KeyPress>',
122 sub {
123 my $c = shift;
124 my $Ev = $c->XEvent;
125 $w->KeyPress($Ev->A);
126 }
127 );
128 $canvas->Tk::bind('<Control-KeyPress>', 'NoOp');
129 $canvas->Tk::bind('<Alt-KeyPress>', 'NoOp');
130 $canvas->Tk::bind('<FocusIn>', sub { $w->FocusIn });
131
132 $w->ConfigSpecs(-browsecmd =>
133 ['CALLBACK', 'browseCommand', 'BrowseCommand', undef],
134 -command =>
135 ['CALLBACK', 'command', 'Command', undef],
136 -font =>
137 ['PASSIVE', 'font', 'Font', undef],
138 -foreground =>
139 ['PASSIVE', 'foreground', 'Foreground', undef],
140 -fg => '-foreground',
141 );
142
143 $w;
144}
145
146# tkIconList_AutoScan --
147#
148# This procedure is invoked when the mouse leaves an entry window
149# with button 1 down. It scrolls the window up, down, left, or
150# right, depending on where the mouse left the window, and reschedules
151# itself as an "after" command so that the window continues to scroll until
152# the mouse moves back into the window or the mouse button is released.
153#
154# Arguments:
155# w - The IconList window.
156#
157sub AutoScan {
158 my $w = shift;
159 return unless ($w->exists);
160 return if ($w->{'noScroll'});
161 my($x, $y);
162 $x = $Tk::x;
163 $y = $Tk::y;
164 my $canvas = $w->Subwidget('canvas');
165 if ($x >= $canvas->width) {
166 $canvas->xview('scroll', 1, 'units');
167 } elsif ($x < 0) {
168 $canvas->xview('scroll', -1, 'units');
169 } elsif ($y >= $canvas->height) {
170 # do nothing
171 } elsif ($y < 0) {
172 # do nothing
173 } else {
174 return;
175 }
176 $w->Motion1($x, $y);
177 $w->RepeatId($w->after(50, ['AutoScan', $w]));
178}
179
180# Deletes all the items inside the canvas subwidget and reset the IconList's
181# state.
182#
183sub DeleteAll {
184 my $w = shift;
185 my $canvas = $w->Subwidget('canvas');
186 $canvas->delete('all');
187 delete $w->{'selected'};
188 delete $w->{'rect'};
189 delete $w->{'list'};
190 delete $w->{'itemList'};
191 $w->{'maxIW'} = 1;
192 $w->{'maxIH'} = 1;
193 $w->{'maxTW'} = 1;
194 $w->{'maxTH'} = 1;
195 $w->{'numItems'} = 0;
196 delete $w->{'curItem'};
197 $w->{'noScroll'} = 1;
198 $w->Subwidget('sbar')->set(0.0, 1.0);
199 $canvas->xview('moveto', 0);
200}
201
202# Adds an icon into the IconList with the designated image and text
203#
204sub Add {
205 my($w, $image, $text) = @_;
206 my $canvas = $w->Subwidget('canvas');
207 my $iTag = $canvas->createImage(0, 0, -image => $image, -anchor => 'nw');
208 my $font = $w->cget(-font);
209 my $fg = $w->cget(-foreground);
210 my $tTag = $canvas->createText(0, 0, -text => $text, -anchor => 'nw',
211 (defined $fg ? (-fill => $fg) : ()),
212 (defined $font ? (-font => $font) : ()),
213 );
214 my $rTag = $canvas->createRectangle(0, 0, 0, 0,
215 -fill => undef,
216 -outline => undef);
217 my(@b) = $canvas->bbox($iTag);
218 my $iW = $b[2] - $b[0];
219 my $iH = $b[3] - $b[1];
220 $w->{'maxIW'} = $iW if ($w->{'maxIW'} < $iW);
221 $w->{'maxIH'} = $iH if ($w->{'maxIH'} < $iH);
222 @b = $canvas->bbox($tTag);
223 my $tW = $b[2] - $b[0];
224 my $tH = $b[3] - $b[1];
225 $w->{'maxTW'} = $tW if ($w->{'maxTW'} < $tW);
226 $w->{'maxTH'} = $tH if ($w->{'maxTH'} < $tH);
227 push @{ $w->{'list'} }, [$iTag, $tTag, $rTag, $iW, $iH, $tW, $tH,
228 $w->{'numItems'}];
229 $w->{'itemList'}{$rTag} = [$iTag, $tTag, $text, $w->{'numItems'}];
230 $w->{'textList'}{$w->{'numItems'}} = lc($text);
231 ++$w->{'numItems'};
232}
233
234# Places the icons in a column-major arrangement.
235#
236sub Arrange {
237 my $w = shift;
238 my $canvas = $w->Subwidget('canvas');
239 my $sbar = $w->Subwidget('sbar');
240 unless (exists $w->{'list'}) {
241 if (defined $canvas && Tk::Exists($canvas)) {
242 $w->{'noScroll'} = 1;
243 $sbar->configure(-command => sub { });
244 }
245 return;
246 }
247
248 my $W = $canvas->width;
249 my $H = $canvas->height;
250 my $pad = $canvas->cget(-highlightthickness) + $canvas->cget(-bd);
251 $pad = 2 if ($pad < 2);
252 $W -= $pad*2;
253 $H -= $pad*2;
254 my $dx = $w->{'maxIW'} + $w->{'maxTW'} + 8;
255 my $dy;
256 if ($w->{'maxTH'} > $w->{'maxIH'}) {
257 $dy = $w->{'maxTH'};
258 } else {
259 $dy = $w->{'maxIH'};
260 }
261 $dy += 2;
262 my $shift = $w->{'maxIW'} + 4;
263 my $x = $pad * 2;
264 my $y = $pad;
265 my $usedColumn = 0;
266 foreach my $sublist (@{ $w->{'list'} }) {
267 $usedColumn = 1;
268 my($iTag, $tTag, $rTag, $iW, $iH, $tW, $tH) = @$sublist;
269 my $i_dy = ($dy - $iH) / 2;
270 my $t_dy = ($dy - $tH) / 2;
271 $canvas->coords($iTag, $x, $y + $i_dy);
272 $canvas->coords($tTag, $x + $shift, $y + $t_dy);
273 $canvas->coords($tTag, $x + $shift, $y + $t_dy);
274 $canvas->coords($rTag, $x, $y, $x + $dx, $y + $dy);
275 $y += $dy;
276 if ($y + $dy > $H) {
277 $y = $pad;
278 $x += $dx;
279 $usedColumn = 0;
280 }
281 }
282 my $sW;
283 if ($usedColumn) {
284 $sW = $x + $dx;
285 } else {
286 $sW = $x;
287 }
288 if ($sW < $W) {
289 $canvas->configure(-scrollregion => [$pad, $pad, $sW, $H]);
290 $sbar->configure(-command => sub { });
291 $canvas->xview(moveto => 0);
292 $w->{'noScroll'} = 1;
293 } else {
294 $canvas->configure(-scrollregion => [$pad, $pad, $sW, $H]);
295 $sbar->configure(-command => ['xview', $canvas]);
296 $w->{'noScroll'} = 0;
297 }
298 $w->{'itemsPerColumn'} = ($H - $pad) / $dy;
299 $w->{'itemsPerColumn'} = 1 if ($w->{'itemsPerColumn'} < 1);
300 $w->Select($w->{'list'}[$w->{'curItem'}][2], 0)
301 if (exists $w->{'curItem'});
302}
303
304# Gets called when the user invokes the IconList (usually by double-clicking
305# or pressing the Return key).
306#
307sub Invoke {
308 my $w = shift;
309 $w->Callback(-command => $w->{'selected'}) if (exists $w->{'selected'});
310}
311
312# tkIconList_See --
313#
314# If the item is not (completely) visible, scroll the canvas so that
315# it becomes visible.
316sub See {
317 my($w, $rTag) = @_;
318 return if ($w->{'noScroll'});
319 return unless (exists $w->{'itemList'}{$rTag});
320 my $canvas = $w->Subwidget('canvas');
321 my(@sRegion) = @{ $canvas->cget('-scrollregion') };
322 return unless (@sRegion);
323 my(@bbox) = $canvas->bbox($rTag);
324 my $pad = $canvas->cget(-highlightthickness) + $canvas->cget(-bd);
325 my $x1 = $bbox[0];
326 my $x2 = $bbox[2];
327 $x1 -= $pad * 2;
328 $x2 -= $pad;
329 my $cW = $canvas->width - $pad * 2;
330 my $scrollW = $sRegion[2] - $sRegion[0] + 1;
331 my $dispX = int(($canvas->xview)[0] * $scrollW);
332 my $oldDispX = $dispX;
333 # check if out of the right edge
334 $dispX = $x2 - $cW if ($x2 - $dispX >= $cW);
335 # check if out of the left edge
336 $dispX = $x1 if ($x1 - $dispX < 0);
337 if ($oldDispX != $dispX) {
338 my $fraction = $dispX / $scrollW;
339 $canvas->xview('moveto', $fraction);
340 }
341}
342
343sub SelectAtXY {
344 my($w, $x, $y) = @_;
345 my $canvas = $w->Subwidget('canvas');
346 $w->Select($canvas->find('closest',
347 $canvas->canvasx($x),
348 $canvas->canvasy($y)));
349}
350
351sub Select {
352 my $w = shift;
353 my $rTag = shift;
354 my $callBrowse = (@_ ? shift : 1);
355 return unless (exists $w->{'itemList'}{$rTag});
356 my($iTag, $tTag, $text, $serial) = @{ $w->{'itemList'}{$rTag} };
357 my $canvas = $w->Subwidget('canvas');
358 $w->{'rect'} = $canvas->createRectangle(0, 0, 0, 0, -fill => '#a0a0ff',
359 -outline => '#a0a0ff')
360 unless (exists $w->{'rect'});
361 $canvas->lower($w->{'rect'});
362 my(@bbox) = $canvas->bbox($tTag);
363 $canvas->coords($w->{'rect'}, @bbox);
364 $w->{'curItem'} = $serial;
365 $w->{'selected'} = $text;
366 if ($callBrowse) {
367 $w->Callback(-browsecmd => $text);
368 }
369}
370
371sub Unselect {
372 my $w = shift;
373 my $canvas = $w->Subwidget('canvas');
374 if (exists $w->{'rect'}) {
375 $canvas->delete($w->{'rect'});
376 delete $w->{'rect'};
377 }
378 delete $w->{'selected'} if (exists $w->{'selected'});
379 delete $w->{'curItem'};
380}
381
382# Returns the selected item
383#
384sub Get {
385 my $w = shift;
386 if (exists $w->{'selected'}) {
387 $w->{'selected'};
388 } else {
389 undef;
390 }
391}
392
393sub Btn1 {
394 my($w, $x, $y) = @_;
395 $w->Subwidget('canvas')->focus;
396 $w->SelectAtXY($x, $y);
397}
398
399# Gets called on button-1 motions
400#
401sub Motion1 {
402 my($w, $x, $y) = @_;
403 $Tk::x = $x;
404 $Tk::y = $y;
405 $w->SelectAtXY($x, $y);
406}
407
408sub Double1 {
409 my($w, $x, $y) = @_;
410 $w->Invoke if (exists $w->{'curItem'});
411}
412
413sub ReturnKey {
414 my $w = shift;
415 $w->Invoke;
416}
417
418sub Leave1 {
419 my($w, $x, $y) = @_;
420 $Tk::x = $x;
421 $Tk::y = $y;
422 $w->AutoScan;
423}
424
425sub FocusIn {
426 my $w = shift;
427 return unless (exists $w->{'list'});
428 unless (exists $w->{'curItem'}) {
429 my $rTag = $w->{'list'}[0][2];
430 $w->Select($rTag);
431 }
432}
433
434# tkIconList_UpDown --
435#
436# Moves the active element up or down by one element
437#
438# Arguments:
439# w - The IconList widget.
440# amount - +1 to move down one item, -1 to move back one item.
441#
442sub UpDown {
443 my($w, $amount) = @_;
444 my $rTag;
445 return unless (exists $w->{'list'});
446 unless (exists $w->{'curItem'}) {
447 $rTag = $w->{'list'}[0][2];
448 } else {
449 my $oldRTag = $w->{'list'}[$w->{'curItem'}][2];
450 $rTag = $w->{'list'}[($w->{'curItem'} + $amount)][2];
451 $rTag = $oldRTag unless defined $rTag;
452 }
453 if (defined $rTag) {
454 $w->Select($rTag);
455 $w->See($rTag);
456 }
457}
458
459# tkIconList_LeftRight --
460#
461# Moves the active element left or right by one column
462#
463# Arguments:
464# w - The IconList widget.
465# amount - +1 to move right one column, -1 to move left one column.
466#
467sub LeftRight {
468 my($w, $amount) = @_;
469 my $rTag;
470 return unless (exists $w->{'list'});
471 unless (exists $w->{'curItem'}) {
472 $rTag = $w->{'list'}[0][2];
473 } else {
474 my $oldRTag = $w->{'list'}[$w->{'curItem'}][2];
475 my $newItem = $w->{'curItem'} + $amount * $w->{'itemsPerColumn'};
476 $rTag = $w->{'list'}[$newItem][2];
477 $rTag = $oldRTag unless (defined $rTag);
478 }
479 if (defined $rTag) {
480 $w->Select($rTag);
481 $w->See($rTag);
482 }
483}
484
485#----------------------------------------------------------------------
486# Accelerator key bindings
487#----------------------------------------------------------------------
488# tkIconList_KeyPress --
489#
490# Gets called when user enters an arbitrary key in the listbox.
491#
492sub KeyPress {
493 my($w, $key) = @_;
494 $w->{'_ILAccel'} .= $key;
495 $w->Goto($w->{'_ILAccel'});
496 eval {
497 $w->afterCancel($w->{'_ILAccel_afterid'});
498 };
499 $w->{'_ILAccel_afterid'} = $w->after(500, ['Reset', $w]);
500}
501
502sub Goto {
503 my($w, $text) = @_;
504 return unless (exists $w->{'list'});
505 return if (not defined $text or $text eq '');
506 my $start = (!exists $w->{'curItem'} ? 0 : $w->{'curItem'});
507 $text = lc($text);
508 my $theIndex = -1;
509 my $less = 0;
510 my $len = length($text);
511 my $i = $start;
512 # Search forward until we find a filename whose prefix is an exact match
513 # with $text
514 while (1) {
515 my $sub = substr($w->{'textList'}{$i}, 0, $len);
516 if ($text eq $sub) {
517 $theIndex = $i;
518 last;
519 }
520 ++$i;
521 $i = 0 if ($i == $w->{'numItems'});
522 last if ($i == $start);
523 }
524 if ($theIndex > -1) {
525 my $rTag = $w->{'list'}[$theIndex][2];
526 $w->Select($rTag, 0);
527 $w->See($rTag);
528 }
529}
530
531sub Reset {
532 my $w = shift;
533 undef $w->{'_ILAccel'};
534}
535
5361;
Full OpenSPARC design & verification tarball including full HDL.