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 / DirBox.tcl < prev    next >
Text File  |  2001-11-03  |  6KB  |  226 lines
  1. # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
  2. #
  3. #    $Id: DirBox.tcl,v 1.2.2.1 2001/11/03 07:29:16 idiscovery Exp $
  4. #
  5. # DirBox.tcl --
  6. #
  7. #    Implements the tixDirSelectBox widget.
  8. #
  9. #        - overrides the -browsecmd and -command options of the
  10. #         HList subwidget
  11. #
  12. # Copyright (c) 1993-1999 Ioi Kim Lam.
  13. # Copyright (c) 2000-2001 Tix Project Group.
  14. #
  15. # See the file "license.terms" for information on usage and redistribution
  16. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  17. #
  18.  
  19. tixWidgetClass tixDirSelectBox {
  20.     -classname TixDirSelectBox
  21.     -superclass tixPrimitive
  22.     -method {
  23.     }
  24.     -flag {
  25.     -command -disablecallback -value
  26.     }
  27.     -configspec {
  28.     {-command command Command ""}
  29.     {-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
  30.     {-label label Label "Directory:"}
  31.     {-value value Value ""}
  32.     }
  33.     -forcecall {
  34.     -value -label
  35.     }
  36.     -default {
  37.     {*combo*listbox.height         5}
  38.     {*combo.label.anchor        w}
  39.     {*combo.labelSide        top}
  40.     {*combo.history            true}
  41.     {*combo.historyLimit        20}
  42.     }
  43. }
  44.  
  45. proc tixDirSelectBox:InitWidgetRec {w} {
  46.     upvar #0 $w data
  47.     tixChainMethod $w InitWidgetRec
  48. }
  49.  
  50. proc tixDirSelectBox:ConstructWidget {w} {
  51.     upvar #0 $w data
  52.  
  53.     tixChainMethod $w ConstructWidget
  54.     set data(w:dircbx) [tixFileComboBox $w.dircbx]
  55.     set data(w:dirlist)  [tixDirList $w.dirlist]
  56.  
  57.     pack $data(w:dircbx) -side top -fill x -padx 4 -pady 2
  58.     pack $data(w:dirlist) -side top -fill both -expand yes -padx 4 -pady 2
  59.  
  60.     if {![string comp $data(-value) ""]} {
  61.     set data(-value) [tixFSPWD]
  62.     }
  63. }
  64.  
  65. proc tixDirSelectBox:SetBindings {w} {
  66.     upvar #0 $w data
  67.  
  68.     tixChainMethod $w SetBindings
  69.  
  70.     $data(w:dircbx) config -command "tixDirSelectBox:Cmd-DirCbx $w"
  71.     $data(w:dirlist) config -command "tixDirSelectBox:Cmd-DirList $w"\
  72.     -browsecmd "tixDirSelectBox:Browse-DirList $w"
  73. }
  74.  
  75. #----------------------------------------------------------------------
  76. # Incoming event: User
  77. #----------------------------------------------------------------------
  78.  
  79. # User activates the FileComboBox
  80. #
  81. #
  82. proc tixDirSelectBox:Cmd-DirCbx {w args} {
  83.     upvar #0 $w data
  84.  
  85.     set fInfo [tixEvent value]
  86.     set path [lindex $fInfo 0]
  87.  
  88.     if {![file exists $path]} {
  89.     tk_dialog .tix_error "" "Directory \"$path\" does not exist." \
  90.         error 0 Ok
  91.     $data(w:dircbx) config \
  92.         -text [tixFSDisplayName [tixFSNormDir $data(-value)]] \
  93.         -directory $data(-value)
  94.     return
  95.  
  96.     #
  97.     # The following code is not used because directories cannot be created
  98.     # on Windows
  99.     #
  100.  
  101.     # 1.1 Check for validity. The pathname cannot contain invalid chars
  102.     #
  103.     if {![tixFSIsValid $path]} {
  104.         tk_dialog .tix_error "Error" \
  105.         "\"$path\" is not a valid directory name" \
  106.         error 0 Ok
  107.         $data(w:dircbx) config \
  108.         -text [tixFSDisplayName [tixFSNormDir $data(-value)]] \
  109.         -directory $data(-value)
  110.         return
  111.     }
  112.  
  113.     # 1.2 Prompt for creation
  114.     #
  115.     set choice [tk_dialog .tix_error "" \
  116.         "Directory \"$path\" does not exist. Do you want to create it?" \
  117.         question 1 Yes No]
  118.     if {$choice == 1} {
  119.         $data(w:dircbx) config \
  120.         -text [tixFSDisplayName [tixFSNormDir $data(-value)]] \
  121.         -directory $data(-value)
  122.         return
  123.     } else {
  124.         if {![tixFSCreateDirs $path]} {
  125.         tk_dialog .tix_error "Error" \
  126.             "Cannot create directory \"$path\". Permission denied" \
  127.             error 0 Ok
  128.         $data(w:dircbx) config \
  129.             -text [tixFSDisplayName [tixFSNormDir $data(-value)]] \
  130.             -directory $data(-value)
  131.         return
  132.         }
  133.         tixDirSelectBox:SetValue $w $path 1 1
  134.     }
  135.     } elseif {![file isdirectory $path]} {
  136.     # 2.1: Can't choose a non-directory file
  137.     #
  138.     tk_dialog .tix_error "Error" \
  139.         "\"$path\" is not a directory." \
  140.         error 0 Ok
  141.     $data(w:dircbx) config \
  142.         -text [tixFSDisplayName [tixFSNormDir $data(-value)]] \
  143.         -directory $data(-value)
  144.     return
  145.     } else {
  146.     # OK. It is an existing directory
  147.     #
  148.     tixDirSelectBox:SetValue $w $path 1 1
  149.     }
  150. }
  151.  
  152. # User activates the dir list
  153. #
  154. #
  155. proc tixDirSelectBox:Cmd-DirList {w args} {
  156.     upvar #0 $w data
  157.  
  158.     set dir $data(-value)
  159.     catch {
  160.     set dir [tixEvent flag V]
  161.     }
  162.     set dir [tixFSNormDir $dir]
  163.     tixDirSelectBox:SetValue $w $dir 0 0
  164. }
  165.  
  166. # User browses the dir list
  167. #
  168. #
  169. proc tixDirSelectBox:Browse-DirList {w args} {
  170.     upvar #0 $w data
  171.  
  172.     set dir $data(-value)
  173.     catch {
  174.     set dir [tixEvent flag V]
  175.     }
  176.     set dir [tixFSNormDir $dir]
  177.     tixDirSelectBox:SetValue $w $dir 0 0
  178. }
  179.  
  180. #----------------------------------------------------------------------
  181. # Incoming event: Application
  182. #----------------------------------------------------------------------
  183. proc tixDirSelectBox:config-value {w value} {
  184.     upvar #0 $w data
  185.     set value [tixFSNormDir $value]
  186.  
  187.     tixDirSelectBox:SetValue $w $value 1 1
  188.     return $value
  189. }
  190.  
  191. proc tixDirSelectBox:config-label {w value} {
  192.     upvar #0 $w data
  193.  
  194.     $data(w:dircbx) subwidget combo config -label $value
  195. }
  196.  
  197. #----------------------------------------------------------------------
  198. #
  199. #            Internal functions
  200. #
  201. #----------------------------------------------------------------------
  202.  
  203. # Arguments:
  204. #    callback:Bool    Should we invoke the the -command.
  205. #     setlist:Bool    Should we set the -value of the DirList subwidget.
  206. #
  207. proc tixDirSelectBox:SetValue {w dir callback setlist} {
  208.     upvar #0 $w data
  209.  
  210.     set data(-value) $dir
  211.     $data(w:dircbx) config -text [tixFSDisplayName $dir] \
  212.     -directory [tixFSDisplayName $dir] 
  213.     if {$setlist && [file isdirectory $dir]} {
  214.     tixSetSilent $data(w:dirlist) $dir
  215.     }
  216.  
  217.     if {$callback} {
  218.     if {!$data(-disablecallback) && ![tixStrEq $data(-command) ""]} {
  219.         set bind(specs) {%V}
  220.         set bind(%V)    $data(-value)
  221.  
  222.         tixEvalCmdBinding $w $data(-command) bind $data(-value)
  223.     }
  224.     }
  225. }
  226.