[PATCH/gdbtk] Implement "Attach to process" for windows

[Roland Schwingel <roland@onevision.com>]

[-- Attachment #1: Type: text/plain, Size: 1246 bytes --]

Hi...

One thing I was always missing in windows versions of insight was to 
nicely attach to a running process. So I took the time now and 
implemented it. The attached patch does the job.

It adds a new function to gdbtk-cmds.c that does the native generation 
of the processlist. In attachdlg.itb there is now a unix case for 
getting the processlist (the old way) and a windows case doing it via 
the new C function.

Changelog:

2012-04-11  Roland Schwingel  <roland.schwingel@onevision.com>

	* library/attachdlg.itb: Updated copyright.
	(list_pids): Add a windows case for getting the
	process list. Adapt method comment.
	* library/srcbar.itcl: Updated copyright.
	(create_run_menu): Allow "Attach to process" on
	windows, too.
	* generic/gdbtk-cmds.c: On windows include
	windows.h/tlhelp32.h. Declare new
	function gdb_list_processes().
	(Gdbtk_Init): Register new tcl function
	"gdb_list_processes".
	(gdb_list_processes): New function.

Any comments? Is this ok?

One last thing. The "Attach to process" menu entry is IMHO in the wrong 
menu. At present it is in the "Run" menu. To me it is more intuitive if 
it would be in the "File" menu. If nobody objects I would generate a 
seperate patch to move it in the "File" menu.

Roland

[-- Attachment #2: windows_attach.patch --]
[-- Type: text/plain, Size: 7122 bytes --]

--- 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 <ctype.h>		/* for isprint() */
 #endif
 
+#ifdef _WIN32
+#include <windows.h>    /* For gdb_list_processes() */
+#include <tlhelp32.h>
+#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[]);
+
 \f
 
 /* 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;
+}
+
 \f
 
 /*