gdb/gdbtk/library/process.itb

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