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 / DirList.tcl < prev    next >
Text File  |  2001-11-03  |  8KB  |  292 lines
  1. # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
  2. #
  3. #    $Id: DirList.tcl,v 1.3.2.1 2001/11/03 06:43:50 idiscovery Exp $
  4. #
  5. # DirList.tcl --
  6. #
  7. #    Implements the tixDirList 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 tixDirList {
  20.     -classname TixDirList
  21.     -superclass tixScrolledHList
  22.     -method {
  23.     chdir
  24.     }
  25.     -flag {
  26.      -browsecmd -command -dircmd -disablecallback 
  27.      -root -rootname -showhidden -value
  28.     }
  29.     -configspec {
  30.     {-browsecmd browseCmd BrowseCmd ""}
  31.     {-command command Command ""}
  32.     {-dircmd dirCmd DirCmd ""}
  33.     {-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
  34.     {-root root Root ""}
  35.     {-rootname rootName RootName ""}
  36.     {-showhidden showHidden ShowHidden 0 tixVerifyBoolean}
  37.     {-value value Value ""}
  38.     }
  39.     -default {
  40.     {.scrollbar            auto}
  41.     {*borderWidth            1}
  42.     {*hlist.background        #c3c3c3}
  43.     {*hlist.indent            7}
  44.     {*hlist.relief            sunken}
  45.     {*hlist.height            10}
  46.     {*hlist.width            20}
  47.     {*hlist.padX            2}
  48.     {*hlist.padY            0}
  49.     {*hlist.wideSelection        0}
  50.     {*hlist.drawBranch        0}
  51.     {*hlist.highlightBackground    #d9d9d9}
  52.     {*hlist.itemType        imagetext}
  53.     {*hlist.takeFocus        1}
  54.     }
  55.     -forcecall {
  56.     -value
  57.     }
  58. }
  59.  
  60. # Important data members:
  61. #
  62. # data(vpath)
  63. #    The currently selected vpath. This internal variable is useful on
  64. #    the Win95 platform, where an directory may correspond to more than
  65. #    one node in the hierarchy. For example, C:\Windows\Desktop\Foo
  66. #    can appead as "Desktop\Foo" and
  67. #    "Desktop\My Computer\C:\Windows\Desktop\Foo". This variable tells us
  68. #    which icon should we show given the same DOS pathname.
  69. #
  70.  
  71. proc tixDirList:InitWidgetRec {w} {
  72.     upvar #0 $w data
  73.  
  74.     tixChainMethod $w InitWidgetRec
  75. }
  76.  
  77. proc tixDirList:ConstructWidget {w} {
  78.     upvar #0 $w data
  79.  
  80.     tixChainMethod $w ConstructWidget
  81.  
  82.     $data(w:hlist) config \
  83.     -separator [tixFSSep] \
  84.     -selectmode "single"
  85.  
  86.     # We must creat an extra copy of these images to avoid flashes on
  87.     # the screen when user changes directory
  88.     #
  89. #    set data(images) [image create compound -window $data(w:hlist)]
  90. #    $data(images) add image -image [tix getimage act_fold]
  91. #    $data(images) add image -image [tix getimage folder]
  92. #    $data(images) add image -image [tix getimage openfold]
  93. }
  94.  
  95. proc tixDirList:SetBindings {w} {
  96.     upvar #0 $w data
  97.  
  98.     tixChainMethod $w SetBindings
  99.  
  100.     $data(w:hlist) config \
  101.     -browsecmd [list tixDirList:Browse $w] \
  102.     -command [list tixDirList:Command $w]
  103.  
  104.     if {[tixStrEq $data(-value) ""]} {
  105.     set data(-value) [tixFSPWD]
  106.     }
  107.     if [catch {
  108.     set data(vpath) [tixFSVPath [tixFSNormDir $data(-value)]]
  109.     }] {
  110.     set data(vpath) [tixFSVPath [tixFSNormDir [tixFSPWD]]]
  111.     }
  112. }
  113.  
  114. #----------------------------------------------------------------------
  115. # Incoming-Events
  116. #----------------------------------------------------------------------
  117. proc tixDirList:Browse {w args} {
  118.     upvar #0 $w data
  119.  
  120.     uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
  121.     set vpath [tixEvent flag V]
  122.     set value [$data(w:hlist) info data $vpath]
  123.  
  124.     tixDirList:HighLight $w $vpath
  125.  
  126.     set data(vpath)  $vpath
  127.     set data(-value) $value
  128.  
  129.     tixDirList:CallBrowseCmd $w $data(-value)
  130. }
  131.  
  132. proc tixDirList:Command {w args} {
  133.     upvar #0 $w data
  134.  
  135.     set vpath [tixEvent value]
  136.     set value [$data(w:hlist) info data $vpath]
  137.     set data(-value) $value
  138.  
  139.     tixDirList:LoadDir $w [tixFSNormDir $value] $vpath
  140.     tixDirList:HighLight $w $vpath
  141.  
  142.     set data(vpath) $vpath
  143.     tixDirList:CallCommand $w $data(-value)
  144. }
  145.  
  146. #----------------------------------------------------------------------
  147. # Outgoing-Events
  148. #----------------------------------------------------------------------
  149.  
  150. proc tixDirList:CallBrowseCmd {w value} {
  151.     upvar #0 $w data
  152.  
  153.     if {$data(-browsecmd) != ""} {
  154.     set bind(specs) "%V"
  155.     set bind(%V) $value
  156.     tixEvalCmdBinding $w $data(-browsecmd) bind $value
  157.     }
  158. }
  159.  
  160. proc tixDirList:CallCommand {w value} {
  161.     upvar #0 $w data
  162.  
  163.     if {$data(-command) != "" && !$data(-disablecallback)} {
  164.     set bind(specs) "%V"
  165.     set bind(%V) $value
  166.     tixEvalCmdBinding $w $data(-command) bind $value
  167.     }
  168. }
  169.  
  170. #----------------------------------------------------------------------
  171. #         Directory loading
  172. #----------------------------------------------------------------------
  173. proc tixDirList:LoadDir {w {npath ""} {vpath ""}} {
  174.     upvar #0 $w data
  175.  
  176.     tixBusy $w on $data(w:hlist)
  177.  
  178.     $data(w:hlist) delete all
  179.  
  180.     if {![string compare $npath ""]} {
  181.     set npath [tixFSNormDir $data(-value)]
  182.     set vpath [tixFSVPath $npath]
  183.     }
  184.  
  185.     tixDirList:ListHierachy $w $npath $vpath
  186.     tixDirList:ListSubDirs $w $npath $vpath
  187.  
  188.     tixWidgetDoWhenIdle tixBusy $w off $data(w:hlist)
  189. }
  190.  
  191. proc tixDirList:ListHierachy {w dir vpath} {
  192.     upvar #0 $w data
  193.     uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
  194.  
  195.     foreach p [tixFSSplit $vpath] {
  196.     set vpath [lindex $p 0]
  197.     set text  [lindex $p 1]
  198.     set path  [lindex $p 2]
  199.  
  200.     $data(w:hlist) add $vpath -text $text -data $path \
  201.         -image [tix getimage openfold]
  202.     }
  203. }
  204.  
  205. proc tixDirList:ListSubDirs {w dir vpath} {
  206.     upvar #0 $w data
  207.     uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
  208.  
  209.     $data(w:hlist) entryconfig $vpath \
  210.     -image [tix getimage act_fold]
  211.  
  212.     foreach ent [tixFSListDir $vpath 1 0 0 $data(-showhidden)] {
  213.     set vp   [lindex $ent 0]
  214.     set name [lindex $ent 1]
  215.     set path [lindex $ent 2]
  216.  
  217.     $data(w:hlist) add $vp -text $name -data $path \
  218.         -image [tix getimage folder]
  219.     }
  220. }
  221.  
  222. proc tixDirList:SetValue {w npath vpath {flag ""}} {
  223.     upvar #0 $w data
  224.  
  225.     if {![string compare $flag reload] ||
  226.     ![$data(w:hlist) info exists $vpath]} {
  227.         tixDirList:LoadDir $w $npath $vpath
  228.     }
  229.  
  230.     tixDirList:HighLight $w $vpath
  231.  
  232.     set data(-value) [tixFSDisplayName $npath]
  233.     set data(vpath) $vpath
  234.     tixDirList:CallCommand $w $data(-value)
  235. }
  236.  
  237. proc tixDirList:HighLight {w vpath} {
  238.     upvar #0 $w data
  239.  
  240.     if {![tixStrEq $data(vpath) $vpath]} {
  241.     set old $data(vpath)
  242.  
  243.     if {[$data(w:hlist) info exists $old]} {
  244.         # Un-highlight the originally selected entry by changing its
  245.         # folder image
  246.  
  247.         if {[$data(w:hlist) info children $old] == ""} {
  248.         $data(w:hlist) entryconfig $old\
  249.             -image [tix getimage folder]
  250.         } else {
  251.         $data(w:hlist) entryconfig $old\
  252.             -image [tix getimage openfold]
  253.         }
  254.     }
  255.     }
  256.  
  257.     # Highlight the newly selected entry
  258.     #
  259.     $data(w:hlist) entryconfig $vpath \
  260.     -image [tix getimage act_fold]
  261.     $data(w:hlist) anchor set $vpath
  262.     $data(w:hlist) select clear
  263.     $data(w:hlist) select set $vpath
  264.     $data(w:hlist) see $vpath
  265. }
  266.  
  267. #----------------------------------------------------------------------
  268. # Config options
  269. #----------------------------------------------------------------------
  270. proc tixDirList:config-value {w value} {
  271.     upvar #0 $w data
  272.  
  273.     tixDirList:chdir $w $value
  274.     return $data(-value)
  275. }
  276.  
  277. proc tixDirList:config-showhidden {w value} {
  278.     upvar #0 $w data
  279.  
  280.     tixWidgetDoWhenIdle tixDirList:LoadDir $w
  281. }
  282.  
  283. #----------------------------------------------------------------------
  284. # Public methods
  285. #----------------------------------------------------------------------
  286. proc tixDirList:chdir {w value} {
  287.     upvar #0 $w data
  288.  
  289.     set path [tixFSNormDir $value]
  290.     tixDirList:SetValue $w $path [tixFSVPath $path]
  291. }
  292.