| # 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 |
| } |