[RFA] Run button - second try

["Martin M. Hunt" <hunt at redhat dot com>]

This is a new, simplified  patch that removes any controversial parts.
Here is my original explanation of why this is needed:

Some people (like me) do both native and remote debugging.  If you attempt
to do so, you cannot just hit the RUN button and expect the right thing to happen.
This is because the run_load, run_attach, run_run, and run_cont preferences are
changed.  To make things work, I had to make them session-dependent.  Rather than
make lots of changes all over the place, I just modified session.tcl to load
the old preferences variables as new sessions are loaded. 

I also fixed the run button so that if you click it while a program is being debugged, 
you get a dialog that allows you to restart your debug session or cancel.

Also, it can take a long time to connect to a remote target, especially if
it isn't responding, so change the RUN botton to the STOP sign so the
user can cancel the connect.  If the user does cancel, the target dialog pops
up again.

Finally, it the user wants to set a BP on exit, and that fails, then display
an ignoreable warning.

-- 
Martin Hunt
GDB Engineer
Red Hat, Inc.



2002-1-3  Martin M. Hunt  <hunt@redhat.com>
        
        * library/session.tcl (session_notice_file_change): Reset
        target run prefs back to defaults then load per-session
        values if available.
        (session_save): Save target run prefs per-session.

        * library/interface.tcl (set_target): Call gdbtk_busy
	 before the target command and gdbtk_idle after.
        (run_executable): If target is unchanged, ask user what
        to do. Display warning if break on exit fails.

Index: interface.tcl
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/interface.tcl,v
retrieving revision 1.38
diff -u -p -w -r1.38 interface.tcl
--- interface.tcl	2002/01/03 00:03:46	1.38
+++ interface.tcl	2002/01/03 21:54:08
@@ -1084,8 +1084,10 @@ proc set_target {} {
     update
     catch {gdb_cmd "detach"}
     debug "CONNECTING TO TARGET: $gdb_target_cmd"
+    gdbtk_busy
     set err [catch {gdb_immediate "target $gdb_target_cmd"} msg ]
     $srcWin set_status
+    gdbtk_idle
 
     if {$err} {
       if {[string first "Program not killed" $msg] != -1} {
@@ -1123,7 +1125,7 @@ proc run_executable { {auto_start 1} } {
   global gdb_exe_changed gdb_target_changed gdb_program_has_run
   global gdb_running gdb_exe_name tcl_platform
 
-#  debug "auto_start=$auto_start gdb_target_name=$gdb_target_name"
+#  debug "auto_start=$auto_start gdb_target_name=$gdb_target_name exe=$gdb_exe_name"
 
   set gdb_running_saved $gdb_running
   set gdb_running 0
@@ -1146,10 +1148,29 @@ proc run_executable { {auto_start 1} } {
 
     # Attach
     if {$gdb_target_name == "" || [pref get gdb/src/run_attach]} {
-      if {[gdbtk_attach_remote] == "ATTACH_CANCELED"} {
+      set r [gdbtk_attach_remote] 
+      if { $r == "ATTACH_CANCELED" || $r == "ATTACH_ERROR"} {
+	return
+      }
+    
+      #
+      if {$r == "ATTACH_TARGET_UNCHANGED"} {
+	set msg "A program is being debugged already.\n"
+	append msg "Do you want to select another target?"
+	if {[gdbtk_tcl_query $msg no]} {
+	  # YES
+	  set ::gdb_target_name ""
+	  set ::gdb_target_cmd ""
+	  set r [gdbtk_attach_remote] 
+	  if { $r == "ATTACH_CANCELED" ||$r == "ATTACH_ERROR"} {
 	return
       }
+	} else {
+	  # NO
+	  return
+	}
     }
+    }
 
     # Download
     if {[pref get gdb/src/run_load] && $gdb_target_name != "exec"} {
@@ -1180,7 +1201,9 @@ proc run_executable { {auto_start 1} } {
     if {[pref get gdb/load/exit] && ![TargetSelection::native_debugging]} {
       debug "Setting new BP at exit"
       catch {gdb_cmd "clear exit"}
-      catch {gdb_cmd "break exit"}
+      if {[catch {gdb_cmd "break exit"} msg]} {
+	gdbtk_tcl_ignorable_warning break_exit $msg
+      }
     }
       
     if {[pref get gdb/load/main]} {
@@ -1239,8 +1262,9 @@ proc run_executable { {auto_start 1} } {
 	dbug W "msg=$msg"
 	gdbtk_idle
 	if {[string match "*help target*" $msg]} {
-	  set_target_name
+	  if {[set_target_name]} {
 	  run_executable $auto_start
+	  }
 	  return
 	}
 	if {[string match "No executable*" $msg]} {
Index: session.tcl
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/session.tcl,v
retrieving revision 1.10
diff -u -p -w -r1.10 session.tcl
--- session.tcl	2002/01/03 21:42:32	1.10
+++ session.tcl	2002/01/03 21:54:09
@@ -169,6 +169,12 @@ proc session_save {} {
   set values(pwd) $gdb_current_directory
   set values(target) $gdb_target_name
 
+  # these prefs need to be made session-dependent
+  set values(run_attach) [pref get gdb/src/run_attach]
+  set values(run_load) [pref get gdb/src/run_load]
+  set values(run_run) [pref get gdb/src/run_run]
+  set values(run_cont) [pref get gdb/src/run_cont]
+
   # Breakpoints.
   set values(breakpoints) [SESSION_serialize_bps]
 
@@ -227,6 +233,12 @@ proc session_notice_file_change {} {
     set values($k) [pref getd $key/$k]
   }
 
+  # reset these back to their defaults
+  pref set gdb/src/run_attach          0
+  pref set gdb/src/run_load            0
+  pref set gdb/src/run_run             1
+  pref set gdb/src/run_cont            0
+  
   if {! [info exists values(executable)] || $values(executable) != $name} {
     # No such session.
     return
@@ -256,6 +268,13 @@ proc session_notice_file_change {} {
     debug "Restoring Target: $values(target)"
     set gdb_target_name $values(target)
   }
+
+  if {[info exists values(run_attach)]} {
+    pref set gdb/src/run_attach $values(run_attach)
+    pref set gdb/src/run_load $values(run_load)
+    pref set gdb/src/run_run $values(run_run)
+    pref set gdb/src/run_cont $values(run_cont)
+  } 
 }
 
 #