Subversion Repositories or1k

# Process window for GDBtk.
# Copyright 1998, 1999 Cygnus Solutions
#
# 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.
#
# ----------------------------------------------------------------------

body ProcessWin::constructor {args} {
  set top [winfo toplevel $itk_interior]

  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
# ------------------------------------------------------------------
body ProcessWin::build_win {} {
  global tixOption tcl_platform
  if {$tcl_platform(platform) == "windows"} {
    tixScrolledListBox $itk_interior.s -scrollbar both -sizebox 1
  } else {
    tixScrolledListBox $itk_interior.s -scrollbar auto
  }
  set lb [$itk_interior.s subwidget listbox]
  $lb configure -selectmode single -bg $tixOption(input1_bg) \
    -selectbackground green \
    -selectforeground black \
    -font src-font          \
    -exportselection false
  update dummy
  balloon register $lb "Click on a line to change context"

  # bind mouse button 1 to change the current context
  bind $lb <ButtonPress-1> [code $this change_context %y]
  bind $lb <ButtonRelease-1> break

  pack $itk_interior.s -side left -expand yes -fill both
}


# ------------------------------------------------------------------
#  METHOD:  update - update widget when something changes
# ------------------------------------------------------------------
body ProcessWin::update {event} {
  if {!$protect_me} {

    $lb delete 0 end
    if {[catch {gdb_cmd "info thread"} threads]} {
      # failed.  leave window blank
      return
    }

    #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 [split $threads \n] {
      # 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} {
        $lb insert end $line
        incr num_threads
      }
    }
    
    # highlight the active thread
    if {$active >= 0} {
      set active_thread $id($active)
      $lb selection set $active
      $lb see $active
    }
  }
}

# ------------------------------------------------------------------
#  METHOD:  change_context - change the current context (active thread)
#        This method is currently ONLY called from the mouse binding
# ------------------------------------------------------------------
body ProcessWin::change_context {y} {
  if {!$Running && [$lb size] != 0} {
    gdbtk_busy
    set linenum [$lb nearest $y]
    set idnum $id($linenum)
    #debug "change_context to line $linenum  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
# ------------------------------------------------------------------
body ProcessWin::destructor {} {
  remove_hook gdb_no_inferior_hook [code $this no_inferior]
}

# ------------------------------------------------------------------
#  METHOD:  reconfig - used when preferences change
# ------------------------------------------------------------------
body ProcessWin::reconfig {} {
  destroy $itk_interior.s
  build_win
}

# ------------------------------------------------------------------
#  METHOD:  busy - BusyEvent handler
#
#        This method should accomplish blocking
#        - clicks in the window
#        - change mouse pointer
# ------------------------------------------------------------------
body ProcessWin::busy {event} {
  set Running 1
  cursor watch
}

# ------------------------------------------------------------------
#  METHOD:  idle - handle IdleEvent
# ------------------------------------------------------------------
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.
# ------------------------------------------------------------------
body ProcessWin::cursor {glyph} {
  $top configure -cursor $glyph
}