# Kernel Object Display Window for Insight.
# Copyright (C) 1998, 1999, 2001 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.
#
# AUTHOR: Fernando Nasser <fnasser@cygnus.com>
#
# ------------------------------------------------------------------
# CONSTRUCTOR - create new process window
# ------------------------------------------------------------------
itcl::body KodWin::constructor {args} {
#
# Create a window with the same name as this object
#
global gdb_kod_cmd
# initialize local variables
set LevelCmd(0) "info $gdb_kod_cmd "
debug "Level 0 kod command is $LevelCmd(0)"
gdbtk_busy
build_win
gdbtk_idle
}
# ------------------------------------------------------------------
# METHOD: build_win - build the main KOD window
# ------------------------------------------------------------------
itcl::body KodWin::build_win {} {
# FIXME: rename this variable.
global kodActivePane
debug "Will build KOD window"
cyg::PanedWindow $itk_interior.pw -orient horizontal
$itk_interior.pw add titlepane
# We would like to use a fixed pane for the buttons. However,
# this feature of PanedWindow doesn't work.
# $itk_interior.pw add buttonpane -resizable 0
$itk_interior.pw add pane1
$itk_interior.pw add pane2
# Now a frame for what is being listed, headers and list
set tp [$itk_interior.pw childsite titlepane]
Labelledframe $tp.tf -text "No Kernel Objects Known" \
-anchor nw
set titl $tp.tf
set lf [$tp.tf get_frame]
set p1 [$itk_interior.pw childsite pane1]
set p2 [$itk_interior.pw childsite pane2]
$p1 configure -height 120 -bd 2
$p2 configure -height 120 -bd 2
Labelledframe $p1.d1 -text "Details" -anchor nw
Labelledframe $p2.d2 -text "Details" -anchor nw
set d1 [$p1.d1 get_frame]
set d2 [$p2.d2 get_frame]
pack $p1.d1 $p2.d2 -side top -expand yes -fill both -padx 5 -pady 5
set pl1 $p1.d1
set pl2 $p2.d2
# Setup the button box
set bf [frame $tp.bf]
set BTop [button $bf.top -height 1 -text Top -command [code $this top]]
set BUp [button $bf.up -height 1 -text Up -command [code $this up]]
set BClear [button $bf.clear -height 1 -text Clear \
-command [code $this clear]]
set BDisplay [button $bf.display -height 1 -text Display \
-command [code $this display]]
set kodActivePane pane1
set BPane1 [radiobutton $bf.pane1 -variable kodActivePane \
-height 1 -text "Pane 1" -value pane1]
set BPane2 [radiobutton $bf.pane2 -variable kodActivePane \
-height 1 -text "Pane 2" -value pane2]
balloon register $bf.top "Return to List of Kernel Objects"
balloon register $bf.up "Return to previous List of Objects"
balloon register $bf.clear "Clear Object Detail Panes\nand Active setting"
balloon register $bf.display \
"Display Object or\nList of Objects of this type"
balloon register $bf.pane1 "Make Pane 1 Active"
balloon register $bf.pane2 "Make Pane 2 Active"
pack $bf.top $bf.up -side left -padx 5
pack $bf.display $bf.clear -side right -padx 5
pack $bf.pane2 $bf.pane1 -side bottom -padx 5 -fill both
# The list of objects
table $lf.s -titlerows 1 \
-colstretch last -rowstretch last -selectmode single \
-selecttype row -variable $this \
-yscrollcommand "$lf.sb set" -resizeborders none \
-state disabled
scrollbar $lf.sb -orient vertical -command "$lf.s yview"
bind $lf.s <Double-1> [code $this display]
$lf.s tag configure coltag -anchor nw
grid $lf.s -row 0 -column 0 -sticky nsew
grid $lf.sb -row 0 -column 1 -sticky nsw
grid columnconfigure $lf 0 -weight 1
grid rowconfigure $lf 0 -weight 1
# Areas to display object details
set t1 [table $d1.t1 -titlerows 1 -colstretch last -rowstretch last \
-selectmode single -selecttype row -variable $this-pane1 \
-yscrollcommand "$d1.s1 set" -resizeborders none \
-rows 1 -cols 1 -state disabled]
scrollbar $d1.s1 -orient vertical -command "$d1.t1 yview"
set t2 [table $d2.t2 -titlerows 1 -colstretch last -rowstretch last \
-selectmode single -selecttype row -variable $this-pane2 \
-yscrollcommand "$d2.s2 set" -resizeborders none \
-rows 1 -cols 1 -state disabled]
scrollbar $d2.s2 -orient vertical -command "$d2.t2 yview"
grid $d1.t1 -row 0 -column 0 -sticky nsew
grid $d1.s1 -row 0 -column 1 -sticky nsw
grid columnconfigure $d1 0 -weight 1
grid rowconfigure $d1 0 -weight 1
grid $d2.t2 -row 0 -column 0 -sticky nsew
grid $d2.s2 -row 0 -column 1 -sticky nsw
grid columnconfigure $d2 0 -weight 1
grid rowconfigure $d2 0 -weight 1
debug "Will pack KOD window"
pack $tp.tf -side top -expand yes -fill both -padx 5 -pady 5
pack $tp.bf -side top -expand no -fill x -padx 5 -pady 5
pack $itk_interior.pw -side bottom -expand yes -fill both
wm minsize $_top 450 500
# Initialize button state variables for idle (called before update)
set BState(BDisplay) disabled
set BState(BClear) disabled
set BState(BTop) disabled
set BState(BUp) disabled
# window_name "Kernel Objects"
update dummy
}
# ------------------------------------------------------------------
# METHOD: update - update widget when something changes
# ------------------------------------------------------------------
itcl::body KodWin::update {event} {
debug "updating kod window"
_disable_buttons
display_list
display_object
_restore_buttons
}
# ------------------------------------------------------------------
# METHOD: display - update the display based on the selection
# it can be a list or an actual object
# We get here from a press on the Display button or
# from a <Double-1> on a line of the list of objects
# ------------------------------------------------------------------
itcl::body KodWin::display {} {
upvar \#0 $this table_vals
if {!$Running && [$lf.s cget -rows] > 1} {
gdbtk_busy
set linenum [$lf.s index active row]
set object $table_vals($linenum,0)
debug "display selection on line $linenum $object"
incr level
set LevelCmd($level) $LevelCmd([expr $level-1])
append LevelCmd($level) $object
debug "kod command for level $level is now: $LevelCmd($level)"
update dummy
# Run idle hooks and cause all other widgets to update
gdbtk_idle
}
}
# ------------------------------------------------------------------
# METHOD: display_list - display list of objects
# ------------------------------------------------------------------
itcl::body KodWin::display_list {} {
upvar \#0 $this table_vals
debug "displaying list of objects"
$lf.s configure -state normal
set cmd $LevelCmd($level)
debug "new kod command is $cmd"
if {[catch "gdb_cmd \"$cmd\"" objects]} {
# failed. leave window blank
$titl configure -text "Kernel Object Display Failed"
$lf.s delete rows 0 [$lf.s index end row]
$lf.s configure -state disabled
set BState(BDisplay) disabled
return
}
debug "KodWin update: \n$objects"
if {[llength $objects] == 0} {
$titl configure -text "No Kernel Objects Known"
# no objects listed.
$lf.s delete rows 0 [$lf.s index end row]
$lf.s configure -state disabled
set BState(BDisplay) disabled
return
}
# insert each line one at a time
set num_lines -1
foreach line [split $objects \n] {
if {$num_lines == -1} {
if {![string match List* $line]} {
if {($level > 0)} {
display_object $cmd objects
incr level -1
$lf.s configure -state disabled
return
} else {
# if level 0 first line does not start with List ignore it
$titl configure -text "List of Kernel Objects"
}
} else {
$titl configure -text $line
}
# Clear listbox and headers to get new stuff.
$lf.s delete rows 0 [$lf.s index end row]
} elseif {$line == ""} {
break
} else {
set col 0
set list [split [string trim $line] \t]
if {$num_lines == 0} {
$lf.s configure -cols [llength $list] -titlerows 1
}
foreach item $list {
debug "inserting $item at $num_lines,$col"
set table_vals($num_lines,$col) $item
incr col
}
}
incr num_lines
}
$lf.s configure -rows [expr {$num_lines + 1}]
if {$num_lines > 0} {
set BState(BDisplay) active
}
if {$level == 0} {
set BState(BTop) disabled
set BState(BUp) disabled
} else {
set BState(BTop) active
set BState(BUp) active
}
$lf.s configure -state disabled
$lf.s see 0,0
$lf.s activate 1,0
_restore_buttons
}
# ------------------------------------------------------------------
# METHOD: display_object - display information about an object
# When called from update we have to reissue the gdb
# command to get fresh data
# ------------------------------------------------------------------
itcl::body KodWin::display_object {{cmd ""} {obj ""}} {
debug "Displaying object details..."
upvar $obj objects
global kodActivePane
debug "Active Pane is $kodActivePane"
# Determine which frame to use
if {$kodActivePane == "pane2"} {
set curpan $t2
upvar \#0 $this-pane2 pane_values
if {$cmd != ""} {
# save command for update
set pane2command $cmd
} else {
# reuse saved command
set cmd $pane2command
}
} else {
set curpan $t1
upvar \#0 $this-pane1 pane_values
if {$cmd != ""} {
# save command for update
set pane1command $cmd
} else {
# reuse saved command
set cmd $pane1command
}
}
debug "curpan $curpan"
# here we must take care of the case where the user has activated a window
# but it does not have been filled yet. We just return.
if {$cmd == ""} {
return
}
$curpan configure -state normal
$curpan delete rows 0 [$curpan index end row]
if {$obj == ""} {
debug "pane kod command is $cmd"
if {[catch "gdb_cmd \"$cmd\"" objects]
|| $objects == ""} {
# Failed. Tell user object no longer there.
$curpan configure -state disabled
return
}
}
set num_lin 0
foreach line [split $objects \n] {
set col 0
set list [split [string trim $line] \t]
if {$num_lin == 0} {
$curpan configure -cols [llength $list]
}
foreach item $list {
set pane_values($num_lin,$col) $item
incr col
}
incr num_lin
}
$curpan configure -rows $num_lin -state disabled
}
# ------------------------------------------------------------------
# METHOD: clear - clear detail panes and reset pane selection
# ------------------------------------------------------------------
itcl::body KodWin::clear {} {
debug "going to clear detail panes and pane selection"
$t1 configure -state normal
$t2 configure -state normal
$t1 delete rows 0 [$t1 index end row]
$t2 delete rows 0 [$t2 index end row]
$t1 configure -state disabled
$t2 configure -state disabled
# Default to pane 1 again.
global kodActivePane
set kodActivePane pane1
set pane1command ""
set pane2command ""
}
# ------------------------------------------------------------------
# METHOD: top - go to the list of types of objects (top level)
# ------------------------------------------------------------------
itcl::body KodWin::top {} {
debug "going to top from level $level"
if {$level > 0} {
set level 0
update dummy
}
}
# ------------------------------------------------------------------
# METHOD: up - go to the list of objects which led to the current one
# ------------------------------------------------------------------
itcl::body KodWin::up {} {
debug "going up from level $level..."
if {$level > 0} {
incr level -1
debug "...to level $level"
update dummy
}
}
# ------------------------------------------------------------------
# DESTRUCTOR - destroy window containing widget
# ------------------------------------------------------------------
itcl::body KodWin::destructor {} {
upvar \#0 $this table_vals $this-pane1 pane1_vals $this-pane2 pane2_vals
global kodActivePane
catch {unset table_vals}
catch {unset pane1_vals}
catch {unset pane2_vals}
catch {unset kodActivePane}
}
# ------------------------------------------------------------------
# PUBLIC METHOD: set_variable - called when user runs `set os'
# command
# ------------------------------------------------------------------
itcl::body KodWin::set_variable {event} {
set value [$event get value]
if {[$event get variable] == "os" && $value != ""} {
set LevelCmd(0) "info $value "
set level 0
update dummy
}
}
# ------------------------------------------------------------------
# METHOD: reconfig - used when preferences change
# ------------------------------------------------------------------
itcl::body KodWin::reconfig {} {
destroy $itk_interior.bf
destroy $titl
build_win
}
# ------------------------------------------------------------------
# METHOD: busy - BusyEvent handler
#
# This method should accomplish blocking
# - clicks in the window
# - change mouse pointer
# ------------------------------------------------------------------
itcl::body KodWin::busy {event} {
set Running 1
_disable_buttons
cursor watch
}
# ------------------------------------------------------------------
# METHOD: idle - idle event handler. Run when the target is not
# running
# ------------------------------------------------------------------
itcl::body KodWin::idle {event} {
set Running 0
_restore_buttons
cursor {}
}
# ------------------------------------------------------------------
# METHOD: cursor - set the window cursor
# This is a convenience method which simply sets the mouse
# pointer to the given glyph.
# ------------------------------------------------------------------
itcl::body KodWin::cursor {glyph} {
$_top configure -cursor $glyph
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _disable_buttons - disable all buttons
# Used when we are busy and can't take another event
# ------------------------------------------------------------------
itcl::body KodWin::_disable_buttons {} {
$BTop configure -state disabled
$BUp configure -state disabled
$BDisplay configure -state disabled
$BClear configure -state disabled
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _restore_buttons - restore all buttons to their
# previous states.
# Used when we are busy and can't take another event
# ------------------------------------------------------------------
itcl::body KodWin::_restore_buttons {} {
$BTop configure -state $BState(BTop)
$BUp configure -state $BState(BUp)
$BDisplay configure -state $BState(BDisplay)
# CLEAR is always active, except when busy
$BClear configure -state active
}