| # Block and frame class implementations for GDBtk. |
| # Copyright (C) 1997, 1998, 1999 Cygnus Solutions |
| # |
| # This program is free software; you can redistribute it and/or modify it |
| # under the terms of the GNU General Public License (GPL) as published by |
| # the Free Software Foundation; either version 2 of the License, or (at |
| # your option) any later version. |
| # |
| # This program is distributed in the hope that it will be useful, |
| # but WITHOUT ANY WARRANTY; without even the implied warranty of |
| # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| # GNU General Public License for more details. |
| |
| # ------------------------------------------------------------------ |
| # Block |
| # ------------------------------------------------------------------ |
| itcl::body Block::constructor {start end args} { |
| |
| # Record runtime info about this block |
| set _start $start |
| set _end $end |
| set _variables [_findVariables] |
| eval configure $args |
| } |
| |
| # Destroy ourself. |
| itcl::body Block::destructor {} { |
| |
| # Each block is responsible for destroying its |
| # variables and removing them from the list of |
| # of all variables for this frame |
| foreach var $_variables { |
| $var delete |
| } |
| } |
| |
| # Return a list of variables defined in this block |
| # This list is determined when we are created. |
| itcl::body Block::variables {} { |
| return $_variables |
| } |
| |
| # Find the new variables for this block. |
| itcl::body Block::_findVariables {} { |
| |
| # Find the new variables for this block. |
| set variables [gdb_block_variables $_start $_end] |
| |
| # Create variables. |
| set vars {} |
| foreach variable $variables { |
| # Be paranoid: catch errors constructing variable. |
| set err [catch {gdb_variable create -expr $variable} obj] |
| if {!$err} { |
| lappend vars $obj |
| } |
| } |
| |
| return $vars |
| } |
| |
| itcl::body Block::update {} { |
| |
| set changed {} |
| foreach var $_variables { |
| set changed [concat $changed [$var update]] |
| } |
| |
| return $changed |
| } |
| |
| itcl::body Block::info {} { |
| |
| return [list $_start $_end] |
| } |
| |
| # ------------------------------------------------------------------ |
| # Frame |
| # ------------------------------------------------------------------ |
| itcl::body Frame::constructor {addr} { |
| |
| set _addr $addr |
| |
| # Create all blocks in the selected frame |
| set _blocks {} |
| _createBlocks [gdb_get_blocks] |
| |
| } |
| |
| itcl::body Frame::destructor {} { |
| # destroy our own blocks |
| foreach block $_blocks { |
| _removeBlock $block |
| } |
| } |
| |
| itcl::body Frame::_removeBlock {blockObj} { |
| |
| set i [lsearch $_blocks $blockObj] |
| if {$i != -1} { |
| set _blocks [lreplace $_blocks $i $i] |
| delete object $blockObj |
| } |
| } |
| |
| itcl::body Frame::_addBlock {block} { |
| |
| set start [lindex $block 0] |
| set end [lindex $block 1] |
| set b [Block \#auto $start $end] |
| lappend _blocks $b |
| |
| return $b |
| } |
| |
| itcl::body Frame::_createBlocks {blocks} { |
| |
| foreach block $blocks { |
| set b [_addBlock $block] |
| } |
| } |
| |
| itcl::body Frame::update {} { |
| |
| set vars {} |
| foreach block $_blocks { |
| set vars [concat $vars [$block update]] |
| } |
| |
| return $vars |
| } |
| |
| itcl::body Frame::variables {} { |
| |
| set vars {} |
| foreach block $_blocks { |
| set vars [concat $vars [$block variables]] |
| } |
| |
| return $vars |
| } |
| |
| itcl::body Frame::new {} { |
| # find any new variables. So get a list of all blocks, |
| # eliminate duplicates, and get those variables. |
| |
| set blocks [gdb_get_blocks] |
| set new {} |
| |
| foreach block $blocks { |
| set b [_findBlock $block] |
| if {$b == ""} { |
| # Found a new block. Create it get its variables |
| set b [_addBlock $block] |
| set new [concat $new [$b variables]] |
| } |
| } |
| |
| return $new |
| } |
| |
| itcl::body Frame::deleteOld {} { |
| |
| foreach block [_oldBlocks] { |
| _removeBlock $block |
| } |
| } |
| |
| itcl::body Frame::_oldBlocks {} { |
| |
| set blocks [gdb_get_blocks] |
| set oldObjs $_blocks |
| |
| foreach block $blocks { |
| set obj [_findBlock $block] |
| if {$obj != ""} { |
| # Found it.. Remove it from old |
| set i [lsearch $oldObjs $obj] |
| set oldObjs [lreplace $oldObjs $i $i] |
| } |
| } |
| |
| return $oldObjs |
| } |
| |
| itcl::body Frame::old {} { |
| |
| # All the variables in the blocks in old are now gone... |
| # We don't remove blocks here, since the frontend viewer |
| # might want to keep these variables around for a little while |
| # longer. |
| set vars {} |
| set old [_oldBlocks] |
| foreach block $old { |
| set vars [concat $vars [$block variables]] |
| } |
| |
| return $vars |
| } |
| |
| itcl::body Frame::_findBlock {block} { |
| |
| foreach b $_blocks { |
| set info [$b info] |
| if {$info == $block} { |
| return $b |
| } |
| } |
| |
| return "" |
| } |
| |
| itcl::body Frame::_findBlockIndex {block} { |
| |
| set i 0 |
| foreach b $_blocks { |
| set info [$b info] |
| if {$info == $block} { |
| return $i |
| } |
| incr i |
| } |
| |
| return -1 |
| } |
| |
| |