home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / dirselectd.tcl < prev    next >
Encoding:
Text File  |  1997-11-06  |  7.2 KB  |  318 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)dirselectd.tcl    /main/titanic/7
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)dirselectd.tcl    /main/titanic/7   6 Nov 1997 Copyright 1997 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12. require dirnode.tcl
  13. # End user added include file section
  14.  
  15.  
  16. Class DirSelectDialog : {TemplateDialog} {
  17.     constructor
  18.     method destructor
  19.     method popUp
  20.     method selChanged
  21.     method handleOk
  22.     method handleDriveChanged
  23.     method updateTree
  24.     method makeVisible
  25.     attribute directory
  26.     attribute savedDrive
  27.     attribute windows
  28.     attribute update
  29.     attribute firstPopup
  30.     attribute curSelected
  31. }
  32.  
  33. constructor DirSelectDialog {class this name} {
  34.     set this [TemplateDialog::constructor $class $this $name]
  35.     $this update 1
  36.     $this firstPopup 1
  37.     # Start constructor user section
  38.     interface DlgColumn $this.c {
  39.         Label dirlbl {
  40.             text "Directory:"
  41.         }
  42.         SingleLineText dirslt { }
  43.         BrowsTree dirtree {
  44.             rowCount 20
  45.             columnCount 30
  46.         }
  47.     }
  48.     if {![string compare $tcl_platform(platform) windows]} {
  49.         $this windows 1
  50.         Label new $this.c.dirlbl -text "Drive:"
  51.         DropDwnList new $this.c.dirdrop
  52.         $this.c.dirdrop config -entrySet [logdrives] \
  53.             -selectionChanged {
  54.                 [[%this parent] parent] handleDriveChanged }
  55.     } else {
  56.         $this windows 0
  57.     }
  58.     $this.c.dirtree selectionChanged "$this selChanged"
  59.     $this config -modal yes \
  60.         -okPressed {%this handleOk}
  61.     $this delHelpButton
  62.     $this TemplateDialog::title "Select Directory"
  63.     # End constructor user section
  64.     return $this
  65. }
  66.  
  67. method DirSelectDialog::destructor {this} {
  68.     # Start destructor user section
  69.     # End destructor user section
  70. }
  71.  
  72. proc DirSelectDialog::hasChildren {dir} {
  73.     set dirs ""
  74.     catch {set dirs [glob -nocomplain [file join $dir *]]}
  75.     foreach subf $dirs {
  76.         if {[file isdirectory $subf] && [file readable $subf]} {
  77.             return 1
  78.         }
  79.     }
  80.     return 0
  81. }
  82.  
  83. proc DirSelectDialog::unfold {parent dir} {
  84.     if [catch {$parent tree}] {
  85.         resetErrorVars
  86.         set nrOfNodes [llength [$parent rootSet]]
  87.         set tree $parent
  88.     } else {
  89.         set nrOfNodes [llength [$parent childSet]]
  90.         set tree [$parent tree]
  91.         if {! [[[$tree parent] parent] windows]} {
  92.             $parent foldState 0
  93.         }
  94.     }
  95.     set dial [[$tree parent] parent]
  96.     busy {
  97.     set dirList [glob -nocomplain [file join $dir *]]
  98.     if [lempty $dirList] {
  99.         catch {$parent hasChildren 0}
  100.         return 0
  101.     }
  102.     if [$dial windows] {
  103.         set sortDirList [lsort -command DirSelectDialog::wsort $dirList]
  104.     } else {
  105.         set sortDirList [lsort $dirList]
  106.     }
  107.  
  108.     set notFoundDir 1
  109.     set count 0
  110.     foreach f $sortDirList {
  111.         if {! [file isdirectory $f]} {
  112.             continue
  113.         }
  114.  
  115.         set notFoundDir 0
  116.         set node $parent.$count
  117.         if {! [isCommand $node]} {
  118.             DirNode new $node \
  119.                 -icon fld_close_16 \
  120.                 -unFolded {
  121.                     DirSelectDialog::unfold \
  122.                         %this [%this directory]
  123.                 }
  124.             if [$dial windows] {
  125.                 $node folded {
  126.                     foreach el [%this childSet] {
  127.                         $el delete
  128.                     }
  129.                 }
  130.             }
  131.         }
  132.         $node config \
  133.             -label [file tail $f] \
  134.             -directory $f \
  135.             -hasChildren 1
  136.  
  137.         incr count
  138.     }
  139.     for {set node $parent.$count} {$count < $nrOfNodes} {incr count} {
  140.         if [isCommand $node] {
  141.             $node delete
  142.         }
  143.     }
  144.  
  145.     if $notFoundDir {
  146.         catch {$parent hasChildren 0}
  147.     }
  148.     }
  149.     return 1
  150. }
  151.  
  152. proc DirSelectDialog::wsort {a b} {
  153.     set a1 [string tolower $a]
  154.     set b1 [string tolower $b]
  155.     return [string compare $a1 $b1]
  156. }
  157.  
  158. method DirSelectDialog::popUp {this} {
  159.  
  160.     if {![$this update] && ![$this firstPopup]} {
  161.         $this TemplateDialog::popUp
  162.         return
  163.     }
  164.  
  165.     $this firstPopup 0
  166.  
  167.     busy {
  168.         if [$this windows] {
  169.             foreach el [$this.c.dirtree rootSet] {
  170.                 $el delete
  171.             }
  172.         }
  173.         $this updateTree
  174.         $this TemplateDialog::popUp
  175.         $this makeVisible
  176.         $this curSelected [$this.c.dirtree selected]
  177.         if [isCommand [$this curSelected]] {
  178.             [$this curSelected] icon fld_open_16
  179.             [$this curSelected] activeIcon fld_open_16
  180.         }
  181.     }
  182. }
  183.  
  184. method DirSelectDialog::selChanged {this} {
  185.     set sel [$this.c.dirtree selected]
  186.     if {$sel == ""} {
  187.         return
  188.     }
  189.     set str [$sel directory]
  190.     if [$this windows] {
  191.         regsub -all / $str \\ str
  192.     }
  193.     $this.c.dirslt text $str
  194.     if [isCommand [$this curSelected]] {
  195.         [$this curSelected] icon fld_close_16
  196.         [$this curSelected] activeIcon fld_close_16
  197.     }
  198.     $this curSelected $sel
  199.     if [isCommand [$this curSelected]] {
  200.         [$this curSelected] icon fld_open_16
  201.         [$this curSelected] activeIcon fld_open_16
  202.     }
  203. }
  204.  
  205. method DirSelectDialog::handleOk {this} {
  206.     $this directory [$this.c.dirslt text]
  207. }
  208.  
  209. method DirSelectDialog::handleDriveChanged {this} {
  210.     set tr $this.c.dirtree
  211.     set dd $this.c.dirdrop
  212.     busy {
  213.     if [$this windows] {
  214.         foreach el [$tr rootSet] {
  215.             $el delete
  216.         }
  217.     }
  218.     if {! [DirSelectDialog::unfold $tr [$dd selected]]} {
  219.         $dd selected [$this savedDrive]
  220.         DirSelectDialog::unfold $tr [$dd selected]
  221.     }
  222.     catch { $tr selected $tr.0 }
  223.     }
  224. }
  225.  
  226. method DirSelectDialog::updateTree {this} {
  227.     set dir [$this directory]
  228.     set pathtype [file pathtype $dir]
  229.     if {![string compare relative $pathtype]} {
  230.         set dir [file join [pwd] $dir]
  231.     } elseif {![string compare volumerelative $pathtype]} {
  232.         set dir [file split $dir]
  233.         lvarpop dir
  234.         set dir [file join [lindex [file split [pwd]] 0] $dir]
  235.     }
  236.     set splitdir [file split $dir]
  237.     if [$this windows] {
  238.         # find drive
  239.         $this.c.dirdrop config -entrySet [logdrives]
  240.         set root [lindex $splitdir 0]
  241.         regsub -all / $root \\ root
  242.         set root [string toupper $root]
  243.         $this.c.dirdrop selected $root
  244.         $this savedDrive $root
  245.     }
  246.     set par $this.c.dirtree
  247.     set el [lvarpop splitdir]
  248.     set growDir $el
  249.     DirSelectDialog::unfold $par $growDir
  250.     set chSet [$par rootSet]
  251.     set nextEl [lvarpop splitdir]
  252.     while {[string length $nextEl] != 0} {
  253.         set growDir [file join $growDir $nextEl]
  254.         set a [string tolower $growDir]
  255.         set found 0
  256.         foreach ch $chSet {
  257.             set b [string tolower [$ch directory]]
  258.             if {![string compare $a $b]} {
  259.                 set par $ch
  260.                 set found 1
  261.                 break
  262.             }
  263.         }
  264.         if $found {
  265.             DirSelectDialog::unfold $par $growDir
  266.             set chSet [$par childSet]
  267.             set nextEl [lvarpop splitdir]
  268.         } else {
  269.             set nextEl ""
  270.         }
  271.     }
  272.     if [string compare $par $this.c.dirtree] {
  273.         $this.c.dirtree selected $par
  274.     } else {
  275.         catch { $this.c.dirtree selected $this.c.dirtree.0 }
  276.     }
  277.     if [$this windows] {
  278.         regsub -all / $growDir \\ search
  279.     } else {
  280.         set search $growDir
  281.     }
  282.     $this.c.dirslt text $search
  283. }
  284.  
  285. method DirSelectDialog::makeVisible {this} {
  286.     set sel [$this.c.dirtree selected]
  287.     if {! [isCommand $sel]} {
  288.         return
  289.     }
  290.     $sel foldState 1
  291.     if [$this windows] {
  292.         set rC [$this.c.dirtree rowCount]
  293.         set totalRows 0
  294.         while {$totalRows < $rC} {
  295.             regsub {.*\.} $sel "" cnt
  296.             incr cnt
  297.             incr totalRows $cnt
  298.             set ptSel [$sel parent]
  299.             if {$ptSel != ""} {
  300.                 set sel $ptSel
  301.             } else {
  302.                 set totalRows $rC
  303.             }
  304.         }
  305.         if {$totalRows > $rC} {
  306.             set idx [expr $totalRows - $rC]
  307.             $sel.$idx makeVisible
  308.         } else {
  309.             $sel makeVisible
  310.         }
  311.     } else {
  312.         $sel makeVisible
  313.     }
  314. }
  315.  
  316. # Do not delete this line -- regeneration end marker
  317.  
  318.