gdb/gdbtk/library/blockframe.itb

   1 # Block and frame class implementations for GDBtk.
   2 # Copyright (C) 1997, 1998, 1999 Cygnus Solutions
   3 #
   4 # This program is free software; you can redistribute it and/or modify it
   5 # under the terms of the GNU General Public License (GPL) as published by
   6 # the Free Software Foundation; either version 2 of the License, or (at
   7 # your option) any later version.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13
  14 # ------------------------------------------------------------------
  15 #                            Block
  16 # ------------------------------------------------------------------
  17 itcl::body Block::constructor {start end args} {
  18
  19   # Record runtime info about this block
  20   set _start $start
  21   set _end $end
  22   set _variables [_findVariables]
  23   eval configure $args
  24 }
  25
  26 # Destroy ourself.
  27 itcl::body Block::destructor {} {
  28
  29   # Each block is responsible for destroying its
  30   # variables and removing them from the list of
  31   # of all variables for this frame
  32   foreach var $_variables {
  33     $var delete
  34   }
  35 }
  36
  37 # Return a list of variables defined in this block
  38 # This list is determined when we are created.
  39 itcl::body Block::variables {} {
  40   return $_variables
  41 }
  42
  43 # Find the new variables for this block.
  44 itcl::body Block::_findVariables {} {
  45
  46   # Find the new variables for this block.
  47   set variables [gdb_block_variables $_start $_end]
  48
  49   # Create variables.
  50   set vars {}
  51   foreach variable $variables {
  52     # Be paranoid: catch errors constructing variable.
  53     set err [catch {gdb_variable create -expr $variable} obj]
  54     if {!$err} {
  55       lappend vars $obj
  56     }
  57   }
  58
  59   return $vars
  60 }
  61
  62 itcl::body Block::update {} {
  63
  64   set changed {}
  65   foreach var $_variables {
  66     set changed [concat $changed [$var update]]
  67   }
  68
  69   return $changed
  70 }
  71
  72 itcl::body Block::info {} {
  73
  74   return [list $_start $_end]
  75 }
  76
  77 # ------------------------------------------------------------------
  78 #                             Frame
  79 # ------------------------------------------------------------------
  80 itcl::body Frame::constructor {addr} {
  81
  82   set _addr $addr
  83
  84   # Create all blocks in the selected frame
  85   set _blocks {}
  86   _createBlocks [gdb_get_blocks]
  87
  88 }
  89
  90 itcl::body Frame::destructor {} {
  91   # destroy our own blocks
  92   foreach block $_blocks {
  93     _removeBlock $block
  94   }
  95 }
  96
  97 itcl::body Frame::_removeBlock {blockObj} {
  98
  99   set i [lsearch $_blocks $blockObj]
 100   if {$i != -1} {
 101     set _blocks [lreplace $_blocks $i $i]
 102     delete object $blockObj
 103   }
 104 }
 105
 106 itcl::body Frame::_addBlock {block} {
 107
 108   set start [lindex $block 0]
 109   set end [lindex $block 1]
 110   set b [Block \#auto $start $end]
 111   lappend _blocks $b
 112
 113   return $b
 114 }
 115
 116 itcl::body Frame::_createBlocks {blocks} {
 117
 118   foreach block $blocks {
 119     set b [_addBlock $block]
 120   }
 121 }
 122
 123 itcl::body Frame::update {} {
 124
 125   set vars {}
 126   foreach block $_blocks {
 127     set vars [concat $vars [$block update]]
 128   }
 129
 130   return $vars
 131 }
 132
 133 itcl::body Frame::variables {} {
 134
 135   set vars {}
 136   foreach block $_blocks {
 137     set vars [concat $vars [$block variables]]
 138   }
 139
 140   return $vars
 141 }
 142
 143 itcl::body Frame::new {} {
 144   # find any new variables. So get a list of all blocks,
 145   # eliminate duplicates, and get those variables.
 146
 147   set blocks [gdb_get_blocks]
 148   set new {}
 149
 150   foreach block $blocks {
 151     set b [_findBlock $block]
 152     if {$b == ""} {
 153       # Found a new block. Create it get its variables
 154       set b [_addBlock $block]
 155       set new [concat $new [$b variables]]
 156     }
 157   }
 158
 159   return $new
 160 }
 161
 162 itcl::body Frame::deleteOld {} {
 163
 164   foreach block [_oldBlocks] {
 165     _removeBlock $block
 166   }
 167 }
 168
 169 itcl::body Frame::_oldBlocks {} {
 170
 171   set blocks [gdb_get_blocks]
 172   set oldObjs $_blocks
 173
 174   foreach block $blocks {
 175     set obj [_findBlock $block]
 176     if {$obj != ""} {
 177       # Found it.. Remove it from old
 178       set i [lsearch $oldObjs $obj]
 179       set oldObjs [lreplace $oldObjs $i $i]
 180     }
 181   }
 182
 183   return $oldObjs
 184 }
 185
 186 itcl::body Frame::old {} {
 187
 188   # All the variables in the blocks in old are now gone...
 189   # We don't remove blocks here, since the frontend viewer
 190   # might want to keep these variables around for a little while
 191   # longer.
 192   set vars {}
 193   set old [_oldBlocks]
 194   foreach block $old {
 195     set vars [concat $vars [$block variables]]
 196   }
 197
 198   return $vars
 199 }
 200
 201 itcl::body Frame::_findBlock {block} {
 202
 203   foreach b $_blocks {
 204     set info [$b info]
 205     if {$info == $block} {
 206       return $b
 207     }
 208   }
 209
 210   return ""
 211 }
 212
 213 itcl::body Frame::_findBlockIndex {block} {
 214
 215   set i 0
 216   foreach b $_blocks {
 217     set info [$b info]
 218     if {$info == $block} {
 219       return $i
 220     }
 221     incr i
 222   }
 223
 224   return -1
 225 }
 226
 227