#
|
#
|
# attachdlg.itb - itcl implementations for class AttachDlg
|
# attachdlg.itb - itcl implementations for class AttachDlg
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
# Implements Attach to process window...
|
# Implements Attach to process window...
|
#
|
#
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
# Copyright (C) 1999 Cygnus Solutions
|
# Copyright (C) 1999 Cygnus Solutions
|
#
|
#
|
|
|
body AttachDlg::constructor {args} {
|
body AttachDlg::constructor {args} {
|
|
|
window_name "Attach To Process"
|
window_name "Attach To Process"
|
build_win
|
build_win
|
eval itk_initialize $args
|
eval itk_initialize $args
|
|
|
}
|
}
|
|
|
body AttachDlg::build_win {} {
|
body AttachDlg::build_win {} {
|
|
|
# CHOOSE_PID: the list box with list or processes. Also an entry
|
# CHOOSE_PID: the list box with list or processes. Also an entry
|
# for typing in the PID by hand.
|
# for typing in the PID by hand.
|
|
|
itk_component add choose_pid {
|
itk_component add choose_pid {
|
iwidgets::scrolledlistbox $itk_interior.cpid -visibleitems 30x15 \
|
iwidgets::scrolledlistbox $itk_interior.cpid -visibleitems 30x15 \
|
-labeltext "Choose process" -labelpos nw \
|
-labeltext "Choose process" -labelpos nw \
|
-labelrelief groove -labelborderwidth 2 \
|
-labelrelief groove -labelborderwidth 2 \
|
-ipadx 8 -ipady 6 -childsitepos s -hscrollmode none \
|
-ipadx 8 -ipady 6 -childsitepos s -hscrollmode none \
|
-textbackground white -exportselection 0 \
|
-textbackground white -exportselection 0 \
|
-selectioncommand [code $this select_pid] \
|
-selectioncommand [code $this select_pid] \
|
-dblclickcommand [code $this doit]
|
-dblclickcommand [code $this doit]
|
}
|
}
|
|
|
itk_component add pid_filter {
|
itk_component add pid_filter {
|
iwidgets::entryfield [$itk_component(choose_pid) childsite].filt \
|
iwidgets::entryfield [$itk_component(choose_pid) childsite].filt \
|
-labeltext Filter: -textbackground white \
|
-labeltext Filter: -textbackground white \
|
-focuscommand [code $this clear_pid_selection] \
|
-focuscommand [code $this clear_pid_selection] \
|
-command [code $this filter_pid_selection]
|
-command [code $this filter_pid_selection]
|
}
|
}
|
|
|
$itk_component(pid_filter) insert 0 *
|
$itk_component(pid_filter) insert 0 *
|
|
|
itk_component add pid_sep {
|
itk_component add pid_sep {
|
frame [$itk_component(choose_pid) childsite].sep \
|
frame [$itk_component(choose_pid) childsite].sep \
|
-height 2 -borderwidth 1 -relief sunken
|
-height 2 -borderwidth 1 -relief sunken
|
}
|
}
|
|
|
# PID_ENTRY: this is the PID entry box. You can enter the pid
|
# PID_ENTRY: this is the PID entry box. You can enter the pid
|
# by hand here, or click on the listbox to have it entered for you.
|
# by hand here, or click on the listbox to have it entered for you.
|
|
|
itk_component add pid_entry {
|
itk_component add pid_entry {
|
iwidgets::entryfield [$itk_component(choose_pid) childsite].lab \
|
iwidgets::entryfield [$itk_component(choose_pid) childsite].lab \
|
-labeltext PID: -validate numeric -textbackground white \
|
-labeltext PID: -validate numeric -textbackground white \
|
-focuscommand [code $this clear_pid_selection]
|
-focuscommand [code $this clear_pid_selection]
|
}
|
}
|
pack $itk_component(pid_filter) -fill x -side top -pady 4
|
pack $itk_component(pid_filter) -fill x -side top -pady 4
|
pack $itk_component(pid_sep) -fill x -side top -pady 8
|
pack $itk_component(pid_sep) -fill x -side top -pady 8
|
pack $itk_component(pid_entry) -fill x -side bottom -pady 4
|
pack $itk_component(pid_entry) -fill x -side bottom -pady 4
|
|
|
|
|
itk_component add symbol_label {
|
itk_component add symbol_label {
|
iwidgets::labeledframe $itk_interior.sym -labeltext "Choose Exec file" \
|
iwidgets::labeledframe $itk_interior.sym -labeltext "Choose Exec file" \
|
-labelpos nw -labelrelief groove -labelborderwidth 2 \
|
-labelpos nw -labelrelief groove -labelborderwidth 2 \
|
-ipadx 8 -ipady 6
|
-ipadx 8 -ipady 6
|
}
|
}
|
|
|
itk_component add symbol_file {
|
itk_component add symbol_file {
|
iwidgets::entryfield [$itk_interior.sym childsite].f -labeltext File: \
|
iwidgets::entryfield [$itk_interior.sym childsite].f -labeltext File: \
|
-textbackground white
|
-textbackground white
|
}
|
}
|
pack $itk_component(symbol_file) -pady 4 -padx 4 -fill x
|
pack $itk_component(symbol_file) -pady 4 -padx 4 -fill x
|
# can't use the -state in the entryfield, 'cause that affects the
|
# can't use the -state in the entryfield, 'cause that affects the
|
# label as well...
|
# label as well...
|
$itk_component(symbol_file) component entry configure -state disabled
|
$itk_component(symbol_file) component entry configure -state disabled
|
|
|
$itk_component(symbol_file) configure -state normal
|
$itk_component(symbol_file) configure -state normal
|
$itk_component(symbol_file) insert 0 $::gdb_exe_name
|
$itk_component(symbol_file) insert 0 $::gdb_exe_name
|
$itk_component(symbol_file) configure -state disabled
|
$itk_component(symbol_file) configure -state disabled
|
|
|
itk_component add symbol_browse {
|
itk_component add symbol_browse {
|
button [$itk_component(symbol_file) childsite].br -text Choose... \
|
button [$itk_component(symbol_file) childsite].br -text Choose... \
|
-command [code $this choose_symbol_file]
|
-command [code $this choose_symbol_file]
|
}
|
}
|
pack $itk_component(symbol_browse) -pady 4 -padx 4 -ipadx 4
|
pack $itk_component(symbol_browse) -pady 4 -padx 4 -ipadx 4
|
|
|
itk_component add button_box {
|
itk_component add button_box {
|
frame $itk_interior.b
|
frame $itk_interior.b
|
}
|
}
|
|
|
itk_component add cancel {
|
itk_component add cancel {
|
button $itk_component(button_box).cancel -text Cancel \
|
button $itk_component(button_box).cancel -text Cancel \
|
-command [code $this cancel]
|
-command [code $this cancel]
|
}
|
}
|
|
|
itk_component add ok {
|
itk_component add ok {
|
button $itk_component(button_box).ok -text OK -command [code $this doit]
|
button $itk_component(button_box).ok -text OK -command [code $this doit]
|
}
|
}
|
|
|
if {$::gdb_exe_name == ""} {
|
if {$::gdb_exe_name == ""} {
|
$itk_component(ok) configure -state disabled
|
$itk_component(ok) configure -state disabled
|
}
|
}
|
|
|
::standard_button_box $itk_component(button_box)
|
::standard_button_box $itk_component(button_box)
|
|
|
pack $itk_component(button_box) -side bottom -fill x \
|
pack $itk_component(button_box) -side bottom -fill x \
|
-pady 4 -padx 4
|
-pady 4 -padx 4
|
pack $itk_component(symbol_label) -side bottom -fill x -pady 4 -padx 4
|
pack $itk_component(symbol_label) -side bottom -fill x -pady 4 -padx 4
|
pack $itk_component(choose_pid) -fill both -expand 1 -pady 4 -padx 4
|
pack $itk_component(choose_pid) -fill both -expand 1 -pady 4 -padx 4
|
|
|
after idle [list update idletasks; $this list_pids]
|
after idle [list update idletasks; $this list_pids]
|
|
|
}
|
}
|
|
|
# ------------------------------------------------------------------
|
# ------------------------------------------------------------------
|
# METHOD: doit - This accepts the attach command.
|
# METHOD: doit - This accepts the attach command.
|
# ------------------------------------------------------------------
|
# ------------------------------------------------------------------
|
|
|
body AttachDlg::doit {} {
|
body AttachDlg::doit {} {
|
set AttachDlg::last_button 1
|
set AttachDlg::last_button 1
|
set AttachDlg::last_pid [$itk_component(pid_entry) get]
|
set AttachDlg::last_pid [$itk_component(pid_entry) get]
|
set AttachDlg::symbol_file [$itk_component(symbol_file) get]
|
set AttachDlg::symbol_file [$itk_component(symbol_file) get]
|
debug "About to unpost"
|
debug "About to unpost"
|
unpost
|
unpost
|
}
|
}
|
|
|
# ------------------------------------------------------------------
|
# ------------------------------------------------------------------
|
# METHOD: cancel - unpost the dialog box without attaching.
|
# METHOD: cancel - unpost the dialog box without attaching.
|
# ------------------------------------------------------------------
|
# ------------------------------------------------------------------
|
|
|
body AttachDlg::cancel {} {
|
body AttachDlg::cancel {} {
|
set AttachDlg::last_button 0
|
set AttachDlg::last_button 0
|
set AttachDlg::last_pid {}
|
set AttachDlg::last_pid {}
|
unpost
|
unpost
|
}
|
}
|
|
|
# ------------------------------------------------------------------
|
# ------------------------------------------------------------------
|
# METHOD: choose_symbol_file - Query for a new symbol file.
|
# METHOD: choose_symbol_file - Query for a new symbol file.
|
# ------------------------------------------------------------------
|
# ------------------------------------------------------------------
|
|
|
body AttachDlg::choose_symbol_file {} {
|
body AttachDlg::choose_symbol_file {} {
|
set file [tk_getOpenFile -parent . -title "Load New Executable"]
|
set file [tk_getOpenFile -parent . -title "Load New Executable"]
|
if {$file != ""} {
|
if {$file != ""} {
|
$itk_component(symbol_file) configure -state normal
|
$itk_component(symbol_file) configure -state normal
|
$itk_component(symbol_file) clear
|
$itk_component(symbol_file) clear
|
$itk_component(symbol_file) insert 0 $file
|
$itk_component(symbol_file) insert 0 $file
|
$itk_component(symbol_file) configure -state disabled
|
$itk_component(symbol_file) configure -state disabled
|
$itk_component(ok) configure -state active
|
$itk_component(ok) configure -state active
|
}
|
}
|
}
|
}
|
|
|
|
|
# ------------------------------------------------------------------
|
# ------------------------------------------------------------------
|
# METHOD: list_pids - List the available processes. Right now,
|
# METHOD: list_pids - List the available processes. Right now,
|
# this just spawns ps, which means we have to deal with
|
# this just spawns ps, which means we have to deal with
|
# all the different ps flags & output formats. At some
|
# all the different ps flags & output formats. At some
|
# point we should steal some C code to do it by hand.
|
# point we should steal some C code to do it by hand.
|
# ------------------------------------------------------------------
|
# ------------------------------------------------------------------
|
|
|
body AttachDlg::list_pids {{pattern *}} {
|
body AttachDlg::list_pids {{pattern *}} {
|
global tcl_platform
|
global tcl_platform
|
|
|
switch $tcl_platform(os) {
|
switch $tcl_platform(os) {
|
Linux {
|
Linux {
|
set ps_cmd "ps axw"
|
set ps_cmd "ps axw"
|
}
|
}
|
default {
|
default {
|
set ps_cmd "ps w"
|
set ps_cmd "ps w"
|
}
|
}
|
}
|
}
|
if {[catch {::open "|$ps_cmd" r} psH]} {
|
if {[catch {::open "|$ps_cmd" r} psH]} {
|
set errTxt "Could not exec ps: $psH
|
set errTxt "Could not exec ps: $psH
|
You will have to enter the PID by hand."
|
You will have to enter the PID by hand."
|
ManagedWin::open WarningDlg -message [list $errTxt]
|
ManagedWin::open WarningDlg -message [list $errTxt]
|
return
|
return
|
}
|
}
|
gets $psH header
|
gets $psH header
|
|
|
set nfields [llength $header]
|
set nfields [llength $header]
|
set nfields_m_1 [expr {$nfields - 1}]
|
set nfields_m_1 [expr {$nfields - 1}]
|
set regexp {^ *([^ ]*) +}
|
set regexp {^ *([^ ]*) +}
|
for {set i 1} {$i < $nfields_m_1} {incr i} {
|
for {set i 1} {$i < $nfields_m_1} {incr i} {
|
append regexp {[^ ]* +}
|
append regexp {[^ ]* +}
|
}
|
}
|
append regexp {(.*)$}
|
append regexp {(.*)$}
|
|
|
$itk_component(choose_pid) clear
|
$itk_component(choose_pid) clear
|
set pid_list {}
|
set pid_list {}
|
|
|
while {[gets $psH line] >= 0} {
|
while {[gets $psH line] >= 0} {
|
regexp $regexp $line dummy PID COMMAND
|
regexp $regexp $line dummy PID COMMAND
|
if {[string match $pattern $COMMAND]} {
|
if {[string match $pattern $COMMAND]} {
|
lappend pid_list [list $PID $COMMAND]
|
lappend pid_list [list $PID $COMMAND]
|
$itk_component(choose_pid) insert end $COMMAND
|
$itk_component(choose_pid) insert end $COMMAND
|
}
|
}
|
}
|
}
|
|
|
close $psH
|
close $psH
|
$itk_component(choose_pid) selection set 0
|
$itk_component(choose_pid) selection set 0
|
select_pid
|
select_pid
|
|
|
}
|
}
|
|
|
# ------------------------------------------------------------------
|
# ------------------------------------------------------------------
|
# METHOD: select_pid - Grab the selected element from the PID listbox
|
# METHOD: select_pid - Grab the selected element from the PID listbox
|
# and insert the associated PID into the entry form.
|
# and insert the associated PID into the entry form.
|
# ------------------------------------------------------------------
|
# ------------------------------------------------------------------
|
|
|
body AttachDlg::select_pid {} {
|
body AttachDlg::select_pid {} {
|
set hit [$itk_component(choose_pid) curselection]
|
set hit [$itk_component(choose_pid) curselection]
|
if {$hit != ""} {
|
if {$hit != ""} {
|
$itk_component(pid_entry) clear
|
$itk_component(pid_entry) clear
|
$itk_component(pid_entry) insert 0 [lindex [lindex $pid_list $hit] 0]
|
$itk_component(pid_entry) insert 0 [lindex [lindex $pid_list $hit] 0]
|
}
|
}
|
}
|
}
|
|
|
# ------------------------------------------------------------------
|
# ------------------------------------------------------------------
|
# METHOD: clear_pid_selection - Clear the current PID selection.
|
# METHOD: clear_pid_selection - Clear the current PID selection.
|
# ------------------------------------------------------------------
|
# ------------------------------------------------------------------
|
|
|
body AttachDlg::clear_pid_selection {} {
|
body AttachDlg::clear_pid_selection {} {
|
$itk_component(choose_pid) selection clear 0 end
|
$itk_component(choose_pid) selection clear 0 end
|
$itk_component(pid_entry) selection range 0 end
|
$itk_component(pid_entry) selection range 0 end
|
}
|
}
|
|
|
# ------------------------------------------------------------------
|
# ------------------------------------------------------------------
|
# METHOD: filter_pid_selection - Filters the pid box.
|
# METHOD: filter_pid_selection - Filters the pid box.
|
# ------------------------------------------------------------------
|
# ------------------------------------------------------------------
|
|
|
body AttachDlg::filter_pid_selection {} {
|
body AttachDlg::filter_pid_selection {} {
|
|
|
list_pids [$itk_component(pid_filter) get]
|
list_pids [$itk_component(pid_filter) get]
|
}
|
}
|
|
|