itcl/iwidgets3.0.0/generic/extfileselectionbox.itk

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