home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_Tix.idb / usr / freeware / lib / tix4.1 / FileBox.tcl.z / FileBox.tcl
Encoding:
Text File  |  1999-01-26  |  14.2 KB  |  580 lines
  1. # FileBox.tcl --
  2. #
  3. #    Implements the File Selection Box widget.
  4. #
  5. # Copyright (c) 1996, Expert Interface Technologies
  6. #
  7. # See the file "license.terms" for information on usage and redistribution
  8. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  9. #
  10.  
  11.  
  12. # ToDo
  13. #   (1)    If user has entered an invalid directory, give an error dialog
  14. #
  15.  
  16. tixWidgetClass tixFileSelectBox {
  17.     -superclass tixPrimitive
  18.     -classname  TixFileSelectBox
  19.     -method {
  20.     filter invoke
  21.     }
  22.     -flag {
  23.     -browsecmd -command -dir -directory -disablecallback
  24.     -grab -pattern -selection -value
  25.     }
  26.     -configspec {
  27.     {-browsecmd browseCmd BrowseCmd ""}
  28.     {-command command Command ""}
  29.     {-directory directory Directory ""}
  30.     {-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
  31.     {-grab grab Grab global}
  32.     {-pattern pattern Pattern *}
  33.     {-value value Value ""}
  34.     }
  35.     -alias {
  36.     {-selection -value}
  37.     {-dir -directory}
  38.     }
  39.     -forcecall {
  40.     -value
  41.     }
  42.     -default {
  43.     {.relief            raised}
  44.     {*filelist*Listbox.takeFocus    true}
  45.     {.borderWidth             1}
  46.     {*Label.anchor            w}
  47.     {*Label.borderWidth        0}
  48.     {*Label.font                   -Adobe-Helvetica-Bold-R-Normal--*-120-*}
  49.     {*TixComboBox*scrollbar        auto}
  50.     {*TixComboBox*Label.anchor    w}
  51.     {*TixScrolledListBox.scrollbar    auto}
  52.     {*Listbox.exportSelection    false}
  53.     {*directory*Label.text      "Directories:"}
  54.     {*directory*Label.underline    0}
  55.     {*file*Label.text        "Files:"}
  56.     {*file*Label.underline        2}
  57.     {*filter.label            "Filter:"}
  58.     {*filter*label.underline    3}
  59.     {*filter.labelSide        top}
  60.     {*selection.label        "Selection:"}
  61.     {*selection*label.underline    0}
  62.     {*selection.labelSide        top}
  63.     }
  64. }
  65.  
  66.  
  67. proc tixFileSelectBox:InitWidgetRec {w} {
  68.     upvar #0 $w data
  69.     global env
  70.  
  71.     tixChainMethod $w InitWidgetRec
  72.  
  73.     if {$data(-directory) == ""} {
  74.     set data(-directory) [pwd]
  75.     }
  76.     if {$data(-pattern) == ""} {
  77.     set data(-pattern) [tixFilePattern allFiles]
  78.     }
  79.  
  80.     tixFileSelectBox:SetPat $w [tixFileIntName $data(-pattern)]
  81.     tixFileSelectBox:SetDir $w [tixFileIntName $data(-directory)]
  82.  
  83.     set data(flag)      0
  84.     set data(fakeDir)   0
  85. }
  86.  
  87. #----------------------------------------------------------------------
  88. #        Construct widget
  89. #----------------------------------------------------------------------
  90. proc tixFileSelectBox:ConstructWidget {w} {
  91.     upvar #0 $w data
  92.  
  93.     tixChainMethod $w ConstructWidget
  94.  
  95.     set frame1 [tixFileSelectBox:CreateFrame1 $w]
  96.     set frame2 [tixFileSelectBox:CreateFrame2 $w]
  97.     set frame3 [tixFileSelectBox:CreateFrame3 $w]
  98.  
  99.     pack $frame1 -in $w -side top -fill x
  100.     pack $frame3 -in $w -side bottom -fill x
  101.     pack $frame2 -in $w -side top -fill both -expand yes
  102. }
  103.  
  104. proc tixFileSelectBox:CreateFrame1 {w} {
  105.     upvar #0 $w data
  106.  
  107.     frame $w.f1 -border 10
  108.     tixComboBox $w.f1.filter -editable 1\
  109.     -command "$w filter" -anchor e \
  110.     -options {
  111.         slistbox.scrollbar auto
  112.         listbox.height 5
  113.         label.anchor w
  114.     }
  115.     set data(w:filter) $w.f1.filter
  116.  
  117.     pack $data(w:filter) -side top -expand yes -fill both
  118.     return $w.f1
  119. }
  120.  
  121. proc tixFileSelectBox:CreateFrame2 {w} {
  122.     upvar #0 $w data
  123.  
  124.     tixPanedWindow $w.f2 -orientation horizontal
  125.     #     THE LEFT FRAME
  126.     #-----------------------
  127.     set dir [$w.f2 add directory -size 120]
  128.     $dir config -relief flat
  129.     label $dir.lab
  130.     set data(w:dirlist) [tixScrolledListBox $dir.dirlist\
  131.                -scrollbar auto\
  132.                -options {listbox.width 4 listbox.height 6}]
  133.  
  134.     pack $dir.lab -side top -fill x -padx 10
  135.     pack $data(w:dirlist) -side bottom -expand yes -fill both -padx 10
  136.  
  137.     #     THE RIGHT FRAME
  138.     #-----------------------
  139.     set file [$w.f2 add file -size 160]
  140.     $file config -relief flat
  141.     label $file.lab
  142.     set data(w:filelist) [tixScrolledListBox $file.filelist \
  143.                -scrollbar auto\
  144.                -options {listbox.width 4 listbox.height 6}]
  145.  
  146.     pack $file.lab -side top -fill x -padx 10
  147.     pack $data(w:filelist) -side bottom -expand yes -fill both -padx 10
  148.  
  149.     return $w.f2
  150. }
  151.  
  152. proc tixFileSelectBox:CreateFrame3 {w} {
  153.     upvar #0 $w data
  154.  
  155.     frame $w.f3 -border 10
  156.     tixComboBox $w.f3.selection -editable 1\
  157.     -command "tixFileSelectBox:SelInvoke $w" \
  158.     -anchor e \
  159.     -options {
  160.         slistbox.scrollbar auto
  161.         listbox.height 5
  162.         label.anchor w
  163.     }
  164.  
  165.     set data(w:selection) $w.f3.selection
  166.  
  167.     pack $data(w:selection) -side top -fill both
  168.  
  169.     return $w.f3
  170. }
  171.  
  172. proc tixFileSelectBox:SelInvoke {w args} {
  173.     upvar #0 $w data
  174.  
  175.     set event [tixEvent type]
  176.  
  177.     if {$event != "<FocusOut>" && $event != "<Tab>"} {
  178.     $w invoke
  179.     }
  180. }
  181.  
  182. proc tixFileSelectBox:SetValue {w value} {
  183.     upvar #0 $w data
  184.  
  185.     set data(i-value) $value
  186.     set data(-value)  [tixNativeName $value 0]
  187. }
  188.  
  189. proc tixFileSelectBox:SetDir {w value} {
  190.     upvar #0 $w data
  191.  
  192.     set data(i-directory) $value
  193.     set data(-directory)  [tixNativeName $value]
  194. }
  195.  
  196. proc tixFileSelectBox:SetPat {w value} {
  197.     upvar #0 $w data
  198.  
  199.     set data(i-pattern) $value
  200.     set data(-pattern)  [tixNativeName $value 0]
  201. }
  202.  
  203.  
  204. #----------------------------------------------------------------------
  205. #                           BINDINGS
  206. #----------------------------------------------------------------------
  207.  
  208. proc tixFileSelectBox:SetBindings {w} {
  209.     upvar #0 $w data
  210.  
  211.     tixChainMethod $w SetBindings
  212.  
  213.     tixDoWhenMapped $w "tixFileSelectBox:FirstMapped $w"
  214.  
  215.     $data(w:dirlist) config \
  216.     -browsecmd "tixFileSelectBox:SelectDir $w" \
  217.     -command   "tixFileSelectBox:InvokeDir $w"
  218.  
  219.     $data(w:filelist) config \
  220.     -browsecmd "tixFileSelectBox:SelectFile $w" \
  221.     -command   "tixFileSelectBox:InvokeFile $w"
  222. }
  223.  
  224. #----------------------------------------------------------------------
  225. #                           CONFIG OPTIONS
  226. #----------------------------------------------------------------------
  227. proc tixFileSelectBox:config-directory {w value} {
  228.     upvar #0 $w data
  229.  
  230.     if {$value == ""} {
  231.     set value [pwd]
  232.     }
  233.     tixFileSelectBox:SetDir $w [tixFileIntName $value]
  234.     tixFileSelectBox:SetFilter $w $data(i-directory) $data(i-pattern)
  235.     $w filter
  236.  
  237.     return $data(-directory)
  238. }
  239.  
  240. proc tixFileSelectBox:config-pattern {w value} {
  241.     upvar #0 $w data
  242.  
  243.     if {$value == ""} {
  244.     set value [tixFilePattern allFiles]
  245.     }
  246.  
  247.     tixFileSelectBox:SetPat $w [tixFileIntName $value]
  248.     tixFileSelectBox:SetFilter $w $data(i-directory) $data(i-pattern)
  249.  
  250.     # Returning a value means we have overridden the value and updated
  251.     # the widget record ourselves.
  252.     #
  253.     return $data(-pattern)
  254. }
  255.  
  256. proc tixFileSelectBox:config-value {w value} {
  257.     upvar #0 $w data
  258.  
  259.     tixFileSelectBox:SetValue $w [tixFileIntName $value]
  260.     tixSetSilent $data(w:selection) $value
  261.  
  262.     return $data(-value)
  263. }
  264.  
  265. #----------------------------------------------------------------------
  266. #                    PUBLIC METHODS
  267. #----------------------------------------------------------------------
  268. proc tixFileSelectBox:filter {w args} {
  269.     upvar #0 $w data
  270.  
  271.     $data(w:filter) popdown
  272.     tixFileSelectBox:InterpFilter $w
  273.     tixFileSelectBox:LoadDir $w
  274. }
  275.  
  276. proc tixFileSelectBox:invoke {w args} {
  277.     upvar #0 $w data
  278.  
  279.     if {[$data(w:selection) cget -value] !=
  280.     [$data(w:selection) cget -selection]} {
  281.         # this will in turn call "invoke" again ...
  282.         #
  283.         $data(w:selection) invoke
  284.         return
  285.     }
  286.     
  287.     # record the filter
  288.     #
  289.     set filter [tixFileSelectBox:InterpFilter $w]
  290.     $data(w:filter) addhistory $filter
  291.  
  292.     # record the selection
  293.     #
  294.     set userInput [string trim [$data(w:selection) cget -value]]
  295.     tixFileSelectBox:SetValue $w \
  296.     [tixFileIntName $userInput $data(i-directory)]
  297.     $data(w:selection) addhistory $data(-value)
  298.  
  299.     $data(w:filter) align
  300.     $data(w:selection)  align
  301.  
  302.     if {$data(-command) != "" && !$data(-disablecallback)} {
  303.     set bind(specs) "%V"
  304.     set bind(%V) $data(-value)
  305.     tixEvalCmdBinding $w $data(-command) bind $data(-value)
  306.     }
  307. }
  308.  
  309. #----------------------------------------------------------------------
  310. #                    INTERNAL METHODS
  311. #----------------------------------------------------------------------
  312. # InterpFilter:
  313. #    Interprets the value of the w:filter widget. 
  314. #
  315. # Side effects:
  316. #    Changes the fields data(-directory) and data(-pattenn) 
  317. #
  318. proc tixFileSelectBox:InterpFilter {w {filter ""}} {
  319.     upvar #0 $w data
  320.  
  321.     if {$filter == ""} {
  322.     set filter [$data(w:filter) cget -selection]
  323.     if {$filter == ""} {
  324.         set filter [$data(w:filter) cget -value]
  325.     }
  326.     }
  327.  
  328.     set i_filter [tixFileIntName $filter]
  329.  
  330.     if [file isdir $filter] {
  331.     tixFileSelectBox:SetDir $w $i_filter
  332.     tixFileSelectBox:SetPat $w [tixFilePattern allFiles]
  333.     } else {
  334.     set nDir [file dir $filter]
  335.     if {$nDir == "" || $nDir == "."} {
  336.         tixFileSelectBox:SetDir $w [tixFileIntName $data(i-directory)]
  337.     } else {
  338.         tixFileSelectBox:SetDir $w [tixFileIntName $nDir]
  339.     }
  340.     tixFileSelectBox:SetPat $w [tixFileIntName [file tail $filter]]
  341.     }
  342.  
  343.     tixFileSelectBox:SetFilter $w $data(i-directory) $data(i-pattern)
  344.  
  345.     return $data(filter)
  346. }
  347.  
  348. proc tixFileSelectBox:SetFilter {w dir pattern} {
  349.     upvar #0 $w data
  350.  
  351.     set data(filter) [tixSubFolder $dir $pattern]
  352.     tixSetSilent $data(w:filter) [tixNativeName $data(filter)]
  353. }
  354.  
  355. proc tixFileSelectBox:LoadDirIntoLists {w} {
  356.     upvar #0 $w data
  357.  
  358.     $data(w:dirlist)  subwidget listbox delete 0 end
  359.     $data(w:filelist) subwidget listbox delete 0 end
  360.  
  361.     set dir $data(i-directory)
  362.  
  363.     # (1) List the directories
  364.     #
  365.     set isDrive 0
  366.     catch {
  367.     set nDir [tixNativeName $dir]
  368.     if {[llength [file split $nDir]] == 1} {
  369.         set isDrive 1
  370.     }
  371.     }
  372.     foreach name [tixListDir $dir 1 0 1 1] {
  373.     if ![string compare ".." $name] {
  374.         if $isDrive {
  375.         continue
  376.         }
  377.     }
  378.     $data(w:dirlist) subwidget listbox insert end $name
  379.     }
  380.  
  381.     # (2) List the files
  382.     #
  383.     # %% UNIX'ISM:
  384.     # If the pattern is "*" force glob to list the .* files.
  385.     # However, since the user might not
  386.     # be interested in them, shift the listbox so that the "normal" files
  387.     # are seen first
  388.     #
  389.     # NOTE: if we pass $pat == "" but with $showHidden set to true,
  390.     #       tixListDir will list "* .*" in Unix. See the comment on top of
  391.     #        the tixListDir code.
  392.     #
  393.     if {[string compare $data(i-pattern) *] == 0} {
  394.     set pat ""
  395.     } else {
  396.     set pat $data(i-pattern)
  397.     }
  398.  
  399.     set top 0
  400.     foreach name [tixListDir $dir 0 1 0 0 $pat] {
  401.     $data(w:filelist) subwidget listbox insert end $name
  402.     if [string match .* $name] {
  403.         incr top
  404.     }
  405.     }
  406.  
  407.     $data(w:filelist) subwidget listbox yview $top
  408. }
  409.  
  410. proc tixFileSelectBox:LoadDir {w} {
  411.     upvar #0 $w data
  412.  
  413.     tixBusy $w on [$data(w:dirlist) subwidget listbox]
  414.  
  415.     tixFileSelectBox:LoadDirIntoLists $w
  416.     tixFileSelectBox:MkDirMenu $w
  417.  
  418.     if {[$data(w:dirlist) subwidget listbox size] == 0} {
  419.     # fail safe, just in case the user has inputed an errnoeuos
  420.     # directory
  421.     $data(w:dirlist) subwidget listbox insert 0 ".."
  422.     }
  423.  
  424.     tixWidgetDoWhenIdle tixBusy $w off [$data(w:dirlist) subwidget listbox]
  425. }
  426.  
  427. # %% unimplemented
  428. #
  429. proc tixFileSelectBox:MkDirMenu {w} {
  430.     upvar #0 $w data
  431. }
  432.  
  433. # User single clicks on the directory listbox
  434. #
  435. proc tixFileSelectBox:SelectDir {w} {
  436.     upvar #0 $w data
  437.  
  438.     if {$data(fakeDir) > 0} {
  439.     incr data(fakeDir) -1
  440.     $data(w:dirlist) subwidget listbox select clear 0 end
  441.     $data(w:dirlist) subwidget listbox activate -1
  442.     return
  443.     }
  444.  
  445.     if {$data(flag)} {
  446.     return
  447.     }
  448.     set data(flag) 1
  449.  
  450.     set subdir [tixListboxGetCurrent [$data(w:dirlist) subwidget listbox]]
  451.     if {$subdir == ""} {
  452.     set subdir "."
  453.     }
  454.  
  455.     tixFileSelectBox:SetFilter $w \
  456.     [tixFileIntName [tixSubFolder $data(i-directory) $subdir]] \
  457.     $data(i-pattern)
  458.     set data(flag) 0
  459. }
  460.  
  461. proc tixFileSelectBox:InvokeDir {w} {
  462.     upvar #0 $w data
  463.  
  464.     set theDir [$data(w:dirlist) subwidget listbox get active]
  465.  
  466.     tixFileSelectBox:SetDir $w [tixFileIntName \
  467.     [tixSubFolder $data(i-directory) $theDir]]
  468.  
  469.     $data(w:dirlist) subwidget listbox select clear 0 end
  470.  
  471.     tixFileSelectBox:SetFilter $w $data(i-directory) $data(i-pattern)
  472.     tixFileSelectBox:InterpFilter $w [tixNativeName $data(filter)]
  473.  
  474.     tixFileSelectBox:LoadDir $w
  475.  
  476.     if {![tixEvent match <Return>]} {
  477.     incr data(fakeDir) 1
  478.     }
  479. }
  480.  
  481. proc tixFileSelectBox:SelectFile {w} {
  482.     upvar #0 $w data
  483.  
  484.     if {$data(flag)} {
  485.     return
  486.     }
  487.     set data(flag) 1
  488.  
  489.     # Reset the "Filter:" box to the current directory:
  490.     #    
  491.     $data(w:dirlist) subwidget listbox select clear 0 end
  492.     tixFileSelectBox:SetFilter $w $data(i-directory) $data(i-pattern)
  493.  
  494.     # Now select the file
  495.     #
  496.     set selected [tixListboxGetCurrent [$data(w:filelist) subwidget listbox]]
  497.     if {$selected != ""} {
  498.     # Make sure that the selection is not empty!
  499.     #
  500.     tixFileSelectBox:SetValue $w \
  501.         [tixFileIntName [tixSubFolder $data(i-directory) $selected]]
  502.     tixSetSilent $data(w:selection) $data(-value)
  503.  
  504.     if {$data(-browsecmd) != ""} {
  505.         tixEvalCmdBinding $w $data(-browsecmd) "" $data(-value)
  506.     }
  507.     }
  508.     set data(flag) 0
  509. }
  510.  
  511. proc tixFileSelectBox:InvokeFile {w} {
  512.     upvar #0 $w data
  513.  
  514.     set selected [tixListboxGetCurrent [$data(w:filelist) subwidget listbox]]
  515.     if {$selected  != ""} {
  516.     $w invoke
  517.     }
  518. }
  519.  
  520. # This is only called the first this fileBox is mapped -- load the directory
  521. #
  522. proc tixFileSelectBox:FirstMapped {w} {
  523.     if {![winfo exists $w]} {
  524.     return
  525.     }
  526.  
  527.     upvar #0 $w data
  528.  
  529.     tixFileSelectBox:SetFilter $w $data(i-directory) $data(i-pattern)
  530.     tixFileSelectBox:LoadDir $w
  531.     $data(w:filter) align
  532. }
  533.  
  534.  
  535. #----------------------------------------------------------------------
  536. #
  537. #
  538. #              C O N V E N I E N C E   R O U T I N E S 
  539. #
  540. #
  541. #----------------------------------------------------------------------
  542.  
  543. # This is obsolete. Use the widget tixFileSelectDialog instead
  544. #
  545. #
  546. proc tixMkFileDialog {w args} {
  547.     set option(-okcmd)    ""
  548.     set option(-helpcmd)  ""
  549.  
  550.     tixHandleOptions option {-okcmd -helpcmd} $args
  551.  
  552.     toplevel $w
  553.     wm minsize $w 10 10
  554.  
  555.     tixStdDlgBtns $w.btns
  556.     
  557.     if {$option(-okcmd) != ""} {
  558.     tixFileSelectBox $w.fsb -command "wm withdraw $w; $option(-okcmd)"
  559.     } else {
  560.     tixFileSelectBox $w.fsb -command "wm withdraw $w"
  561.     }
  562.  
  563.     $w.btns button ok     config -command "$w.fsb invoke"
  564.     $w.btns button apply  config -command "$w.fsb filter" -text Filter
  565.     $w.btns button cancel config -command "wm withdraw $w"
  566.  
  567.     if {$option(-helpcmd) == ""} {
  568.     $w.btns button help config -state disabled
  569.     } else {
  570.     $w.btns button help config -command $option(-helpcmd)
  571.     }
  572.     wm protocol $w WM_DELETE_WINDOW "wm withdraw $w"
  573.     pack $w.btns  -side bottom -fill both
  574.     pack $w.fsb   -fill both -expand yes
  575.  
  576.     return $w.fsb
  577. }
  578.  
  579.  
  580.