gdb/gdbtk/library/locals.tcl

   1 # Local Variable Window for Insight.
   2 # Copyright (C) 2002, 2003, 2006 Red Hat
   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 # ----------------------------------------------------------------------
  16 # Implements local variables windows for gdb.
  17 # ----------------------------------------------------------------------
  18
  19 itcl::class LocalsWin {
  20   inherit EmbeddedWin GDBWin
  21   # ------------------------------------------------------------------
  22   #  CONSTRUCTOR - create new locals window
  23   # ------------------------------------------------------------------
  24   constructor {args} {
  25     debug
  26
  27     gdbtk_busy
  28     build_win $itk_interior
  29     gdbtk_idle
  30
  31     add_hook gdb_no_inferior_hook "$this no_inferior"
  32     add_hook gdb_clear_file_hook [code $this clear_file]
  33     add_hook file_changed_hook [code $this clear_file]
  34
  35     update dummy
  36   }
  37
  38
  39   # ------------------------------------------------------------------
  40   #   PUBLIC METHOD:  busy - BusyEvent handler
  41   #           Disable all ui elements that could affect gdb's state
  42   # ------------------------------------------------------------------
  43   method busy {event} {
  44     debug
  45     cursor watch
  46   }
  47
  48   # Re-enable the UI
  49   method idle {event} {
  50     debug
  51     cursor {}
  52   }
  53
  54   # ------------------------------------------------------------------
  55   # METHOD:   no_inferior
  56   #           Reset this object.
  57   # ------------------------------------------------------------------
  58   method no_inferior {} {
  59     debug
  60     cursor {}
  61     catch {delete object $_frame}
  62     set _frame {}
  63     $tree remove all
  64   }
  65
  66   # ------------------------------------------------------------------
  67   #  METHOD:  cursor - change the toplevel's cursor
  68   # ------------------------------------------------------------------
  69   method cursor {what} {
  70     [winfo toplevel [namespace tail $this]] configure -cursor $what
  71     ::update idletasks
  72   }
  73
  74
  75   # ------------------------------------------------------------------
  76   # METHOD: build_win - build window for variables.
  77   # ------------------------------------------------------------------
  78   method build_win {f} {
  79     #debug "$f"
  80
  81     set tree [VarTree $f.tree -type "local"]
  82     pack $f.tree -expand yes -fill both
  83     pack $f -expand yes -fill both
  84
  85     window_name "Local Variables"
  86     ::update idletasks
  87   }
  88
  89
  90   # ------------------------------------------------------------------
  91   #  METHOD: clear_file - Clear out state so that a new executable
  92   #             can be loaded. For LocalWins, this means doing
  93   #             everything that no_inferior does.
  94   # ------------------------------------------------------------------
  95   method clear_file {} {
  96     no_inferior
  97   }
  98
  99   # ------------------------------------------------------------------
 100   # DESTRUCTOR - delete locals window
 101   # ------------------------------------------------------------------
 102   destructor {
 103     debug
 104     set tree {}
 105
 106     # Remove this window and all hooks
 107     remove_hook gdb_no_inferior_hook "$this no_inferior"
 108     remove_hook gdb_clear_file_hook [code $this clear_file]
 109     remove_hook file_changed_hook [code $this clear_file]
 110   }
 111
 112   method context_switch {} {
 113     debug
 114
 115     set err [catch {gdb_selected_frame} current_frame]
 116     #debug "1: err=$err; _frame=\"$_frame\"; current_frame=\"$current_frame\""
 117
 118     if {$err && $_frame != ""} {
 119       # No current frame
 120       debug "no current frame"
 121       catch {delete object $_frame}
 122       set _frame {}
 123       return 1
 124     } elseif {$current_frame == "" && $_frame == ""} {
 125       #debug "2"
 126       return 0
 127     } elseif {$_frame == "" || $current_frame != [$_frame address]} {
 128       # We've changed frames. If we knew something about
 129       # the stack layout, we could be more intelligent about
 130       # destroying variables, but we don't know that here (yet).
 131       debug "switching to frame at $current_frame"
 132
 133       # Destroy the old frame and create the new one
 134       catch {destroy $_frame}
 135       set _frame [Frame ::\#auto $current_frame]
 136       debug "created new frame: $_frame at [$_frame address]"
 137       return 1
 138     }
 139
 140     # Nothing changed
 141     #debug "3"
 142     return 0
 143   }
 144
 145
 146   method update {event} {
 147     debug
 148
 149     # Check that a context switch has not occured
 150     if {[context_switch]} {
 151       debug "CONTEXT SWITCH"
 152
 153       # delete variables in tree
 154       $tree remove all
 155
 156       if {$_frame != ""} {
 157         $tree add [$_frame variables]
 158       }
 159     } else {
 160       if {$_frame == ""} {return}
 161       # check for any new variables in the same frame
 162       $tree add [$_frame new]
 163     }
 164     after idle [code $tree update]
 165   }
 166
 167   protected variable Entry
 168   protected variable tree
 169   protected variable _frame {}
 170 }