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  [code $this change_context %y]

  bind $lb  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

}