1# 2# Fileselectionbox 3# ---------------------------------------------------------------------- 4# Implements a file selection box in a style similar to the OSF/Motif 5# standard XmFileselectionbox composite widget. The Fileselectionbox 6# is composed of directory and file scrolled lists as well as filter 7# and selection entry fields. 8# 9# ---------------------------------------------------------------------- 10# AUTHOR: Mark L. Ulferts EMAIL: mulferts@spd.dsccc.com 11# 12# @(#) $Id: fileselectionbox.itk,v 1.3 2001/08/07 19:56:48 smithc Exp $ 13# ---------------------------------------------------------------------- 14# Copyright (c) 1997 DSC Technologies Corporation 15# ====================================================================== 16# Permission to use, copy, modify, distribute and license this software 17# and its documentation for any purpose, and without fee or written 18# agreement with DSC, is hereby granted, provided that the above copyright 19# notice appears in all copies and that both the copyright notice and 20# warranty disclaimer below appear in supporting documentation, and that 21# the names of DSC Technologies Corporation or DSC Communications 22# Corporation not be used in advertising or publicity pertaining to the 23# software without specific, written prior permission. 24# 25# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 26# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- 27# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE 28# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 29# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 30# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 31# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 32# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, 33# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 34# SOFTWARE. 35# ====================================================================== 36 37# 38# Usual options. 39# 40itk::usual Fileselectionbox { 41 keep -activebackground -activerelief -background -borderwidth -cursor \ 42 -elementborderwidth -foreground -highlightcolor -highlightthickness \ 43 -insertbackground -insertborderwidth -insertofftime -insertontime \ 44 -insertwidth -jump -labelfont -selectbackground -selectborderwidth \ 45 -textbackground -textfont -troughcolor 46} 47 48# ------------------------------------------------------------------ 49# FILESELECTIONBOX 50# ------------------------------------------------------------------ 51itcl::class iwidgets::Fileselectionbox { 52 inherit itk::Widget 53 54 constructor {args} {} 55 destructor {} 56 57 itk_option define -childsitepos childSitePos Position s 58 itk_option define -fileson filesOn FilesOn true 59 itk_option define -dirson dirsOn DirsOn true 60 itk_option define -selectionon selectionOn SelectionOn true 61 itk_option define -filteron filterOn FilterOn true 62 itk_option define -mask mask Mask {*} 63 itk_option define -directory directory Directory {} 64 itk_option define -automount automount Automount {} 65 itk_option define -nomatchstring noMatchString NoMatchString {} 66 itk_option define -dirsearchcommand dirSearchCommand Command {} 67 itk_option define -filesearchcommand fileSearchCommand Command {} 68 itk_option define -selectioncommand selectionCommand Command {} 69 itk_option define -filtercommand filterCommand Command {} 70 itk_option define -selectdircommand selectDirCommand Command {} 71 itk_option define -selectfilecommand selectFileCommand Command {} 72 itk_option define -invalid invalid Command {bell} 73 itk_option define -filetype fileType FileType {regular} 74 itk_option define -width width Width 350 75 itk_option define -height height Height 300 76 77 public { 78 method childsite {} 79 method get {} 80 method filter {} 81 } 82 83 public { 84 method _selectDir {} 85 method _dblSelectDir {} 86 method _selectFile {} 87 method _selectSelection {} 88 method _selectFilter {} 89 } 90 91 protected { 92 method _packComponents {{when later}} 93 method _updateLists {{when later}} 94 } 95 96 private { 97 method _setFilter {} 98 method _setSelection {} 99 method _setDirList {} 100 method _setFileList {} 101 102 method _nPos {} 103 method _sPos {} 104 method _ePos {} 105 method _wPos {} 106 method _topPos {} 107 method _centerPos {} 108 method _bottomPos {} 109 110 variable _packToken "" ;# non-null => _packComponents pending 111 variable _updateToken "" ;# non-null => _updateLists pending 112 variable _pwd "." ;# present working dir 113 variable _interior ;# original interior setting 114 } 115} 116 117# 118# Provide a lowercased access method for the Fileselectionbox class. 119# 120proc ::iwidgets::fileselectionbox {pathName args} { 121 uplevel ::iwidgets::Fileselectionbox $pathName $args 122} 123 124# 125# Use option database to override default resources of base classes. 126# 127option add *Fileselectionbox.borderWidth 2 widgetDefault 128 129option add *Fileselectionbox.filterLabel Filter widgetDefault 130option add *Fileselectionbox.dirsLabel Directories widgetDefault 131option add *Fileselectionbox.filesLabel Files widgetDefault 132option add *Fileselectionbox.selectionLabel Selection widgetDefault 133 134option add *Fileselectionbox.width 350 widgetDefault 135option add *Fileselectionbox.height 300 widgetDefault 136 137# ------------------------------------------------------------------ 138# CONSTRUCTOR 139# ------------------------------------------------------------------ 140itcl::body iwidgets::Fileselectionbox::constructor {args} { 141 # 142 # Add back to the hull width and height options and make the 143 # borderwidth zero since we don't need it. 144 # 145 itk_option add hull.width hull.height 146 component hull configure -borderwidth 0 147 148 set _interior $itk_interior 149 150 # 151 # Create the filter entry. 152 # 153 itk_component add filter { 154 iwidgets::Entryfield $itk_interior.filter -labelpos nw \ 155 -command [itcl::code $this _selectFilter] -exportselection 0 156 } { 157 usual 158 159 rename -labeltext -filterlabel filterLabel Text 160 } 161 162 # 163 # Create the directory list. 164 # 165 itk_component add dirs { 166 iwidgets::Scrolledlistbox $itk_interior.dirs \ 167 -selectioncommand [itcl::code $this _selectDir] \ 168 -selectmode single -exportselection 0 \ 169 -visibleitems 1x1 -labelpos nw \ 170 -hscrollmode static -vscrollmode static \ 171 -dblclickcommand [itcl::code $this _dblSelectDir] 172 } { 173 usual 174 175 rename -labeltext -dirslabel dirsLabel Text 176 } 177 178 # 179 # Create the files list. 180 # 181 itk_component add files { 182 iwidgets::Scrolledlistbox $itk_interior.files \ 183 -selectioncommand [itcl::code $this _selectFile] \ 184 -selectmode single -exportselection 0 \ 185 -visibleitems 1x1 -labelpos nw \ 186 -hscrollmode static -vscrollmode static 187 } { 188 usual 189 190 rename -labeltext -fileslabel filesLabel Text 191 } 192 193 # 194 # Create the selection entry. 195 # 196 itk_component add selection { 197 iwidgets::Entryfield $itk_interior.selection -labelpos nw \ 198 -command [itcl::code $this _selectSelection] -exportselection 0 199 } { 200 usual 201 202 rename -labeltext -selectionlabel selectionLabel Text 203 } 204 205 # 206 # Create the child site widget. 207 # 208 itk_component add -protected childsite { 209 frame $itk_interior.fsbchildsite 210 } 211 212 # 213 # Set the interior variable to the childsite for derived classes. 214 # 215 set itk_interior $itk_component(childsite) 216 217 # 218 # Explicitly handle configs that may have been ignored earlier. 219 # 220 eval itk_initialize $args 221 222 # 223 # When idle, pack the childsite and update the lists. 224 # 225 _packComponents 226 _updateLists 227} 228 229# ------------------------------------------------------------------ 230# DESTRUCTOR 231# ------------------------------------------------------------------ 232itcl::body iwidgets::Fileselectionbox::destructor {} { 233 if {$_packToken != ""} {after cancel $_packToken} 234 if {$_updateToken != ""} {after cancel $_updateToken} 235} 236 237# ------------------------------------------------------------------ 238# OPTIONS 239# ------------------------------------------------------------------ 240 241# ------------------------------------------------------------------ 242# OPTION: -childsitepos 243# 244# Specifies the position of the child site in the selection box. 245# ------------------------------------------------------------------ 246itcl::configbody iwidgets::Fileselectionbox::childsitepos { 247 _packComponents 248} 249 250# ------------------------------------------------------------------ 251# OPTION: -fileson 252# 253# Specifies whether or not to display the files list. 254# ------------------------------------------------------------------ 255itcl::configbody iwidgets::Fileselectionbox::fileson { 256 _packComponents 257} 258 259# ------------------------------------------------------------------ 260# OPTION: -dirson 261# 262# Specifies whether or not to display the dirs list. 263# ------------------------------------------------------------------ 264itcl::configbody iwidgets::Fileselectionbox::dirson { 265 _packComponents 266} 267 268# ------------------------------------------------------------------ 269# OPTION: -selectionon 270# 271# Specifies whether or not to display the selection entry widget. 272# ------------------------------------------------------------------ 273itcl::configbody iwidgets::Fileselectionbox::selectionon { 274 _packComponents 275} 276 277# ------------------------------------------------------------------ 278# OPTION: -filteron 279# 280# Specifies whether or not to display the filter entry widget. 281# ------------------------------------------------------------------ 282itcl::configbody iwidgets::Fileselectionbox::filteron { 283 _packComponents 284} 285 286# ------------------------------------------------------------------ 287# OPTION: -mask 288# 289# Specifies the initial file mask string. 290# ------------------------------------------------------------------ 291itcl::configbody iwidgets::Fileselectionbox::mask { 292 global tcl_platform 293 set prefix $_pwd 294 295 # 296 # Remove automounter paths. 297 # 298 if {$tcl_platform(platform) == "unix"} { 299 if {$itk_option(-automount) != {}} { 300 foreach autoDir $itk_option(-automount) { 301 # Use catch because we can't be sure exactly what strings 302 # were passed into the -automount option 303 catch { 304 if {[regsub ^/$autoDir $prefix {} prefix] != 0} { 305 break 306 } 307 } 308 } 309 } 310 } 311 312 set curFilter $itk_option(-mask); 313 $itk_component(filter) delete 0 end 314 $itk_component(filter) insert 0 [file join $_pwd $itk_option(-mask)] 315 316 # 317 # Make sure the right most text is visable. 318 # 319 $itk_component(filter) xview moveto 1 320} 321 322# ------------------------------------------------------------------ 323# OPTION: -directory 324# 325# Specifies the initial default directory. 326# ------------------------------------------------------------------ 327itcl::configbody iwidgets::Fileselectionbox::directory { 328 if {$itk_option(-directory) != {}} { 329 if {! [file exists $itk_option(-directory)]} { 330 error "bad directory option \"$itk_option(-directory)\":\ 331 directory does not exist" 332 } 333 334 set olddir [pwd] 335 cd $itk_option(-directory) 336 set _pwd [pwd] 337 cd $olddir 338 339 configure -mask $itk_option(-mask) 340 _selectFilter 341 } 342} 343 344# ------------------------------------------------------------------ 345# OPTION: -automount 346# 347# Specifies list of directory prefixes to ignore. Typically, this 348# option would be used with values such as: 349# -automount {export tmp_mnt} 350# ------------------------------------------------------------------ 351itcl::configbody iwidgets::Fileselectionbox::automount { 352} 353 354# ------------------------------------------------------------------ 355# OPTION: -nomatchstring 356# 357# Specifies the string to be displayed in the files list should 358# not regular files exist in the directory. 359# ------------------------------------------------------------------ 360itcl::configbody iwidgets::Fileselectionbox::nomatchstring { 361} 362 363# ------------------------------------------------------------------ 364# OPTION: -dirsearchcommand 365# 366# Specifies a command to be executed to perform a directory search. 367# The command will receive the current working directory and filter 368# mask as arguments. The command should return a list of files which 369# will be placed into the directory list. 370# ------------------------------------------------------------------ 371itcl::configbody iwidgets::Fileselectionbox::dirsearchcommand { 372} 373 374# ------------------------------------------------------------------ 375# OPTION: -filesearchcommand 376# 377# Specifies a command to be executed to perform a file search. 378# The command will receive the current working directory and filter 379# mask as arguments. The command should return a list of files which 380# will be placed into the file list. 381# ------------------------------------------------------------------ 382itcl::configbody iwidgets::Fileselectionbox::filesearchcommand { 383} 384 385# ------------------------------------------------------------------ 386# OPTION: -selectioncommand 387# 388# Specifies a command to be executed upon pressing return in the 389# selection entry widget. 390# ------------------------------------------------------------------ 391itcl::configbody iwidgets::Fileselectionbox::selectioncommand { 392} 393 394# ------------------------------------------------------------------ 395# OPTION: -filtercommand 396# 397# Specifies a command to be executed upon pressing return in the 398# filter entry widget. 399# ------------------------------------------------------------------ 400itcl::configbody iwidgets::Fileselectionbox::filtercommand { 401} 402 403# ------------------------------------------------------------------ 404# OPTION: -selectdircommand 405# 406# Specifies a command to be executed following selection of a 407# directory in the directory list. 408# ------------------------------------------------------------------ 409itcl::configbody iwidgets::Fileselectionbox::selectdircommand { 410} 411 412# ------------------------------------------------------------------ 413# OPTION: -selectfilecommand 414# 415# Specifies a command to be executed following selection of a 416# file in the files list. 417# ------------------------------------------------------------------ 418itcl::configbody iwidgets::Fileselectionbox::selectfilecommand { 419} 420 421# ------------------------------------------------------------------ 422# OPTION: -invalid 423# 424# Specify a command to executed should the filter contents be 425# proven invalid. 426# ------------------------------------------------------------------ 427itcl::configbody iwidgets::Fileselectionbox::invalid { 428} 429 430# ------------------------------------------------------------------ 431# OPTION: -filetype 432# 433# Specify the type of files which may appear in the file list. 434# ------------------------------------------------------------------ 435itcl::configbody iwidgets::Fileselectionbox::filetype { 436 switch $itk_option(-filetype) { 437 regular - 438 directory - 439 any { 440 } 441 default { 442 error "bad filetype option \"$itk_option(-filetype)\":\ 443 should be regular, directory, or any" 444 } 445 } 446 447 _updateLists 448} 449 450# ------------------------------------------------------------------ 451# OPTION: -width 452# 453# Specifies the width of the file selection box. The value may be 454# specified in any of the forms acceptable to Tk_GetPixels. 455# ------------------------------------------------------------------ 456itcl::configbody iwidgets::Fileselectionbox::width { 457 # 458 # The width option was added to the hull in the constructor. 459 # So, any width value given is passed automatically to the 460 # hull. All we have to do is play with the propagation. 461 # 462 if {$itk_option(-width) != 0} { 463 set propagate 0 464 } else { 465 set propagate 1 466 } 467 468 # 469 # Due to a bug in the tk4.2 grid, we have to check the 470 # propagation before setting it. Setting it to the same 471 # value it already is will cause it to toggle. 472 # 473 if {[grid propagate $itk_component(hull)] != $propagate} { 474 grid propagate $itk_component(hull) $propagate 475 } 476} 477 478# ------------------------------------------------------------------ 479# OPTION: -height 480# 481# Specifies the height of the file selection box. The value may be 482# specified in any of the forms acceptable to Tk_GetPixels. 483# ------------------------------------------------------------------ 484itcl::configbody iwidgets::Fileselectionbox::height { 485 # 486 # The height option was added to the hull in the constructor. 487 # So, any height value given is passed automatically to the 488 # hull. All we have to do is play with the propagation. 489 # 490 if {$itk_option(-height) != 0} { 491 set propagate 0 492 } else { 493 set propagate 1 494 } 495 496 # 497 # Due to a bug in the tk4.2 grid, we have to check the 498 # propagation before setting it. Setting it to the same 499 # value it already is will cause it to toggle. 500 # 501 if {[grid propagate $itk_component(hull)] != $propagate} { 502 grid propagate $itk_component(hull) $propagate 503 } 504} 505 506# ------------------------------------------------------------------ 507# METHODS 508# ------------------------------------------------------------------ 509 510# ------------------------------------------------------------------ 511# METHOD: childsite 512# 513# Returns the path name of the child site widget. 514# ------------------------------------------------------------------ 515itcl::body iwidgets::Fileselectionbox::childsite {} { 516 return $itk_component(childsite) 517} 518 519# ------------------------------------------------------------------ 520# METHOD: get 521# 522# Returns the current selection. 523# ------------------------------------------------------------------ 524itcl::body iwidgets::Fileselectionbox::get {} { 525 return [$itk_component(selection) get] 526} 527 528# ------------------------------------------------------------------ 529# METHOD: filter 530# 531# The user has pressed Return in the filter. Make sure the contents 532# contain a valid directory before setting default to directory. 533# Use the invalid option to warn the user of any problems. 534# ------------------------------------------------------------------ 535itcl::body iwidgets::Fileselectionbox::filter {} { 536 set newdir [file dirname [$itk_component(filter) get]] 537 538 if {! [file exists $newdir]} { 539 uplevel #0 "$itk_option(-invalid)" 540 return 541 } 542 543 set _pwd $newdir; 544 if {$_pwd == "."} {set _pwd [pwd]}; 545 546 _updateLists 547} 548 549# ------------------------------------------------------------------ 550# PRIVATE METHOD: _updateLists ?now? 551# 552# Updates the contents of both the file and directory lists, as well 553# resets the positions of the filter, and lists. 554# ------------------------------------------------------------------ 555itcl::body iwidgets::Fileselectionbox::_updateLists {{when "later"}} { 556 switch -- $when { 557 later { 558 if {$_updateToken == ""} { 559 set _updateToken [after idle [itcl::code $this _updateLists now]] 560 } 561 } 562 now { 563 if {$itk_option(-dirson)} {_setDirList} 564 if {$itk_option(-fileson)} {_setFileList} 565 566 if {$itk_option(-filteron)} { 567 _setFilter 568 } 569 if {$itk_option(-selectionon)} { 570 $itk_component(selection) icursor end 571 } 572 if {$itk_option(-dirson)} { 573 $itk_component(dirs) justify left 574 } 575 if {$itk_option(-fileson)} { 576 $itk_component(files) justify left 577 } 578 set _updateToken "" 579 } 580 default { 581 error "bad option \"$when\": should be later or now" 582 } 583 } 584} 585 586# ------------------------------------------------------------------ 587# PRIVATE METHOD: _setFilter 588# 589# Set the filter to the current selection in the directory list plus 590# any existing mask in the filter. Translate the two special cases 591# of '.', and '..' directory names to full path names.. 592# ------------------------------------------------------------------ 593itcl::body iwidgets::Fileselectionbox::_setFilter {} { 594 global tcl_platform 595 set prefix [$itk_component(dirs) getcurselection] 596 set curFilter [file tail [$itk_component(filter) get]] 597 598 while {[regexp {\.$} $prefix]} { 599 if {[file tail $prefix] == "."} { 600 if {$prefix == "."} { 601 if {$_pwd == "."} { 602 set _pwd [pwd] 603 } elseif {$_pwd == ".."} { 604 set _pwd [file dirname [pwd]] 605 } 606 set prefix $_pwd 607 } else { 608 set prefix [file dirname $prefix] 609 } 610 } elseif {[file tail $prefix] == ".."} { 611 if {$prefix != ".."} { 612 set prefix [file dirname [file dirname $prefix]] 613 } else { 614 if {$_pwd == "."} { 615 set _pwd [pwd] 616 } elseif {$_pwd == ".."} { 617 set _pwd [file dirname [pwd]] 618 } 619 set prefix [file dirname $_pwd] 620 } 621 } else { 622 break 623 } 624 } 625 626 if { [file pathtype $prefix] != "absolute" } { 627 set prefix [file join $_pwd $prefix] 628 } 629 630 # 631 # Remove automounter paths. 632 # 633 if {$tcl_platform(platform) == "unix"} { 634 if {$itk_option(-automount) != {}} { 635 foreach autoDir $itk_option(-automount) { 636 # Use catch because we can't be sure exactly what strings 637 # were passed into the -automount option 638 catch { 639 if {[regsub ^/$autoDir $prefix {} prefix] != 0} { 640 break 641 } 642 } 643 } 644 } 645 } 646 647 $itk_component(filter) delete 0 end 648 $itk_component(filter) insert 0 [file join $prefix $curFilter] 649 650 # 651 # Make sure insertion cursor is at the end. 652 # 653 $itk_component(filter) icursor end 654 655 # 656 # Make sure the right most text is visable. 657 # 658 $itk_component(filter) xview moveto 1 659} 660 661# ------------------------------------------------------------------ 662# PRIVATE METHOD: _setSelection 663# 664# Set the contents of the selection entry to either the current 665# selection of the file or directory list dependent on which lists 666# are currently mapped. For the file list, avoid seleciton of the 667# no match string. As for the directory list, translate file names. 668# ------------------------------------------------------------------ 669itcl::body iwidgets::Fileselectionbox::_setSelection {} { 670 global tcl_platform 671 $itk_component(selection) delete 0 end 672 673 if {$itk_option(-fileson)} { 674 set selection [$itk_component(files) getcurselection] 675 676 if {$selection != $itk_option(-nomatchstring)} { 677 if {[file pathtype $selection] != "absolute"} { 678 set selection [file join $_pwd $selection] 679 } 680 681 # 682 # Remove automounter paths. 683 # 684 if {$tcl_platform(platform) == "unix"} { 685 if {$itk_option(-automount) != {}} { 686 foreach autoDir $itk_option(-automount) { 687 # Use catch because we can't be sure exactly what strings 688 # were passed into the -automount option 689 catch { 690 if {[regsub ^/$autoDir $selection {} selection] != 0} { 691 break 692 } 693 } 694 } 695 } 696 } 697 698 $itk_component(selection) insert 0 $selection 699 } else { 700 $itk_component(files) selection clear 0 end 701 } 702 703 } else { 704 set selection [$itk_component(dirs) getcurselection] 705 706 if {[file tail $selection] == "."} { 707 if {$selection != "."} { 708 set selection [file dirname $selection] 709 } else { 710 set selection $_pwd 711 } 712 } elseif {[file tail $selection] == ".."} { 713 if {$selection != ".."} { 714 set selection [file dirname [file dirname $selection]] 715 } else { 716 set selection [file join $_pwd ..] 717 } 718 } else { 719 set selection [file join $_pwd $selection] 720 } 721 722 # 723 # Remove automounter paths. 724 # 725 if {$tcl_platform(platform) == "unix"} { 726 if {$itk_option(-automount) != {}} { 727 foreach autoDir $itk_option(-automount) { 728 # Use catch because we can't be sure exactly what strings 729 # were passed into the -automount option 730 catch { 731 if {[regsub ^/$autoDir $selection {} selection] != 0} { 732 break 733 } 734 } 735 } 736 } 737 } 738 739 $itk_component(selection) delete 0 end 740 $itk_component(selection) insert 0 $selection 741 } 742 743 $itk_component(selection) icursor end 744 745 # 746 # Make sure the right most text is visable. 747 # 748 $itk_component(selection) xview moveto 1 749} 750 751# ------------------------------------------------------------------ 752# PRIVATE METHOD: _setDirList 753# 754# Clear the directory list and dependent on whether the user has 755# defined their own search procedure or not fill the list with their 756# results or those of a glob. Select the first element if it exists. 757# ------------------------------------------------------------------ 758itcl::body iwidgets::Fileselectionbox::_setDirList {} { 759 $itk_component(dirs) clear 760 761 if {$itk_option(-dirsearchcommand) == {}} { 762 foreach i [lsort [glob -nocomplain \ 763 [file join $_pwd .*] [file join $_pwd *]]] { 764 if {[file isdirectory $i]} { 765 $itk_component(dirs) insert end [file tail "$i"] 766 } 767 } 768 769 } else { 770 set mask [file tail [$itk_component(filter) get]] 771 772 foreach file [uplevel #0 $itk_option(-dirsearchcommand) $_pwd $mask] { 773 $itk_component(dirs) insert end $file 774 } 775 } 776 777 if {[$itk_component(dirs) size]} { 778 $itk_component(dirs) selection clear 0 end 779 $itk_component(dirs) selection set 0 780 } 781} 782 783# ------------------------------------------------------------------ 784# PRIVATE METHOD: _setFileList 785# 786# Clear the file list and dependent on whether the user has defined 787# their own search procedure or not fill the list with their results 788# or those of a 'glob'. If the files list has no contents, then set 789# the files list to the 'nomatchstring'. Clear all selections. 790# ------------------------------------------------------------------ 791itcl::body iwidgets::Fileselectionbox::_setFileList {} { 792 $itk_component(files) clear 793 set mask [file tail [$itk_component(filter) get]] 794 795 if {$itk_option(-filesearchcommand) == {}} { 796 if {$mask == "*"} { 797 set files [lsort [glob -nocomplain \ 798 [file join $_pwd .*] [file join $_pwd *]]] 799 } else { 800 set files [lsort [glob -nocomplain [file join $_pwd $mask]]] 801 } 802 803 foreach i $files { 804 if {($itk_option(-filetype) == "regular" && \ 805 ! [file isdirectory $i]) || \ 806 ($itk_option(-filetype) == "directory" && \ 807 [file isdirectory $i]) || \ 808 ($itk_option(-filetype) == "any")} { 809 $itk_component(files) insert end [file tail "$i"] 810 } 811 } 812 813 } else { 814 foreach file [uplevel #0 $itk_option(-filesearchcommand) $_pwd $mask] { 815 $itk_component(files) insert end $file 816 } 817 } 818 819 if {[$itk_component(files) size] == 0} { 820 if {$itk_option(-nomatchstring) != {}} { 821 $itk_component(files) insert end $itk_option(-nomatchstring) 822 } 823 } 824 825 $itk_component(files) selection clear 0 end 826} 827 828# ------------------------------------------------------------------ 829# PRIVATE METHOD: _selectDir 830# 831# For a selection in the directory list, set the filter and possibly 832# the selection entry based on the fileson option. 833# ------------------------------------------------------------------ 834itcl::body iwidgets::Fileselectionbox::_selectDir {} { 835 _setFilter 836 837 if {$itk_option(-fileson)} {} { 838 _setSelection 839 } 840 841 if {$itk_option(-selectdircommand) != {}} { 842 uplevel #0 $itk_option(-selectdircommand) 843 } 844} 845 846# ------------------------------------------------------------------ 847# PRIVATE METHOD: _dblSelectDir 848# 849# For a double click event in the directory list, select the 850# directory, set the default to the selection, and update both the 851# file and directory lists. 852# ------------------------------------------------------------------ 853itcl::body iwidgets::Fileselectionbox::_dblSelectDir {} { 854 filter 855} 856 857# ------------------------------------------------------------------ 858# PRIVATE METHOD: _selectFile 859# 860# The user has selected a file. Put the current selection in the 861# file list in the selection entry widget. 862# ------------------------------------------------------------------ 863itcl::body iwidgets::Fileselectionbox::_selectFile {} { 864 _setSelection 865 866 if {$itk_option(-selectfilecommand) != {}} { 867 uplevel #0 $itk_option(-selectfilecommand) 868 } 869} 870 871# ------------------------------------------------------------------ 872# PRIVATE METHOD: _selectSelection 873# 874# The user has pressed Return in the selection entry widget. Call 875# the defined selection command if it exists. 876# ------------------------------------------------------------------ 877itcl::body iwidgets::Fileselectionbox::_selectSelection {} { 878 if {$itk_option(-selectioncommand) != {}} { 879 uplevel #0 $itk_option(-selectioncommand) 880 } 881} 882 883# ------------------------------------------------------------------ 884# PRIVATE METHOD: _selectFilter 885# 886# The user has pressed Return in the filter entry widget. Call the 887# defined selection command if it exists, otherwise just filter. 888# ------------------------------------------------------------------ 889itcl::body iwidgets::Fileselectionbox::_selectFilter {} { 890 if {$itk_option(-filtercommand) != {}} { 891 uplevel #0 $itk_option(-filtercommand) 892 } else { 893 filter 894 } 895} 896 897# ------------------------------------------------------------------ 898# PRIVATE METHOD: _packComponents 899# 900# Pack the selection, items, and child site widgets based on options. 901# Using the -in option of pack, put the childsite around the frame 902# in the hull for n, s, e, and w positions. Make sure and raise 903# the child site since using the 'in' option may obscure the site. 904# ------------------------------------------------------------------ 905itcl::body iwidgets::Fileselectionbox::_packComponents {{when "later"}} { 906 if {$when == "later"} { 907 if {$_packToken == ""} { 908 set _packToken [after idle [itcl::code $this _packComponents now]] 909 } 910 return 911 } elseif {$when != "now"} { 912 error "bad option \"$when\": should be now or later" 913 } 914 915 set _packToken "" 916 917 # 918 # Forget about any previous placements via the grid and 919 # reset all the possible minsizes and weights for all 920 # the rows and columns. 921 # 922 foreach component {childsite filter dirs files selection} { 923 grid forget $itk_component($component) 924 } 925 926 for {set row 0} {$row < 6} {incr row} { 927 grid rowconfigure $_interior $row -minsize 0 -weight 0 928 } 929 930 for {set col 0} {$col < 4} {incr col} { 931 grid columnconfigure $_interior $col -minsize 0 -weight 0 932 } 933 934 # 935 # Place all the components based on the childsite poisition 936 # option. 937 # 938 switch $itk_option(-childsitepos) { 939 n { _nPos } 940 941 w { _wPos } 942 943 s { _sPos } 944 945 e { _ePos } 946 947 center { _centerPos } 948 949 top { _topPos } 950 951 bottom { _bottomPos } 952 953 default { 954 error "bad childsitepos option \"$itk_option(-childsitepos)\":\ 955 should be n, e, s, w, center, top, or bottom" 956 } 957 } 958} 959 960# ------------------------------------------------------------------ 961# PRIVATE METHOD: _nPos 962# 963# Position the childsite to the north and all the other components 964# appropriately based on the individual "on" options. 965# ------------------------------------------------------------------ 966itcl::body iwidgets::Fileselectionbox::_nPos {} { 967 grid $itk_component(childsite) -row 0 -column 0 \ 968 -columnspan 3 -rowspan 1 -sticky nsew 969 970 if {$itk_option(-filteron)} { 971 grid $itk_component(filter) -row 1 -column 0 \ 972 -columnspan 3 -sticky ew 973 grid rowconfigure $_interior 2 -minsize 7 974 } 975 976 if {$itk_option(-dirson)} { 977 grid $itk_component(dirs) -row 3 -column 0 \ 978 -columnspan 1 -sticky nsew 979 } 980 if {$itk_option(-fileson)} { 981 grid $itk_component(files) -row 3 -column 2 \ 982 -columnspan 1 -sticky nsew 983 } 984 if {$itk_option(-dirson)} { 985 if {$itk_option(-fileson)} { 986 grid columnconfigure $_interior 1 -minsize 7 987 } else { 988 grid configure $itk_component(dirs) -columnspan 3 -column 0 989 } 990 } else { 991 if {$itk_option(-fileson)} { 992 grid configure $itk_component(files) -columnspan 3 -column 0 993 } 994 } 995 996 grid rowconfigure $_interior 3 -weight 1 997 998 if {$itk_option(-selectionon)} { 999 grid rowconfigure $_interior 4 -minsize 7 1000 grid $itk_component(selection) -row 5 -column 0 \ 1001 -columnspan 3 -sticky ew 1002 } 1003 1004 grid columnconfigure $_interior 0 -weight 1 1005 grid columnconfigure $_interior 2 -weight 1 1006} 1007 1008# ------------------------------------------------------------------ 1009# PRIVATE METHOD: _sPos 1010# 1011# Position the childsite to the south and all the other components 1012# appropriately based on the individual "on" options. 1013# ------------------------------------------------------------------ 1014itcl::body iwidgets::Fileselectionbox::_sPos {} { 1015 if {$itk_option(-filteron)} { 1016 grid $itk_component(filter) -row 0 -column 0 \ 1017 -columnspan 3 -sticky ew 1018 grid rowconfigure $_interior 1 -minsize 7 1019 } 1020 1021 if {$itk_option(-dirson)} { 1022 grid $itk_component(dirs) -row 2 -column 0 \ 1023 -columnspan 1 -sticky nsew 1024 } 1025 if {$itk_option(-fileson)} { 1026 grid $itk_component(files) -row 2 -column 2 \ 1027 -columnspan 1 -sticky nsew 1028 } 1029 if {$itk_option(-dirson)} { 1030 if {$itk_option(-fileson)} { 1031 grid columnconfigure $_interior 1 -minsize 7 1032 } else { 1033 grid configure $itk_component(dirs) -columnspan 3 -column 0 1034 } 1035 } else { 1036 if {$itk_option(-fileson)} { 1037 grid configure $itk_component(files) -columnspan 3 -column 0 1038 } 1039 } 1040 1041 grid rowconfigure $_interior 2 -weight 1 1042 1043 if {$itk_option(-selectionon)} { 1044 grid rowconfigure $_interior 3 -minsize 7 1045 grid $itk_component(selection) -row 4 -column 0 \ 1046 -columnspan 3 -sticky ew 1047 } 1048 1049 grid $itk_component(childsite) -row 5 -column 0 \ 1050 -columnspan 3 -rowspan 1 -sticky nsew 1051 grid columnconfigure $_interior 0 -weight 1 1052 grid columnconfigure $_interior 2 -weight 1 1053} 1054 1055# ------------------------------------------------------------------ 1056# PRIVATE METHOD: _ePos 1057# 1058# Position the childsite to the east and all the other components 1059# appropriately based on the individual "on" options. 1060# ------------------------------------------------------------------ 1061itcl::body iwidgets::Fileselectionbox::_ePos {} { 1062 if {$itk_option(-filteron)} { 1063 grid $itk_component(filter) -row 0 -column 0 \ 1064 -columnspan 3 -sticky ew 1065 grid rowconfigure $_interior 1 -minsize 7 1066 } 1067 1068 if {$itk_option(-dirson)} { 1069 grid $itk_component(dirs) -row 2 -column 0 \ 1070 -columnspan 1 -sticky nsew 1071 } 1072 if {$itk_option(-fileson)} { 1073 grid $itk_component(files) -row 2 -column 2 \ 1074 -columnspan 1 -sticky nsew 1075 } 1076 if {$itk_option(-dirson)} { 1077 if {$itk_option(-fileson)} { 1078 grid columnconfigure $_interior 1 -minsize 7 1079 } else { 1080 grid configure $itk_component(dirs) -columnspan 3 -column 0 1081 } 1082 } else { 1083 if {$itk_option(-fileson)} { 1084 grid configure $itk_component(files) -columnspan 3 -column 0 1085 } 1086 } 1087 1088 grid rowconfigure $_interior 2 -weight 1 1089 1090 if {$itk_option(-selectionon)} { 1091 grid rowconfigure $_interior 3 -minsize 7 1092 grid $itk_component(selection) -row 4 -column 0 \ 1093 -columnspan 3 -sticky ew 1094 } 1095 1096 grid $itk_component(childsite) -row 0 -column 3 \ 1097 -rowspan 5 -columnspan 1 -sticky nsew 1098 grid columnconfigure $_interior 0 -weight 1 1099 grid columnconfigure $_interior 2 -weight 1 1100} 1101 1102# ------------------------------------------------------------------ 1103# PRIVATE METHOD: _wPos 1104# 1105# Position the childsite to the west and all the other components 1106# appropriately based on the individual "on" options. 1107# ------------------------------------------------------------------ 1108itcl::body iwidgets::Fileselectionbox::_wPos {} { 1109 grid $itk_component(childsite) -row 0 -column 0 \ 1110 -rowspan 5 -columnspan 1 -sticky nsew 1111 1112 if {$itk_option(-filteron)} { 1113 grid $itk_component(filter) -row 0 -column 1 \ 1114 -columnspan 3 -sticky ew 1115 grid rowconfigure $_interior 1 -minsize 7 1116 } 1117 1118 if {$itk_option(-dirson)} { 1119 grid $itk_component(dirs) -row 2 -column 1 \ 1120 -columnspan 1 -sticky nsew 1121 } 1122 if {$itk_option(-fileson)} { 1123 grid $itk_component(files) -row 2 -column 3 \ 1124 -columnspan 1 -sticky nsew 1125 } 1126 if {$itk_option(-dirson)} { 1127 if {$itk_option(-fileson)} { 1128 grid columnconfigure $_interior 2 -minsize 7 1129 } else { 1130 grid configure $itk_component(dirs) -columnspan 3 -column 1 1131 } 1132 } else { 1133 if {$itk_option(-fileson)} { 1134 grid configure $itk_component(files) -columnspan 3 -column 1 1135 } 1136 } 1137 1138 grid rowconfigure $_interior 2 -weight 1 1139 1140 if {$itk_option(-selectionon)} { 1141 grid rowconfigure $_interior 3 -minsize 7 1142 grid $itk_component(selection) -row 4 -column 1 \ 1143 -columnspan 3 -sticky ew 1144 } 1145 1146 grid columnconfigure $_interior 1 -weight 1 1147 grid columnconfigure $_interior 3 -weight 1 1148} 1149 1150# ------------------------------------------------------------------ 1151# PRIVATE METHOD: _topPos 1152# 1153# Position the childsite below the filter but above the lists and 1154# all the other components appropriately based on the individual 1155# "on" options. 1156# ------------------------------------------------------------------ 1157itcl::body iwidgets::Fileselectionbox::_topPos {} { 1158 if {$itk_option(-filteron)} { 1159 grid $itk_component(filter) -row 0 -column 0 \ 1160 -columnspan 3 -sticky ew 1161 } 1162 1163 grid $itk_component(childsite) -row 1 -column 0 \ 1164 -columnspan 3 -rowspan 1 -sticky nsew 1165 1166 if {$itk_option(-dirson)} { 1167 grid $itk_component(dirs) -row 2 -column 0 -sticky nsew 1168 } 1169 if {$itk_option(-fileson)} { 1170 grid $itk_component(files) -row 2 -column 2 -sticky nsew 1171 } 1172 if {$itk_option(-dirson)} { 1173 if {$itk_option(-fileson)} { 1174 grid columnconfigure $_interior 1 -minsize 7 1175 } else { 1176 grid configure $itk_component(dirs) -columnspan 3 -column 0 1177 } 1178 } else { 1179 if {$itk_option(-fileson)} { 1180 grid configure $itk_component(files) -columnspan 3 -column 0 1181 } 1182 } 1183 1184 grid rowconfigure $_interior 2 -weight 1 1185 1186 if {$itk_option(-selectionon)} { 1187 grid rowconfigure $_interior 3 -minsize 7 1188 grid $itk_component(selection) -row 4 -column 0 \ 1189 -columnspan 3 -sticky ew 1190 } 1191 1192 grid columnconfigure $_interior 0 -weight 1 1193 grid columnconfigure $_interior 2 -weight 1 1194} 1195 1196# ------------------------------------------------------------------ 1197# PRIVATE METHOD: _centerPos 1198# 1199# Position the childsite between the lists and all the other 1200# components appropriately based on the individual "on" options. 1201# ------------------------------------------------------------------ 1202itcl::body iwidgets::Fileselectionbox::_centerPos {} { 1203 if {$itk_option(-filteron)} { 1204 grid $itk_component(filter) -row 0 -column 0 \ 1205 -columnspan 3 -sticky ew 1206 grid rowconfigure $_interior 1 -minsize 7 1207 } 1208 1209 if {$itk_option(-dirson)} { 1210 grid $itk_component(dirs) -row 2 -column 0 \ 1211 -columnspan 1 -sticky nsew 1212 } 1213 if {$itk_option(-fileson)} { 1214 grid $itk_component(files) -row 2 -column 2 \ 1215 -columnspan 1 -sticky nsew 1216 } 1217 grid $itk_component(childsite) -row 2 \ 1218 -columnspan 1 -rowspan 1 -sticky nsew 1219 1220 if {$itk_option(-dirson)} { 1221 if {$itk_option(-fileson)} { 1222 grid configure $itk_component(childsite) -column 1 1223 grid columnconfigure $_interior 0 -weight 1 1224 grid columnconfigure $_interior 2 -weight 1 1225 1226 } else { 1227 grid configure $itk_component(dirs) -columnspan 2 -column 0 1228 grid configure $itk_component(childsite) -column 2 1229 grid columnconfigure $_interior 0 -weight 1 1230 grid columnconfigure $_interior 1 -weight 1 1231 } 1232 } else { 1233 grid configure $itk_component(childsite) -column 0 1234 if {$itk_option(-fileson)} { 1235 grid configure $itk_component(files) -columnspan 2 \ 1236 -column 1 1237 grid columnconfigure $_interior 1 -weight 1 1238 grid columnconfigure $_interior 2 -weight 1 1239 } else { 1240 grid columnconfigure $_interior 0 -weight 1 1241 } 1242 } 1243 1244 grid rowconfigure $_interior 2 -weight 1 1245 1246 if {$itk_option(-selectionon)} { 1247 grid rowconfigure $_interior 3 -minsize 7 1248 grid $itk_component(selection) -row 4 -column 0 \ 1249 -columnspan 3 -sticky ew 1250 } 1251} 1252 1253# ------------------------------------------------------------------ 1254# PRIVATE METHOD: _bottomPos 1255# 1256# Position the childsite below the lists and above the selection 1257# and all the other components appropriately based on the individual 1258# "on" options. 1259# ------------------------------------------------------------------ 1260itcl::body iwidgets::Fileselectionbox::_bottomPos {} { 1261 if {$itk_option(-filteron)} { 1262 grid $itk_component(filter) -row 0 -column 0 \ 1263 -columnspan 3 -sticky ew 1264 grid rowconfigure $_interior 1 -minsize 7 1265 } 1266 1267 if {$itk_option(-dirson)} { 1268 grid $itk_component(dirs) -row 2 -column 0 -sticky nsew 1269 } 1270 if {$itk_option(-fileson)} { 1271 grid $itk_component(files) -row 2 -column 2 -sticky nsew 1272 } 1273 if {$itk_option(-dirson)} { 1274 if {$itk_option(-fileson)} { 1275 grid columnconfigure $_interior 1 -minsize 7 1276 } else { 1277 grid configure $itk_component(dirs) -columnspan 3 -column 0 1278 } 1279 } else { 1280 if {$itk_option(-fileson)} { 1281 grid configure $itk_component(files) -columnspan 3 -column 0 1282 } 1283 } 1284 grid rowconfigure $_interior 2 -weight 1 1285 1286 grid $itk_component(childsite) -row 3 -column 0 \ 1287 -columnspan 3 -rowspan 1 -sticky nsew 1288 1289 if {$itk_option(-selectionon)} { 1290 grid $itk_component(selection) -row 4 -column 0 \ 1291 -columnspan 3 -sticky ew 1292 } 1293 1294 grid columnconfigure $_interior 0 -weight 1 1295 grid columnconfigure $_interior 2 -weight 1 1296} 1297