gdb/gdbtk/library/attachdlg.itb

   1 # Attach Dialog for Insight.
   2 # Copyright (C) 1999, 2002, 2003, 2008 Red Hat, Inc.
   3 #
   4 # This program is free software; you can redistribute it and/or modify it
   5 # under the terms of the GNU General Public License (GPL) as published by
   6 # the Free Software Foundation; either version 2 of the License, or (at
   7 # your option) any later version.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13
  14
  15 itcl::body AttachDlg::constructor {args} {
  16   eval itk_initialize $args
  17   window_name "Attach To Process"
  18   build_win
  19 }
  20
  21 itcl::body AttachDlg::build_win {} {
  22   # Frame
  23   itk_component add pid {
  24     iwidgets::labeledframe $itk_interior.f -labeltext "Choose Process" \
  25       -relief groove -borderwidth 2 -ipadx 6 -ipady 4
  26   }
  27
  28   # Listbox of processes
  29   itk_component add choose_pid {
  30     iwidgets::scrolledlistbox [$itk_component(pid) childsite].pid \
  31       -visibleitems 30x15 -hscrollmode dynamic -vscrollmode dynamic\
  32       -exportselection 0 -selectioncommand [code $this select_pid] \
  33       -foreground $::Colors(textfg) -textbackground $::Colors(textbg) \
  34       -dblclickcommand [code $this doit]
  35   }
  36
  37   # Filter entryfield
  38   itk_component add pid_filter {
  39     iwidgets::entryfield [$itk_component(pid) childsite].filt \
  40       -labeltext "Filter:" \
  41       -foreground $::Colors(textfg) -textbackground $::Colors(textbg) \
  42       -focuscommand [code $this clear_pid_selection] \
  43       -command [code $this filter_pid_selection]
  44   }
  45   $itk_component(pid_filter) insert 0 *
  46
  47   # seperator
  48   itk_component add pid_sep {
  49     frame [$itk_component(pid) childsite].sep \
  50       -height 2 -borderwidth 1 -relief sunken
  51   }
  52
  53   # PID_ENTRY: this is the PID entry box.  You can enter the pid
  54   # by hand here, or click on the listbox to have it entered for you.
  55   itk_component add pid_entry {
  56     iwidgets::entryfield [$itk_component(pid) childsite].lab \
  57       -labeltext "PID:" -validate numeric \
  58       -foreground $::Colors(textfg) -textbackground $::Colors(textbg) \
  59       -focuscommand [code $this clear_pid_selection]
  60   }
  61   pack $itk_component(choose_pid) -fill x -side top -pady 4
  62   pack $itk_component(pid_filter) -fill x -side top -pady 4
  63   pack $itk_component(pid_sep) -fill x -side top -pady 8
  64   pack $itk_component(pid_entry) -fill x -side bottom -pady 4
  65
  66   itk_component add symbol_label {
  67     iwidgets::labeledframe $itk_interior.sym -labeltext "Choose Exec file" \
  68       -labelpos nw -relief groove -borderwidth 2 \
  69       -ipadx 8 -ipady 6
  70   }
  71
  72   itk_component add symbol_file {
  73     iwidgets::entryfield [$itk_interior.sym childsite].f -labeltext "File:" \
  74       -foreground $::Colors(textfg) -textbackground $::Colors(textbg)
  75   }
  76   pack $itk_component(symbol_file) -pady 4 -padx 4 -fill x
  77
  78   # can't use the -state in the entryfield, 'cause that affects the
  79   # label as well...
  80   #$itk_component(symbol_file) component entry configure -state disabled
  81   $itk_component(symbol_file) configure -state normal
  82   $itk_component(symbol_file) insert 0 $::gdb_exe_name
  83   #$itk_component(symbol_file) configure -state disabled
  84
  85   itk_component add symbol_browse {
  86     button [$itk_component(symbol_file) childsite].br -text "Choose..." \
  87       -command [code $this choose_symbol_file]
  88   }
  89   pack $itk_component(symbol_browse) -pady 4 -padx 4 -ipadx 4
  90
  91   itk_component add button_box {
  92     frame $itk_interior.b
  93   }
  94
  95   itk_component add cancel {
  96     button $itk_component(button_box).cancel -text "Cancel" \
  97       -command [code $this cancel]
  98   }
  99
 100   itk_component add ok {
 101     button $itk_component(button_box).ok -text "OK" -command [code $this doit]
 102   }
 103
 104 #  if {$::gdb_exe_name == ""} {
 105 #    $itk_component(ok) configure -state disabled
 106 #  }
 107
 108   ::standard_button_box $itk_component(button_box)
 109
 110   pack $itk_component(button_box) -side bottom -fill x -pady 4 -padx 4
 111   pack $itk_component(symbol_label) -side bottom -fill x -pady 4 -padx 4
 112   pack $itk_component(pid) -fill both -expand 1 -pady 4 -padx 4
 113
 114   after idle [list update idletasks;  $this list_pids]
 115 }
 116
 117 # ------------------------------------------------------------------
 118 #  METHOD:  doit - This accepts the attach command.
 119 # ------------------------------------------------------------------
 120
 121 itcl::body AttachDlg::doit {} {
 122   set AttachDlg::last_button 1
 123   set AttachDlg::last_pid [$itk_component(pid_entry) get]
 124   set AttachDlg::symbol_file [$itk_component(symbol_file) get]
 125   unpost
 126 }
 127
 128 # ------------------------------------------------------------------
 129 #  METHOD:  cancel - unpost the dialog box without attaching.
 130 # ------------------------------------------------------------------
 131
 132 itcl::body AttachDlg::cancel {} {
 133   set AttachDlg::last_button 0
 134   set AttachDlg::last_pid {}
 135   unpost
 136 }
 137
 138 # ------------------------------------------------------------------
 139 #  METHOD:  choose_symbol_file - Query for a new symbol file.
 140 # ------------------------------------------------------------------
 141
 142 itcl::body AttachDlg::choose_symbol_file {} {
 143   set file [tk_getOpenFile -parent . -title "Load New Executable"]
 144   if {$file != ""} {
 145     $itk_component(symbol_file) configure -state normal
 146     $itk_component(symbol_file) clear
 147     $itk_component(symbol_file) insert 0 $file
 148 #    $itk_component(symbol_file) configure -state disabled
 149     $itk_component(ok) configure -state active
 150   }
 151 }
 152
 153
 154 # ------------------------------------------------------------------
 155 #  METHOD:  list_pids - List the available processes.  Right now,
 156 #           this just spawns ps, which means we have to deal with
 157 #           all the different ps flags & output formats.  At some
 158 #           point we should steal some C code to do it by hand.
 159 # ------------------------------------------------------------------
 160
 161 itcl::body AttachDlg::list_pids {{pattern *}} {
 162   global gdbtk_platform
 163
 164   switch $gdbtk_platform(os) {
 165     Linux {
 166       set ps_cmd "ps axw"
 167     }
 168     default {
 169       set ps_cmd "ps w"
 170     }
 171   }
 172   if {[catch {::open "|$ps_cmd" r} psH]} {
 173     set errTxt "Could not exec ps: $psH
 174 You will have to enter the PID by hand."
 175     ManagedWin::open WarningDlg -message [list $errTxt]
 176     return
 177   }
 178   gets $psH header
 179
 180   set nfields [llength $header]
 181   set nfields_m_1 [expr {$nfields - 1}]
 182   set regexp {^ *([^ ]*) +}
 183   for {set i 1} {$i < $nfields_m_1} {incr i} {
 184     append regexp {[^ ]* +}
 185   }
 186   append regexp {(.*)$}
 187
 188   $itk_component(choose_pid) clear
 189   set pid_list {}
 190
 191   while {[gets $psH line] >= 0} {
 192     regexp $regexp $line dummy PID COMMAND
 193     if {[string match $pattern $COMMAND]} {
 194       lappend pid_list [list $PID $COMMAND]
 195       $itk_component(choose_pid) insert end $COMMAND
 196     }
 197   }
 198
 199   close $psH
 200   $itk_component(choose_pid) selection set 0
 201   select_pid
 202 }
 203
 204 # ------------------------------------------------------------------
 205 #  METHOD:  select_pid - Grab the selected element from the PID listbox
 206 #           and insert the associated PID into the entry form.
 207 # ------------------------------------------------------------------
 208
 209 itcl::body AttachDlg::select_pid {} {
 210   set hit [$itk_component(choose_pid) curselection]
 211   if {$hit != ""} {
 212     $itk_component(pid_entry) clear
 213     $itk_component(pid_entry) insert 0 [lindex [lindex $pid_list $hit] 0]
 214   }
 215 }
 216
 217 # ------------------------------------------------------------------
 218 #  METHOD:  clear_pid_selection - Clear the current PID selection.
 219 # ------------------------------------------------------------------
 220
 221 itcl::body AttachDlg::clear_pid_selection {} {
 222   $itk_component(choose_pid) selection clear 0 end
 223   $itk_component(pid_entry) selection range 0 end
 224 }
 225
 226 # ------------------------------------------------------------------
 227 #  METHOD:  filter_pid_selection - Filters the pid box.
 228 # ------------------------------------------------------------------
 229
 230 itcl::body AttachDlg::filter_pid_selection {} {
 231   list_pids [$itk_component(pid_filter) get]
 232 }