blob: 80c1bed8a0072cc5ad9e06e0ed9fbe4598d8a855 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
# Process window for Insight.
# Copyright 1998, 1999, 2001, 2002 Red Hat, Inc.
#
# 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 a process window with a list of threads, tasks, and/or
# processes to debug.
#
# ----------------------------------------------------------------------
itcl::body ProcessWin::constructor {args} {
window_name "Processes"
gdbtk_busy
build_win
gdbtk_idle
# Add hooks for this object
add_hook gdb_no_inferior_hook [code $this idle]
}
# ------------------------------------------------------------------
# METHOD: build_win - build the main process window
# ------------------------------------------------------------------
itcl::body ProcessWin::build_win {} {
global tcl_platform
if {$tcl_platform(platform) == "windows"} {
set hsmode static
set vsmode static
ide_sizebox $itk_interior.sbox
place $itk_interior.sbox -relx 1.0 -rely 1.0 -anchor se
} else {
set hsmode dynamic
set vsmode dynamic
}
itk_component add slbox {
iwidgets::scrolledlistbox $itk_interior.slbox \
-background $::Colors(bg) \
-selectbackground $::Colors(sbg) -selectforeground $::Colors(sfg) \
-textfont global/fixed \
-exportselection false \
-selectioncommand [code $this change_context]
} {}
[$itk_component(slbox) component listbox] configure \
-bg $::Colors(textbg) -fg $::Colors(textfg)
update dummy
pack $itk_component(slbox) -side left -expand yes -fill both
}
# ------------------------------------------------------------------
# METHOD: update - update widget when something changes
# ------------------------------------------------------------------
itcl::body ProcessWin::update {event} {
if {!$protect_me} {
$itk_component(slbox) delete 0 end
if {[catch {gdb_cmd "info thread"} threads]} {
# failed. leave window blank
return
}
set threads [split $threads \n]
debug "processWin update: \n$threads"
if {[llength $threads] == 0} {
# no processes/threads listed.
return
}
# insert each line one at a time
set active -1
set num_threads 0
foreach line $threads {
# Active line starts with "*"
if {[string index $line 0] == "*"} {
# strip off leading "*"
set line " [string trimleft $line "*"]"
set active $num_threads
}
# scan for GDB ID number at start of line
if {[scan $line "%d" id($num_threads)] == 1} {
$itk_component(slbox) insert end $line
incr num_threads
}
}
# highlight the active thread
if {$active >= 0} {
set active_thread $id($active)
$itk_component(slbox) selection set $active
$itk_component(slbox) see $active
}
}
}
# ------------------------------------------------------------------
# METHOD: change_context - change the current context (active thread)
# This method is currently ONLY called from the mouse binding
# ------------------------------------------------------------------
itcl::body ProcessWin::change_context {} {
if {!$Running && [$itk_component(slbox) size] != 0} {
gdbtk_busy
set sel [$itk_component(slbox) curselection]
set idnum $id($sel)
#debug "change_context to line $sel id=$idnum"
catch {gdb_cmd "thread $idnum"}
# Run idle hooks and cause all widgets to update
set protect_me 1
gdbtk_update
set protect_me 0
gdbtk_idle
}
}
# ------------------------------------------------------------------
# DESTRUCTOR - destroy window containing widget
# ------------------------------------------------------------------
itcl::body ProcessWin::destructor {} {
remove_hook gdb_no_inferior_hook [code $this no_inferior]
}
# ------------------------------------------------------------------
# METHOD: reconfig - used when preferences change
# ------------------------------------------------------------------
itcl::body ProcessWin::reconfig {} {
destroy $itk_interior.s
if {[winfo exists $itk_interior.sbox]} { destroy $itk_interior.sbox }
if {[winfo exists $itk_interior.slbox]} { destroy $itk_interior.slbox }
build_win
}
# ------------------------------------------------------------------
# METHOD: busy - BusyEvent handler
#
# This method should accomplish blocking
# - clicks in the window
# - change mouse pointer
# ------------------------------------------------------------------
itcl::body ProcessWin::busy {event} {
set Running 1
cursor watch
}
# ------------------------------------------------------------------
# METHOD: idle - handle IdleEvent
# ------------------------------------------------------------------
itcl::body ProcessWin::idle {event} {
set Running 0
cursor {}
}
# ------------------------------------------------------------------
# METHOD: cursor - set the window cursor
# This is a convenience method which simply sets the mouse
# pointer to the given glyph.
# ------------------------------------------------------------------
itcl::body ProcessWin::cursor {glyph} {
$_top configure -cursor $glyph
}
|
