home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / profiledia.tcl < prev    next >
Text File  |  1996-05-29  |  4KB  |  176 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cadre Technologies Inc.    1996
  4. #
  5. #      File:           @(#)profiledia.tcl    1.6
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)profiledia.tcl    1.6   01 Feb 1996 Copyright 1996 Cadre Technologies Inc.
  10.  
  11. # Start user added include file section
  12.  
  13. require profilenod.tcl
  14. require profrep.tcl
  15.  
  16. # End user added include file section
  17.  
  18.  
  19. Class ProfileDialog : {TemplateDialog} {
  20.     constructor
  21.     method destructor
  22.     method processData
  23.     method readData
  24.     method buildTree
  25.     method addRoots
  26.     method removeRoots
  27.     method getChildren
  28.     method setChildren
  29.     method removeChildren
  30.     attribute tmpFile
  31.     attribute rootsSet
  32.     attribute children
  33. }
  34.  
  35. global ProfileDialog::nodeCount
  36. set ProfileDialog::nodeCount 0
  37.  
  38.  
  39. constructor ProfileDialog {class this name} {
  40.     set this [TemplateDialog::constructor $class $this $name]
  41.     $this rootsSet [List new]
  42.     $this children [Dictionary new]
  43.     # Start constructor user section
  44.  
  45.     interface DlgRow $this.r {
  46.         BrowsTree tree {
  47.             rowCount 24
  48.         }
  49.         DlgColumn c {
  50.             Label callsLabel {text "Calls:"}
  51.             SingleLineText callsText {editable 0}
  52.             Label realLabel {text "Real Time:"}
  53.             SingleLineText realText {editable 0}
  54.             Label cpuLabel {text "CPU Time:"}
  55.             SingleLineText cpuText {editable 0}
  56.             Label cpcLabel {text "CPU/Call:"}
  57.             SingleLineText cpcText {editable 0}
  58.         }
  59.     }
  60.     $this delCancelButton
  61.     $this config -okPressed {%this delete}
  62.  
  63.     # End constructor user section
  64.     return $this
  65. }
  66.  
  67. method ProfileDialog::destructor {this} {
  68.     # Start destructor user section
  69.     unlink [$this tmpFile]
  70.     # End destructor user section
  71. }
  72.  
  73. method ProfileDialog::processData {this} {
  74.     $this readData
  75.     [$this rootsSet] foreach root {
  76.         $this buildTree $root ""
  77.     }
  78. }
  79.  
  80. method ProfileDialog::readData {this} {
  81.     set fp [open [$this tmpFile]]
  82.     set roots [$this rootsSet]
  83.     set children [$this children]
  84.     # Skip header
  85.     gets $fp; gets $fp; gets $fp;
  86.     while {[gets $fp line] >= 0} {
  87.         set ncols [llength $line]
  88.         if {$ncols == 5} {
  89.             $roots append $line
  90.         } else {
  91.             set parent [lindex $line 1]
  92.             set childList [$children set $parent]
  93.             lappend childList \
  94.                 [concat [lindex $line 0] [lrange $line 2 end]]
  95.             $children set $parent $childList
  96.         }
  97.     }
  98. }
  99.  
  100. method ProfileDialog::buildTree {this spec parent} {
  101.     set node [lindex $spec 0]
  102.     set time [lindex $spec 2]
  103.     global ProfileDialog::nodeCount
  104.     incr ProfileDialog::nodeCount
  105.     if {$parent != ""} {
  106.         $parent hasChildren 1
  107.     }
  108.     set newNode [ProfileNode new $this.r.tree.n${ProfileDialog::nodeCount} \
  109.                 -parent $parent \
  110.                 -label "$time $node" \
  111.                 -data [lrange $spec 1 end] \
  112.                 -dialog $this]
  113.     set children [$this children]
  114.     set nodeChildren [$children set $node]
  115.     if {$nodeChildren == ""} {
  116.         return
  117.     }
  118.     global busy
  119.     foreach spec $nodeChildren {
  120.         if {[info exists busy($spec)]} {
  121.             incr ProfileDialog::nodeCount
  122.             $newNode hasChildren 1
  123.             ProfileNode new \
  124.                 $this.r.tree.n${ProfileDialog::nodeCount} \
  125.                 -label "<loop to [lindex $spec 0]>"\
  126.                 -parent $newNode \
  127.                 -data [lrange $spec 1 end] \
  128.                 -dialog $this
  129.         } else {
  130.             set busy($spec) 1
  131.             $this buildTree $spec $newNode
  132.             unset busy($spec)
  133.         }
  134.     }
  135. }
  136.  
  137. proc ProfileDialog::startProfile {} {
  138.     profile on
  139. }
  140.  
  141. proc ProfileDialog::endProfile {} {
  142.     profile off ProfileDialog::data
  143.     if {[isCommand .main.profile]} {
  144.         error "profile dialog still active"
  145.     }
  146.     set tmp [args_file {}]
  147.     profrep ProfileDialog::data real 2 $tmp
  148.     ProfileDialog new .main.profile -tmpFile $tmp
  149.     .main.profile processData
  150.     .main.profile popUp
  151. }
  152.  
  153. # Do not delete this line -- regeneration end marker
  154.  
  155. method ProfileDialog::addRoots {this newRoots} {
  156.     [$this rootsSet] append $newRoots
  157.  
  158. }
  159.  
  160. method ProfileDialog::removeRoots {this oldRoots} {
  161.     [$this rootsSet] removeValue $oldRoots
  162. }
  163.  
  164. method ProfileDialog::getChildren {this node} {
  165.     return [[$this children] set $node]
  166. }
  167.  
  168. method ProfileDialog::setChildren {this node newChildren} {
  169.     [$this children] set $node $newChildren
  170. }
  171.  
  172. method ProfileDialog::removeChildren {this node} {
  173.     [$this children] unset $node
  174. }
  175.  
  176.