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