neingeist
/
arduinisten
Archived
1
0
Fork 0
You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
This repo is archived. You can view files and clone it, but cannot push or open issues/pull-requests.

162 lines
5.1 KiB
Plaintext

# Process window for Insight.
# Copyright (C) 1998, 1999, 2001, 2002, 2008 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 {} {
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.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
}