itcl::class ActionDlg {
inherit ManagedWin
constructor {args} {
global _TStepCount _TOtherVariable
eval itk_initialize $args
set Registers [gdb_reginfo name]
if {$Line != ""} {
set Locals [gdb_get_locals "$File:$Line"]
set Args [gdb_get_args "$File:$Line"]
} else {
set Locals [gdb_get_locals "*$Address"]
set Args [gdb_get_args "*$Address"]
}
set Variables [concat $Locals $Args]
foreach a $Registers {
lappend Variables "\$$a"
}
if {[llength $Args] > 0} {
lappend Variables "All Arguments"
}
if {[llength $Locals] > 0} {
lappend Variables "All Locals"
}
lappend Variables "All Registers"
lappend Variables "Collect Stack"
build_win
set _TOtherVariable {}
if {"$Data" != {}} {
change 1 $Data
}
}
destructor {
eval $Callback cancel
}
method build_win {} {
global _TStepCount _TOtherVariable
set f $itk_interior
set bbox [frame $f.bbox]; set data [frame $f.data];
button $bbox.ok -text OK -command "$this ok"
button $bbox.cancel -text CANCEL -command "$this cancel"
pack $bbox.ok $bbox.cancel -side left -padx 10 -expand yes
set top [frame $data.top]
set bot [frame $data.bot]
set boxes [frame $top.boxes]
set cFrame [frame $boxes.cFrame]
set vFrame [frame $boxes.vFrame]
set bFrame [frame $boxes.bframe]
set oFrame [frame $top.uFrame]
pack $cFrame $bFrame $vFrame -side left -expand yes -padx 5
if {$WhileStepping} {
set step_frame [frame $top.stepf]
label $step_frame.whilelbl -text {While Stepping, Steps:}
set WhileSteppingEntry [entry $step_frame.steps \
-textvariable _TStepCount \
-width 5]
pack $step_frame.whilelbl $WhileSteppingEntry -side left
}
label $cFrame.lbl -text {Collect:}
set CollectLB [iwidgets::scrolledlistbox $cFrame.lb -hscrollmode dynamic \
-vscrollmode dynamic \
-selectioncommand [code $this toggle_button_state 0] \
-dblclickcommand [code $this change 0] \
-selectmode extended \
-exportselection false]
[$CollectLB component listbox] configure -background gray92
pack $cFrame.lbl $cFrame.lb -side top -expand yes -pady 2
label $vFrame.lbl -text {Variables:}
set VariablesLB [iwidgets::scrolledlistbox $vFrame.lb -hscrollmode dynamic \
-vscrollmode dynamic \
-selectioncommand [code $this toggle_button_state 1] \
-dblclickcommand [code $this change 1] \
-selectmode extended \
-exportselection false]
[$VariablesLB component listbox] configure -background gray92
pack $vFrame.lbl $vFrame.lb -side top -expand yes -pady 2
set AddButton [button $bFrame.add -text {<<< Collect} \
-command "$this change 1" -state disabled]
set RemoveButton [button $bFrame.del -text {Ignore >>>} \
-command "$this change 0" -state disabled]
pack $bFrame.add $bFrame.del -side top -expand yes -pady 5
label $oFrame.lbl -text {Other:}
set OtherEntry [entry $oFrame.ent -textvariable _TOtherVariable]
pack $oFrame.lbl $OtherEntry -side left
bind $OtherEntry <Return> "$this change_other"
if {$WhileStepping} {
pack $step_frame -side top
}
pack $boxes $oFrame -side top -padx 5 -pady 5
pack $top $bot -side top
fill_listboxes
pack $f.data $bbox -side top -padx 4 -pady 2 \
-expand yes -fill x
if {$WhileStepping} {
$WhileSteppingEntry delete 0 end
$WhileSteppingEntry insert 0 $Steps
}
}
method toggle_button_state {add} {
if {$add} {
set a [$VariablesLB getcurselection]
if {"$a" != ""} {
$AddButton configure -state normal
$RemoveButton configure -state disabled
}
} else {
set a [$CollectLB getcurselection]
if {"$a" != ""} {
$AddButton configure -state disabled
$RemoveButton configure -state normal
}
}
}
method fill_listboxes {{last {}}} {
if {[info exists Collect]} {
fill_collect $last
}
fill_variables $last
}
method change {add {select {}}} {
if {"$select" == {}} {
set selections [get_selections $add]
set lb [lindex $selections 0]
set last [lindex $selections 1]
set selection [lindex $selections 2]
set noname 1
} else {
set lb {}
set last {}
set noname 0
set selection $select
}
$RemoveButton configure -state disabled
$AddButton configure -state disabled
if {$add} {
set list1 $Variables
set list2 $Collect
} else {
set list1 $Collect
set list2 $Variables
}
foreach a $selection {
if {$noname} {
set name [$lb get $a]
} else {
set name $a
}
if {"$name" == "All Locals" || "$name" == {$loc}} {
set name "All Locals"
set lists [all_locals $add]
set list1 [lindex $lists 0]
set list2 [lindex $lists 1]
} elseif {"$name" == "All Registers" || "$name" == {$reg}} {
set name "All Registers"
set lists [all_regs $add]
set list1 [lindex $lists 0]
set list2 [lindex $lists 1]
} elseif {"$name" == "All Arguments" || "$name" == {$arg}} {
set name "All Arguments"
set lists [all_args $add]
set list1 [lindex $lists 0]
set list2 [lindex $lists 1]
} else {
set i [lsearch -exact $list1 $name]
set list1 [lreplace $list1 $i $i]
if {[lsearch $Args $name] != -1 || [lsearch $Registers [string trim $name \$]] != -1 || [lsearch $Locals $name] != -1 || $add} {
lappend list2 $name
}
}
if {$add} {
set Collect $list2
set Variables $list1
} else {
set Collect $list1
set Variables $list2
}
}
fill_collect $last
fill_variables $last
}
method fill_collect {{last {}}} {
$CollectLB delete 0 end
set Collect [sort $Collect]
foreach a $Collect {
$CollectLB insert end $a
}
if {"$last" != ""} {
$CollectLB see $last
}
}
method fill_variables {{last {}}} {
$VariablesLB delete 0 end
set Variables [sort $Variables]
foreach a $Variables {
$VariablesLB insert end $a
}
if {"$last" != ""} {
$VariablesLB see $last
}
}
method sort {list} {
set special_names {
"All Arguments" args \
"All Locals" locs \
"All Registers" regs \
"Collect Stack" stack
}
foreach {name var} $special_names {
set i [lsearch $list $name]
if {$i != -1} {
set $var 1
set list [lreplace $list $i $i]
} else {
set $var 0
}
}
set types_list {Args Locals Registers }
foreach type $types_list {
set used_$type {}
foreach a [set $type] {
set i [lsearch $list $a]
if {$i != -1} {
lappend used_$type $a
set list [lreplace $list $i $i]
}
}
set used_$type [lsort [set used_$type]]
}
set globals [lsort $list]
set list [concat $used_Args $used_Locals $globals $used_Registers]
set list2 {}
foreach {name var} $special_names {
if {[set $var]} {
lappend list2 $name
}
}
set list [concat $list2 $list]
return $list
}
method all_args {add} {
if {$add} {
set list1 $Variables
set list2 $Collect
} else {
set list1 $Collect
set list2 $Variables
}
lappend list2 "All Arguments"
set i [lsearch $list1 "All Arguments"]
if {$i != -1} {
set list1 [lreplace $list1 $i $i]
}
return [list $list1 $list2]
}
method all_locals {add} {
if {$add} {
set list1 $Variables
set list2 $Collect
} else {
set list1 $Collect
set list2 $Variables
}
lappend list2 "All Locals"
set i [lsearch $list1 "All Locals"]
if {$i != -1} {
set list1 [lreplace $list1 $i $i]
}
return [list $list1 $list2]
}
method all_regs {add} {
if {$add} {
set list1 $Variables
set list2 $Collect
} else {
set list1 $Collect
set list2 $Variables
}
lappend list2 "All Registers"
set i [lsearch $list1 "All Registers"]
if {$i != -1} {
set list1 [lreplace $list1 $i $i]
}
return [list $list1 $list2]
}
method change_other {} {
set other [$OtherEntry get]
if {"$other" != ""} {
set added 0
set i [lsearch $Locals "$other"]
if {$i != -1} {
set i [lsearch $Collect "$other"]
set added 1
if {$i != -1} {
debug "local on collection list"
set add 0
set list1 [lreplace $Collect $i $i]
set list2 [concat $Variables "$other"]
} else {
debug "local on variable list"
set add 1
set i [lsearch $Variables "$other"]
set list1 [lreplace $Variables $i $i]
set list2 [concat $Collect "$other"]
}
}
set i [lsearch $Registers [string trim "$other" \$]]
if {$i != -1} {
set i [lsearch $Collect "$other"]
set added 1
if {$i != -1} {
debug "register on collection list"
set add 0
set list1 [lreplace $Collect $i $i]
set list2 [concat $Variables "$other"]
} else {
debug "register on variable list"
set add 1
set i [lsearch $Variables "$other"]
set list1 [lreplace $Variables $i $i]
set list2 [concat $Collect "$other"]
}
}
set i [lsearch $Args $other]
if {$i != -1} {
set i [lsearch $Collect "$other"]
set added 1
if {$i != -1} {
debug "arg on collection list"
set add 0
set list1 [lreplace $Collect $i $i]
set list2 [concat $Variables "$other"]
} else {
debug "arg on variable list"
set add 1
set i [lsearch $Variables "$other"]
set list1 [lreplace $Variables $i $i]
set list2 [concat $Collect "$other"]
}
}
if {!$added} {
if {"[string tolower $other]" == "all locals"} {
set i [lsearch $Variables "All Locals"]
if {$i != -1} {
set add 1
set lists [all_locals 1]
set list1 [lindex $lists 0]
set list2 [lindex $lists 1]
} else {
set add 0
set lists [all_locals 0]
set list1 [lindex $lists 0]
set list2 [lindex $lists 1]
}
} elseif {"[string tolower $other]" == "all registers"} {
set i [lsearch $Variables "All Registers"]
if {$i != -1} {
set add 1
set lists [all_regs 1]
set list1 [lindex $lists 0]
set list2 [lindex $lists 1]
} else {
set add 0
set lists [all_regs 0]
set list1 [lindex $lists 0]
set list2 [lindex $lists 1]
}
} elseif {"[string tolower $other]" == "all arguments"} {
set i [lsearch $Variables "All Arguments"]
if {$i != -1} {
set add 1
set lists [all_args 1]
set list1 [lindex $lists 0]
set list2 [lindex $lists 1]
} else {
set add 0
set lists [all_args 0]
set list1 [lindex $lists 0]
set list2 [lindex $lists 1]
}
} elseif {"[string tolower $other]" == "collect stack"} {
set i [lsearch $Variables "Collect Stack"]
if {$i != -1} {
set add 1
set lists [all_args 1]
set list1 [lindex $lists 0]
set list2 [lindex $lists 1]
} else {
set add 0
set lists [all_args 0]
set list1 [lindex $lists 0]
set list2 [lindex $lists 1]
}
} else {
set i [lsearch $Collect $other]
if {$i != -1} {
set add 0
set list1 [lreplace $Collect $i $i]
set list2 $Variables
} else {
set other [string trim $other \ \r\t\n]
set ok 1
if {[string range $other 0 1] == "\$("} {
tk_messageBox -type ok -icon error \
-message "Expression syntax not supported"
set ok 0
}
if {$ok} {
if {[regsub -all { } $other {} expression]} {
set other $expression
}
set add 1
set list1 $Variables
set list2 [concat $Collect "$other"]
} else {
}
}
}
}
$OtherEntry delete 0 end
if {$add} {
set Variables $list1
set Collect $list2
} else {
set Variables $list2
set Collect $list1
}
fill_listboxes
}
}
method get_selections {vars} {
if {$vars} {
set widget $VariablesLB
} else {
set widget $CollectLB
}
set elements [$widget curselection]
set list {}
set i 0
foreach i $elements {
lappend list [$widget get $i]
}
return [list $widget $i $elements]
}
method cancel {} {
::delete object $this
}
method remove_special {list items} {
foreach item $items {
set i [lsearch $list $item]
if {$i != -1} {
set list [lreplace $list $i $i]
} else {
set i [lsearch $list \$$item]
if {$i != -1} {
set list [lreplace $list $i $i]
}
}
}
return $list
}
method ok {} {
global _TStepCount
change_other
if {[llength $Collect] == 0} {
set msg "No data specified for the given action."
set answer [tk_messageBox -type ok -title "Tracepoint Error" \
-icon error \
-message $msg]
case $answer {
cancel {
cancel
}
ok {
return
}
}
}
set i [lsearch $Collect "All Locals"]
if {$i != -1} {
set data [lreplace $Collect $i $i]
set data [concat $data {$loc}]
set data [remove_special $data $Locals]
} else {
set data $Collect
}
set i [lsearch $data "All Registers"]
if {$i != -1} {
set data [lreplace $data $i $i]
set data [concat $data {$reg}]
set data [remove_special $data $Registers]
}
set i [lsearch $data "All Arguments"]
if {$i != -1} {
set data [lreplace $data $i $i]
set data [concat $data {$arg}]
set data [remove_special $data $Args]
}
set i [lsearch $data "Collect Stack"]
if {$i != -1} {
set data [lreplace $data $i $i]
set data [concat $data [collect_stack]]
}
set d {}
foreach i $data {
if {![info exists check($i)]} {
set check($i) 1
lappend d $i
}
}
if {$WhileStepping} {
set steps $_TStepCount
} else {
set steps 0
}
if {"$Data" != {}} {
set command "modify"
} else {
set command "add"
}
debug "DATA = $data"
eval $Callback $command $steps [list $data]
::delete object $this
}
method collect_stack {} {
return $StackCollect
}
method cmd {line} {
$line
}
public variable File
public variable Line {}
public variable WhileStepping 0
public variable Number
public variable Callback
public variable Data {}
public variable Steps {}
public variable Address {}
protected variable WhileSteppingEntry
protected variable CollectLB
protected variable VariablesLB
protected variable Variables {}
protected variable Collect {}
protected variable Locals
protected variable Args
protected variable Registers
protected variable Others {}
protected variable AddButton
protected variable RemoveButton
protected variable OtherEntry
protected variable StackCollect {*(char*)$sp@64}
}