--- gdbtk_orig/library/attachdlg.itb 2008-02-09 02:23:42.000000000 +0100 +++ gdbtk/library/attachdlg.itb 2012-04-11 16:51:23.387762900 +0200 @@ -1,5 +1,5 @@ # Attach Dialog for Insight. -# Copyright (C) 1999, 2002, 2003, 2008 Red Hat, Inc. +# Copyright (C) 1999-2012 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 @@ -152,51 +152,66 @@ itcl::body AttachDlg::choose_symbol_file # ------------------------------------------------------------------ -# 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. +# METHOD: list_pids - List the available processes. +# Right now on *nix systems 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 gdbtk_platform - switch $gdbtk_platform(os) { - Linux { - set ps_cmd "ps axw" + $itk_component(choose_pid) clear + + if {$gdbtk_platform(platform) == "windows"} { + set processes [gdb_list_processes] + foreach entry $processes { + set executable [lindex $entry 1] + if {[string match $pattern $executable]} { + lappend pid_list $entry + $itk_component(choose_pid) insert end $executable + } } - default { - set ps_cmd "ps w" + } else { + switch $gdbtk_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 + + 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 + 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 {} + 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 {(.*)$} + + 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 + 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 } - close $psH $itk_component(choose_pid) selection set 0 select_pid } --- gdbtk_orig/library/srcbar.itcl 2008-02-09 02:23:42.000000000 +0100 +++ gdbtk/library/srcbar.itcl 2012-04-11 16:50:45.448496200 +0200 @@ -1,5 +1,5 @@ # SrcBar -# Copyright (C) 2001, 2002, 2004, 2008 Red Hat, Inc. +# Copyright (C) 2001-2012 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 @@ -230,16 +230,10 @@ itcl::class SrcBar { set is_native [TargetSelection::native_debugging] - # If we are on a Unix target, put in the attach options. "ps" doesn't - # give me the Windows PID yet, and the attach also seems flakey, so - # I will hold off on the Windows implementation for now. - if {$is_native} { - if {[string compare $::gdbtk_platform(platform) windows] != 0} { $Menu add command Attach "Attach to process" \ [code $this do_attach $run_menu] \ -underline 0 -accelerator "Ctrl+A" - } } else { $Menu add command Other "Connect to target" \ "$this do_connect $run_menu" -underline 0 --- gdbtk_orig/generic/gdbtk-cmds.c 2012-03-30 09:14:33.000000000 +0200 +++ gdbtk/generic/gdbtk-cmds.c 2012-04-11 16:51:59.423826200 +0200 @@ -92,6 +92,11 @@ #include /* for isprint() */ #endif +#ifdef _WIN32 +#include /* For gdb_list_processes() */ +#include +#endif + /* Various globals we reference. */ extern char *source_path; @@ -225,6 +230,8 @@ static int perror_with_name_wrapper (PTR static int wrapped_call (PTR opaque_args); static int hex2bin (const char *hex, char *bin, int count); static int fromhex (int a); +static int gdb_list_processes (ClientData, Tcl_Interp *, int, Tcl_Obj * CONST[]); + /* Gdbtk_Init @@ -293,6 +300,8 @@ Gdbtk_Init (Tcl_Interp *interp) gdb_get_inferior_args, NULL); Tcl_CreateObjCommand (interp, "gdb_set_inferior_args", gdbtk_call_wrapper, gdb_set_inferior_args, NULL); + Tcl_CreateObjCommand (interp, "gdb_list_processes", gdbtk_call_wrapper, + gdb_list_processes, NULL); /* gdb_context is used for debugging multiple threads or tasks */ Tcl_LinkVar (interp, "gdb_context_id", @@ -591,6 +600,60 @@ gdb_stop (ClientData clientData, Tcl_Int return TCL_OK; } + +/* + * This command lists all processes in a system. Yet only implemented + * for windows as the *nix part is handled directly from tcl code. + * + * Arguments: + * None + * Tcl Result: + * A list of 2 elemented lists containing all running processes and their pids. + */ + +static int +gdb_list_processes (ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj * CONST objv[]) +{ + if (objc != 1) + { + Tcl_WrongNumArgs (interp, 1, objv, NULL); + return TCL_ERROR; + } + + Tcl_SetListObj (result_ptr->obj_ptr, 0, NULL); + + #ifdef _WIN32 + { + HANDLE processSnap = CreateToolhelp32Snapshot (TH32CS_SNAPPROCESS, 0); + if (processSnap != INVALID_HANDLE_VALUE) + { + PROCESSENTRY32 processEntry; + + processEntry.dwSize = sizeof(PROCESSENTRY32); + + if (Process32First (processSnap, &processEntry)) + { + do + { + Tcl_Obj *pidProc[2]; + pidProc[0] = Tcl_NewIntObj (processEntry.th32ProcessID); + pidProc[1] = Tcl_NewStringObj (processEntry.szExeFile, -1); + + Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, + Tcl_NewListObj (2, pidProc)); + + } while(Process32Next (processSnap, &processEntry)); + } + + CloseHandle (processSnap); + } + } + #endif + + return TCL_OK; +} + /*