OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [gdb/] [gdbtk/] [library/] [watch.tcl] - Blame information for rev 1765

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
# Watch window for Insight.
2
# Copyright 1997, 1998, 1999, 2001 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 watch windows for gdb. Inherits the VariableWin
17
# class from variables.tcl. 
18
# ----------------------------------------------------------------------
19
 
20
class WatchWin {
21
  inherit VariableWin
22
 
23
  # ------------------------------------------------------------------
24
  #  CONSTRUCTOR - create new locals window
25
  # ------------------------------------------------------------------
26
  constructor {args} {
27
    set Sizebox 0
28
 
29
    # Only allow one watch window for now...
30
    if {$init} {
31
      set init 0
32
    }
33
  }
34
 
35
  # ------------------------------------------------------------------
36
  # METHOD: build_win - build window for watch. This supplants the 
37
  #         one in VariableWin, so that we can add the entry at the
38
  #         bottom.
39
  # ------------------------------------------------------------------
40
  method build_win {f} {
41
    global tcl_platform
42
    #debug "$f"
43
 
44
    set Menu [build_menu_helper Watch]
45
    $Menu add command -label Remove -underline 0 \
46
      -command [format {
47
        %s remove [%s getSelection]
48
      } $this $this]
49
 
50
    set f [::frame $f.f]
51
    set treeFrame  [frame $f.top]
52
    set entryFrame [frame $f.expr]
53
    VariableWin::build_win $treeFrame
54
    set Entry [entry $entryFrame.ent -font src-font]
55
    button $entryFrame.but -text "Add Watch" -command [code $this validateEntry]
56
    pack $f -fill both -expand yes
57
    grid $entryFrame.ent -row 0 -column 0 -sticky news -padx 2
58
    grid $entryFrame.but -row 0 -column 1 -padx 2
59
    grid columnconfigure $entryFrame 0 -weight 1
60
    grid columnconfigure $entryFrame 1
61
 
62
    if {$tcl_platform(platform) == "windows"} {
63
      grid columnconfigure $entryFrame 1 -pad 20
64
      ide_sizebox [namespace tail $this].sizebox
65
      place [namespace tail $this].sizebox -relx 1 -rely 1 -anchor se
66
    }
67
 
68
    grid $treeFrame -row 0 -column 0 -sticky news
69
    grid $entryFrame -row 1 -column 0 -padx 5 -pady 5 -sticky news
70
    grid columnconfigure $f 0 -weight 1
71
    grid rowconfigure $f 0 -weight 1
72
    window_name "Watch Expressions"
73
    ::update idletasks
74
    # Binding for the entry
75
    bind $entryFrame.ent <Return> "$entryFrame.but flash; $entryFrame.but invoke"
76
 
77
  }
78
 
79
  method selectionChanged {entry} {
80
    VariableWin::selectionChanged $entry
81
 
82
    set state disabled
83
    set entry [getSelection]
84
    foreach var $Watched {
85
      set name [lindex $var 0]
86
      if {"$name" == "$entry"} {
87
        set state normal
88
        break
89
      }
90
    }
91
 
92
    $Menu entryconfigure last -state $state
93
  }
94
 
95
  method validateEntry {} {
96
    if {!$Running} {
97
      debug "Getting entry value...."
98
      set variable [$Entry get]
99
      debug "Got $variable, going to add"
100
      set ok [add $variable]
101
      debug "Added... with ok: $ok"
102
 
103
      $Entry delete 0 end
104
    }
105
  }
106
 
107
  # ------------------------------------------------------------------
108
  #  METHOD: clear_file - Clear out state so that a new executable
109
  #             can be loaded. For WatchWins, this means deleting
110
  #             the Watched list, in addition to the normal
111
  #             VariableWin stuff.
112
  # ------------------------------------------------------------------
113
  method clear_file {} {
114
    VariableWin::clear_file
115
    set Watched {}
116
  }
117
 
118
  # ------------------------------------------------------------------
119
  # DESTRUCTOR - delete watch window
120
  # ------------------------------------------------------------------
121
  destructor {
122
    foreach var $Watched {
123
      $var delete
124
    }
125
  }
126
 
127
  method postMenu {X Y} {
128
#    debug "$x $y"
129
 
130
    set entry [getEntry $X $Y]
131
 
132
    # Disable "Remove" if we are not applying this to the parent
133
    set found 0
134
    foreach var $Watched {
135
      set name [lindex $var 0]
136
      if {"$name" == "$entry"} {
137
        set found 1
138
        break
139
      }
140
    }
141
 
142
    # Ok, nasty, but a sad reality...
143
    set noStop [catch {$Popup index "Remove"} i]
144
    if {!$noStop} {
145
      $Popup delete $i
146
    }
147
    if {$found} {
148
      $Popup add command -label "Remove" -command "$this remove \{$entry\}"
149
    }
150
 
151
    VariableWin::postMenu $X $Y
152
  }
153
 
154
  method remove {entry} {
155
    global Display Update
156
 
157
    # Remove this entry from the list of watched variables
158
    set i [lsearch -exact $Watched $entry]
159
    if {$i == -1} {
160
      debug "WHAT HAPPENED?"
161
      return
162
    }
163
    set Watched [lreplace $Watched $i $i]
164
 
165
    set list [$Hlist info children $entry]
166
    lappend list $entry
167
    $Hlist delete entry $entry
168
 
169
    $entry delete
170
  }
171
 
172
  # ------------------------------------------------------------------
173
  # METHOD: getVariablesBlankPath
174
  # Overrides VarialbeWin::getVariablesBlankPath. For a Watch Window,
175
  # this method returns a list of watched variables.
176
  #
177
  # ONLY return items that need to be added to the Watch Tree
178
  # (or use deleteTree)
179
  # ------------------------------------------------------------------
180
  method getVariablesBlankPath {} {
181
#    debug
182
    set list {}
183
 
184
    set variables [displayedVariables {}]
185
    foreach var $variables {
186
      set name [$var name]
187
      set on($name) 1
188
    }
189
 
190
    foreach var $Watched {
191
      set name [$var name]
192
      if {![info exists on($name)]} {
193
        lappend list $var
194
      }
195
    }
196
 
197
    return $list
198
  }
199
 
200
  method update {event} {
201
    global Update Display
202
    debug "START WATCH UPDATE CALLBACK"
203
    catch {populate {}} msg
204
    catch {VariableWin::update dummy} msg
205
    debug "Did VariableWin::update with return \"$msg\""
206
 
207
    # Make sure all variables are marked as _not_ Openable?
208
    debug "END WATCH UPDATE CALLBACK"
209
  }
210
 
211
  method showMe {} {
212
    debug "Watched: $Watched"
213
  }
214
 
215
  # ------------------------------------------------------------------
216
  # METHOD: add - add a variable to the watch window
217
  # ------------------------------------------------------------------
218
  method add {name} {
219
      debug "Trying to add \"$name\" to watch"
220
 
221
    # Strip all the junk after the first \n
222
    set var [split $name \n]
223
    set var [lindex $var 0]
224
    set var [split $var =]
225
    set var [lindex $var 0]
226
 
227
    # Strip out leading/trailing +, -, ;, spaces, commas
228
    set var [string trim $var +-\;\ \r\n,]
229
 
230
    # Make sure that we have a valid variable
231
    set err [catch {gdb_cmd "set variable $var"} errTxt]
232
    if {$err} {
233
      dbug W "ERROR adding variable: $errTxt"
234
      ManagedWin::open WarningDlg -transient \
235
        -over $this -message [list $errTxt] -ignorable "watchvar"
236
    } else {
237
      if {[string index $var 0] == "\$"} {
238
        # We must make a special attempt at verifying convenience
239
        # variables.. Specifically, these are printed as "void"
240
        # when they are not defined. So if a user type "$_I_made_tbis_up",
241
        # gdb responds with the value "void" instead of an error
242
        catch {gdb_cmd "p $var"} msg
243
        set msg [split $msg =]
244
        set msg [string trim [lindex $msg 1] \ \r\n]
245
        if {$msg == "void"} {
246
          return 0
247
        }
248
      }
249
 
250
      debug "In add, going to add $name"
251
      # make one last attempt to get errors
252
      set err [catch {set foo($name) 1}]
253
      set err [expr {$err + [catch {expr {$foo($name) + 1}}]}]
254
      if {!$err} {
255
          set var [gdb_variable create -expr $name]
256
          set ::Update($this,$var) 1
257
          lappend Watched $var
258
          update dummy
259
          return 1
260
      }
261
    }
262
 
263
    return 0
264
  }
265
 
266
  protected variable Entry
267
  protected variable Watched {}
268
  protected variable Menu {}
269
  protected common init 1
270
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.