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