| # Watch window for Insight. |
| # Copyright (C) 2002, 2003, 2006 Red Hat |
| # |
| # 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. |
| |
| |
| # ---------------------------------------------------------------------- |
| # Implements watch windows for gdb. |
| # ---------------------------------------------------------------------- |
| |
| itcl::class WatchWin { |
| inherit EmbeddedWin GDBWin |
| # ------------------------------------------------------------------ |
| # CONSTRUCTOR - create new watch window |
| # ------------------------------------------------------------------ |
| constructor {args} { |
| debug |
| |
| gdbtk_busy |
| build_win $itk_interior |
| gdbtk_idle |
| |
| add_hook gdb_no_inferior_hook "$this no_inferior" |
| add_hook gdb_clear_file_hook [code $this clear_file] |
| add_hook file_changed_hook [code $this clear_file] |
| } |
| |
| |
| # ------------------------------------------------------------------ |
| # PUBLIC METHOD: busy - BusyEvent handler |
| # Disable all ui elements that could affect gdb's state |
| # ------------------------------------------------------------------ |
| method busy {event} { |
| debug |
| set Running 1 |
| cursor watch |
| } |
| |
| # Re-enable the UI |
| method idle {event} { |
| debug |
| set Running 0 |
| cursor {} |
| } |
| |
| # ------------------------------------------------------------------ |
| # METHOD: no_inferior |
| # Reset this object. |
| # ------------------------------------------------------------------ |
| method no_inferior {} { |
| debug |
| cursor {} |
| set Running 0 |
| foreach var $Watched { |
| $var delete |
| } |
| $tree remove all |
| } |
| |
| # ------------------------------------------------------------------ |
| # METHOD: cursor - change the toplevel's cursor |
| # ------------------------------------------------------------------ |
| method cursor {what} { |
| [winfo toplevel [namespace tail $this]] configure -cursor $what |
| ::update idletasks |
| } |
| |
| |
| # ------------------------------------------------------------------ |
| # METHOD: build_win - build window for watch. |
| # ------------------------------------------------------------------ |
| method build_win {f} { |
| #debug "$f" |
| |
| set f [::frame $f.f] |
| set treeFrame [frame $f.top] |
| set entryFrame [frame $f.expr] |
| |
| set tree [VarTree $treeFrame.tree] |
| pack $tree -expand yes -fill both |
| |
| set Entry [entry $entryFrame.ent -font global/fixed] |
| button $entryFrame.but -text "Add Watch" -command [code $this validateEntry] |
| pack $f -fill both -expand yes |
| grid $entryFrame.ent -row 0 -column 0 -sticky news -padx 2 |
| grid $entryFrame.but -row 0 -column 1 -padx 2 |
| grid columnconfigure $entryFrame 0 -weight 1 |
| grid columnconfigure $entryFrame 1 |
| |
| grid $treeFrame -row 0 -column 0 -sticky news |
| grid $entryFrame -row 1 -column 0 -padx 5 -pady 5 -sticky news |
| grid columnconfigure $f 0 -weight 1 |
| grid rowconfigure $f 0 -weight 1 |
| window_name "Watch" |
| ::update idletasks |
| # Binding for the entry |
| bind $entryFrame.ent <Return> "$entryFrame.but flash; $entryFrame.but invoke" |
| } |
| |
| method validateEntry {} { |
| if {!$Running} { |
| debug "Getting entry value...." |
| set variable [$Entry get] |
| debug "Got $variable, going to add" |
| set ok [add $variable] |
| debug "Added... with ok: $ok" |
| $Entry delete 0 end |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # METHOD: clear_file - Clear out state so that a new executable |
| # can be loaded. For WatchWins, this means doing |
| # everything that no_inferior does. |
| # ------------------------------------------------------------------ |
| method clear_file {} { |
| debug |
| no_inferior |
| } |
| |
| # ------------------------------------------------------------------ |
| # DESTRUCTOR - delete watch window |
| # ------------------------------------------------------------------ |
| destructor { |
| debug |
| set tree {} |
| |
| # Remove this window and all hooks |
| remove_hook gdb_no_inferior_hook "$this no_inferior" |
| remove_hook gdb_clear_file_hook [code $this clear_file] |
| remove_hook file_changed_hook [code $this clear_file] |
| |
| foreach var $Watched { |
| $var delete |
| } |
| } |
| |
| method remove {entry} { |
| debug $entry |
| |
| # Remove this entry from the list of watched variables |
| set Watched [lremove $Watched $entry] |
| |
| $entry remove |
| $entry delete |
| } |
| |
| |
| method update {event} { |
| $tree update |
| } |
| |
| |
| # ------------------------------------------------------------------ |
| # METHOD: add - add a variable to the watch window |
| # ------------------------------------------------------------------ |
| method add {name} { |
| debug "Trying to add \"$name\" to watch" |
| |
| # Strip all the junk after the first \n |
| set var [split $name \n] |
| set var [lindex $var 0] |
| set var [split $var =] |
| set var [lindex $var 0] |
| |
| # Strip out leading/trailing +, -, ;, spaces, commas |
| set var [string trim $var +-\;\ \r\n,] |
| |
| # Make sure that we have a valid variable |
| set err [catch {gdb_cmd "set variable $var"} errTxt] |
| if {$err} { |
| dbug W "ERROR adding variable: $errTxt" |
| ManagedWin::open WarningDlg -transient \ |
| -over $this -message [list $errTxt] -ignorable "watchvar" |
| } else { |
| if {[string index $var 0] == "\$"} { |
| # We must make a special attempt at verifying convenience |
| # variables.. Specifically, these are printed as "void" |
| # when they are not defined. So if a user type "$_I_made_tbis_up", |
| # gdb responds with the value "void" instead of an error |
| catch {gdb_cmd "p $var"} msg |
| set msg [split $msg =] |
| set msg [string trim [lindex $msg 1] \ \r\n] |
| if {$msg == "void"} { |
| return 0 |
| } |
| } |
| |
| debug "In add, going to add $name" |
| # make one last attempt to get errors |
| set err [catch {set foo($name) 1}] |
| debug "err1=$err" |
| set err [expr {$err + [catch {expr {$foo($name) + 1}}]}] |
| debug "err2=$err" |
| if {!$err} { |
| set var [gdb_variable create -expr $name] |
| debug "var=$var" |
| $tree add $var |
| lappend Watched $var |
| return 1 |
| } |
| } |
| return 0 |
| } |
| |
| protected variable Entry |
| protected variable Watched {} |
| protected variable tree |
| protected variable Running |
| } |