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