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