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 / DirTree.tcl < prev    next >
Text File  |  2002-01-24  |  10KB  |  401 lines
  1. # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
  2. #
  3. #    $Id: DirTree.tcl,v 1.2.2.2 2002/01/24 10:08:58 idiscovery Exp $
  4. #
  5. # DirTree.tcl --
  6. #
  7. #    Implements directory tree for Unix file systems
  8. #
  9. #       What the indicators mean:
  10. #
  11. #    (+): There are some subdirectories in this directory which are not
  12. #         currently visible.
  13. #    (-): This directory has some subdirectories and they are all visible
  14. #
  15. #      none: The dir has no subdirectori(es).
  16. #
  17. # Copyright (c) 1993-1999 Ioi Kim Lam.
  18. # Copyright (c) 2000-2001 Tix Project Group.
  19. #
  20. # See the file "license.terms" for information on usage and redistribution
  21. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  22. #
  23.  
  24. tixWidgetClass tixDirTree {
  25.     -classname TixDirTree
  26.     -superclass tixVTree
  27.     -method {
  28.     activate chdir refresh
  29.     }
  30.     -flag {
  31.     -browsecmd -command -directory -disablecallback -showhidden -value
  32.     }
  33.     -configspec {
  34.     {-browsecmd browseCmd BrowseCmd ""}
  35.     {-command command Command ""}
  36.     {-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
  37.     {-showhidden showHidden ShowHidden 0 tixVerifyBoolean}
  38.     {-value value Value ""}
  39.     }
  40.     -alias {
  41.     {-directory -value}
  42.     }
  43.     -default {
  44.     {.scrollbar            auto}
  45.     {*Scrollbar.takeFocus           0}
  46.     {*borderWidth                   1}
  47.     {*hlist.indicator               1}
  48.     {*hlist.background              #c3c3c3}
  49.     {*hlist.drawBranch              1}
  50.     {*hlist.height                  10}
  51.     {*hlist.highlightBackground      #d9d9d9}
  52.     {*hlist.indent                  20}
  53.     {*hlist.itemType                imagetext}
  54.     {*hlist.padX                    3}
  55.     {*hlist.padY                    0}
  56.     {*hlist.relief                  sunken}
  57.     {*hlist.takeFocus               1}
  58.     {*hlist.wideSelection           0}
  59.     {*hlist.width                   20}
  60.     }
  61. }
  62.  
  63. proc tixDirTree:InitWidgetRec {w} {
  64.     upvar #0 $w data
  65.  
  66.     tixChainMethod $w InitWidgetRec
  67.  
  68.     if {$data(-value) == ""} {
  69.     global env
  70.     if {[info exists env(PWD)]} {
  71.         set data(-value) $env(PWD)
  72.     } else {
  73.         set data(-value) [pwd]
  74.     }
  75.     }
  76.  
  77.     tixDirTree:SetDir $w [tixFileIntName $data(-value)]
  78. }
  79.  
  80. proc tixDirTree:ConstructWidget {w} {
  81.     upvar #0 $w data
  82.  
  83.     tixChainMethod $w ConstructWidget
  84.     tixDoWhenMapped $w "tixDirTree:StartUp $w"
  85.  
  86.     $data(w:hlist) config \
  87.     -separator [tixDirSep] \
  88.     -selectmode "single" -drawbranch 1
  89.  
  90.     # We must creat an extra copy of these images to avoid flashes on
  91.     # the screen when user changes directory
  92.     #
  93.     set data(images) [image create compound -window $data(w:hlist)]
  94.     $data(images) add image -image [tix getimage act_fold]
  95.     $data(images) add image -image [tix getimage folder]
  96.     $data(images) add image -image [tix getimage openfold]
  97. }
  98.  
  99. proc tixDirTree:SetBindings {w} {
  100.     upvar #0 $w data
  101.  
  102.     tixChainMethod $w SetBindings
  103.  
  104. # %% do I still need this?
  105. #   bind $data(w:hlist) <3> "tixDirTree:DeleteSib $w %x %y"
  106. }
  107.  
  108. # This procedure is supposed to "trim" the directory tree view to
  109. # just the current directory and its ancestors.
  110. #
  111. #proc tixDirTree:DeleteSib {w x y} {
  112. #    upvar #0 $w data
  113. #
  114. #    set ent [$data(w:hlist) nearest $y]
  115. #
  116. #    if {$ent != ""} {
  117. #    $data(w:hlist) anchor set $ent
  118. #
  119. #    for {set e $ent} {$e != "/"} {set e [$data(w:hlist) info parent $e]} {
  120. #        $data(w:hlist) delete siblings $e
  121. #    }
  122. #    tixDirTree:Browse $w $ent
  123. #    }
  124. #}
  125.  
  126. # %% This functions needs to be optimized
  127. #
  128. #
  129. proc tixDirTree:HasSubDir {w dir} {
  130.     upvar #0 $w data
  131.  
  132.     if {[tixListDir $dir 1 0 0 $data(-showhidden)] != ""} {
  133.     return 1
  134.     } else {
  135.     return 0
  136.     }
  137. }
  138.  
  139.  
  140. # Add one dir into the parent directory, sorted alphabetically
  141. #
  142. proc tixDirTree:AddToList {w dir parent name image} {
  143.     upvar #0 $w data
  144.  
  145.     set added 0
  146.     foreach sib [$data(w:hlist) info children $parent] {
  147.     if {[string compare $dir $sib] < 0} {
  148.         $data(w:hlist) add $dir -before $sib -text $name -image $image
  149.         set added 1
  150.         break
  151.     }
  152.     }
  153.     if {!$added} {
  154.     $data(w:hlist) add $dir -text $name -image $image
  155.     }
  156.  
  157.     if {[tixDirTree:HasSubDir $w $dir]} {
  158.     tixVTree:SetMode $w $dir open
  159.     }
  160. }
  161.  
  162. # Add $dir and all ancestors of $dir into the HList widget
  163. #
  164. #
  165. proc tixDirTree:AddAncestors {w dir} {
  166.     upvar #0 $w data
  167.  
  168.     set path ""
  169.     set parent ""
  170.     foreach name [tixFileSplit $dir] {
  171.     set path [tixSubFolder $path $name]
  172.     if {![$data(w:hlist) info exists $path]} {
  173.         tixDirTree:AddToList $w $path $parent [tixFileDisplayName $path] \
  174.         [tix getimage openfold]
  175.     }
  176.     set parent $path
  177.     }
  178. }
  179.  
  180. # Add all the sub directories of $dir into the HList widget
  181. #
  182. #
  183. proc tixDirTree:ListDirs {w dir} {
  184.     upvar #0 $w data
  185.     uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
  186.  
  187.     tixBusy $w on $data(w:hlist)
  188.  
  189.     foreach name [tixListDir $dir 1 0 0 $data(-showhidden)] {
  190.     set subdir [tixSubFolder $dir $name]
  191.     if {![$data(w:hlist) info exists $subdir]} {
  192.         tixDirTree:AddToList $w $subdir $dir [tixFileDisplayName $subdir] \
  193.         [tix getimage folder]
  194.     }
  195.     }
  196.  
  197.     tixWidgetDoWhenIdle tixBusy $w off $data(w:hlist)
  198. }
  199.  
  200. proc tixDirTree:LoadDir {w dir {mode toggle}} {
  201.     if {![winfo exists $w]} {
  202.     return
  203.     }
  204.  
  205.     upvar #0 $w data
  206.     uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
  207.  
  208.     # Add the directory and set it to the active directory
  209.     #
  210.     if {![$data(w:hlist) info exists $dir]} {
  211.     tixDirTree:AddAncestors $w $dir
  212.     }
  213.     $data(w:hlist) entryconfig $dir -image [tix getimage act_fold]
  214.  
  215.     if {$mode == "toggle"} {
  216.     if {[$data(w:hlist) info children $dir] == ""} {
  217.         set mode expand
  218.     } else {
  219.         set mode flatten
  220.     }
  221.     }
  222.  
  223.     if {$mode == "expand"} {
  224.     tixDirTree:ListDirs $w $dir
  225.     if {[$data(w:hlist) info children $dir] == ""} {
  226.         tixVTree:SetMode $w $dir none
  227.     } else {
  228.         tixVTree:SetMode $w $dir close
  229.     }
  230.     } else {
  231.     $data(w:hlist) delete offsprings $dir
  232.     tixVTree:SetMode $w $dir open
  233.     }
  234. }
  235.  
  236. proc tixDirTree:ToggleDir {w value mode} {
  237.     upvar #0 $w data
  238.  
  239.     tixDirTree:LoadDir $w $value $mode
  240.     tixDirTree:CallCommand $w
  241. }
  242.  
  243. proc tixDirTree:CallCommand {w} {
  244.     upvar #0 $w data
  245.  
  246.     if {$data(-command) != "" && !$data(-disablecallback)} {
  247.     set bind(specs) {%V}
  248.     set bind(%V)    $data(-value)
  249.  
  250.     tixEvalCmdBinding $w $data(-command) bind $data(-value)
  251.     }
  252. }
  253.  
  254. proc tixDirTree:CallBrowseCmd {w ent} {
  255.     upvar #0 $w data
  256.  
  257.     if {$data(-browsecmd) != "" && !$data(-disablecallback)} {
  258.     set bind(specs) {%V}
  259.     set bind(%V)    $data(-value)
  260.  
  261.     tixEvalCmdBinding $w $data(-browsecmd) bind [list $data(-value)]
  262.     }
  263. }
  264.  
  265. proc tixDirTree:StartUp {w} {
  266.     if {![winfo exists $w]} {
  267.     return
  268.     }
  269.  
  270.     upvar #0 $w data
  271.  
  272.     tixDirTree:LoadDir $w $data(i-directory)
  273. }
  274.  
  275. proc tixDirTree:ChangeDir {w value {forced 0}} {
  276.     upvar #0 $w data
  277.  
  278.     if {!$forced && $data(i-directory) == $value} {
  279.     return
  280.     }
  281.     uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
  282.  
  283.     if {!$forced && [$data(w:hlist) info exists $value]} {
  284.     # Set the old directory to "non active"
  285.     #
  286.     if {[$data(w:hlist) info exists $data(i-directory)]} {
  287.         $data(w:hlist) entryconfig $data(i-directory) \
  288.         -image [tix getimage folder]
  289.     }
  290.  
  291.     $data(w:hlist) entryconfig $value  \
  292.         -image [tix getimage act_fold]
  293.  
  294.     } else {
  295.     if {$forced} {
  296.         if {[$data(w:hlist) info children $value] == ""} {
  297.         set mode flatten
  298.         } else {
  299.         set mode expand
  300.         }
  301.     } else {
  302.         set mode toggle
  303.     }
  304.     tixDirTree:LoadDir $w $value $mode
  305.     tixDirTree:CallCommand $w
  306.     }
  307.     tixDirTree:SetDir $w $value
  308. }
  309.  
  310.  
  311. proc tixDirTree:SetDir {w intName} {
  312.     upvar #0 $w data
  313.  
  314.     set data(i-directory) $intName
  315.     set data(-value)  [tixNativeName $intName]
  316. }
  317.  
  318. #----------------------------------------------------------------------
  319. #
  320. # Virtual Methods
  321. #
  322. #----------------------------------------------------------------------
  323. proc tixDirTree:OpenCmd {w ent} {
  324.     tixDirTree:ToggleDir $w $ent expand
  325.     tixDirTree:ChangeDir $w $ent
  326.     tixDirTree:CallBrowseCmd $w $ent
  327. }
  328.  
  329. proc tixDirTree:CloseCmd {w ent} {
  330.     tixDirTree:ToggleDir $w $ent flatten
  331.     tixDirTree:ChangeDir $w $ent
  332.     tixDirTree:CallBrowseCmd $w $ent
  333. }
  334.  
  335. proc tixDirTree:Command {w B} {
  336.     upvar #0 $w data
  337.     upvar $B bind
  338.  
  339.     set ent [tixEvent flag V]
  340.     tixChainMethod $w Command $B
  341.  
  342.     if {$data(-command) != ""} {
  343.     tixEvalCmdBinding $w $data(-command) bind $ent
  344.     }
  345. }
  346.  
  347. # This is a virtual method
  348. #
  349. proc tixDirTree:BrowseCmd {w B} {
  350.     upvar #0 $w data
  351.     upvar $B bind
  352.     
  353.     set ent [tixEvent flag V]
  354.  
  355. #    if {[$data(w:hlist) indicator exist $ent] && 
  356. #    [$data(w:hlist) info children $ent] == ""} {
  357. #    
  358. #    tixVTree:Activate $w $ent open
  359. #   }
  360.  
  361.     if {[string index $ent 0] != "/"} {
  362.         # This is a hack because %V may have been modified by
  363.     # callbrowsecmd ....
  364.         set ent [tixFileIntName $ent]
  365.     } 
  366.     tixDirTree:ChangeDir $w $ent
  367.     tixDirTree:CallBrowseCmd $w $ent
  368. }
  369.  
  370. #----------------------------------------------------------------------
  371. #
  372. # Public Methods
  373. #
  374. #----------------------------------------------------------------------
  375. proc tixDirTree:chdir {w value} {
  376.     tixDirTree:ChangeDir $w [tixFileIntName $value]
  377. }
  378.  
  379. proc tixDirTree:refresh {w {dir ""}} {
  380.     upvar #0 $w data
  381.  
  382.     if {$dir == ""} {
  383.     set dir $data(-value)
  384.     }
  385.  
  386.     tixDirTree:ChangeDir $w [tixFileIntName $dir] 1
  387.  
  388.  
  389.     # Delete any stale directories that no longer exist
  390.     #
  391.     foreach sub [$data(w:hlist) info children [tixFileIntName $dir]] {
  392.     if {![file exists [tixNativeName $sub]]} {
  393.         $data(w:hlist) delete entry $sub
  394.     }
  395.     }
  396. }
  397.  
  398. proc tixDirTree:config-directory {w value} {
  399.     tixDirTree:ChangeDir $w [tixFileIntName $value]
  400. }
  401.