1999-02-09 Martin Hunt <hunt@cygnus.com>

	* gdbtk-hooks.c: Remove gdbtk_ignorable_warning prototype.
	It is in gdbtk.h.
	(report_error): New function. Displays debugging information
	if a hook function fails.  All hook functions should probably
	call this.
	(gdbtk_warning): Call report_error() if there is a problem.
	(gdbtk_register_changed): Call report_error() if there is a problem.
	(gdbtk_memory_changed): Call report_error() if there is a problem.
	(gdbtk_ignorable_warning): Pass along class argument. If there
	is a problem, call report_error().

	* gdbtk-cmds.c: Remove TclDebug prototype.  It is in gdbtk.h.
	(gdb_loadfile): Add class name to gdbtk_ignorable_warning call.

	* gdbtk.c (TclDebug): Add "priority" argument. Calls "dbug"
	instead of "debug". Removed non-ANSI ifdefs.

	* gdbtk.h: Fixed protos for gdbtk_ignorable_warning and TclDebug.

5 files changed, 81 insertions, 36 deletions

diff --git a/gdb/ChangeLog-gdbtk b/gdb/ChangeLog-gdbtk
index 3f90613..863a821 100644
--- a/gdb/ChangeLog-gdbtk
+++ b/gdb/ChangeLog-gdbtk
@@ -1,3 +1,24 @@
+1999-02-09  Martin Hunt  <hunt@cygnus.com>
+
+	* gdbtk-hooks.c: Remove gdbtk_ignorable_warning prototype.
+	It is in gdbtk.h.
+	(report_error): New function. Displays debugging information
+	if a hook function fails.  All hook functions should probably
+	call this.
+	(gdbtk_warning): Call report_error() if there is a problem.
+	(gdbtk_register_changed): Call report_error() if there is a problem.
+	(gdbtk_memory_changed): Call report_error() if there is a problem.
+	(gdbtk_ignorable_warning): Pass along class argument. If there
+	is a problem, call report_error().
+	
+	* gdbtk-cmds.c: Remove TclDebug prototype.  It is in gdbtk.h.
+	(gdb_loadfile): Add class name to gdbtk_ignorable_warning call.
+
+	* gdbtk.c (TclDebug): Add "priority" argument. Calls "dbug"
+	instead of "debug". Removed non-ANSI ifdefs.
+
+	* gdbtk.h: Fixed protos for gdbtk_ignorable_warning and TclDebug.
+	
 1999-02-05  James Ingham  <jingham@cygnus.com>
 
 	* Makefile.in: Add GDBTK_CFLAGS - this is now used to hold
diff --git a/gdb/gdbtk-cmds.c b/gdb/gdbtk-cmds.c
index b81c3f9..ee5d1e1 100644
--- a/gdb/gdbtk-cmds.c
+++ b/gdb/gdbtk-cmds.c
@@ -243,7 +243,6 @@ static void get_register_name PARAMS ((int, void *));
 static int map_arg_registers PARAMS ((int, Tcl_Obj *CONST [], void (*) (int, void *), void *));
 static int perror_with_name_wrapper PARAMS ((PTR args));
 static void register_changed_p PARAMS ((int, void *));
-void TclDebug PARAMS ((const char *fmt, ...));
 static int wrapped_call (PTR opaque_args);
 static void get_frame_name PARAMS ((Tcl_Interp *interp, Tcl_Obj *list, struct frame_info *fi));
 
@@ -2735,9 +2734,12 @@ gdb_loadfile (clientData, interp, objc, objv)
       mtime = bfd_get_mtime(exec_bfd);
  
   if (mtime && mtime < st.st_mtime)
-     gdbtk_ignorable_warning("Source file is more recent than executable.\n");
-
-
+    {
+      gdbtk_ignorable_warning("file_times",\
+			      "Source file is more recent than executable.\n");
+    }
+  
+  
   /* Source linenumbers don't appear to be in order, and a sort is */
   /* too slow so the fastest solution is just to allocate a huge */
   /* array and set the array entry for each linenumber */
diff --git a/gdb/gdbtk-hooks.c b/gdb/gdbtk-hooks.c
index 4e19233..71bca51 100644
--- a/gdb/gdbtk-hooks.c
+++ b/gdb/gdbtk-hooks.c
@@ -94,10 +94,9 @@ static void   gdbtk_exec_file_display PARAMS ((char *));
 static void   tk_command_loop PARAMS ((void));
 static void   gdbtk_call_command PARAMS ((struct cmd_list_element *, char *, int));
 static int    gdbtk_wait PARAMS ((int, struct target_waitstatus *));
-       void   x_event PARAMS ((int));
+void   x_event PARAMS ((int));
 static int    gdbtk_query PARAMS ((const char *, va_list));
 static void   gdbtk_warning PARAMS ((const char *, va_list));
-void   gdbtk_ignorable_warning PARAMS ((const char *));
 static char*  gdbtk_readline PARAMS ((char *));
 static void
 #ifdef ANSI_PROTOTYPES
@@ -303,8 +302,25 @@ gdbtk_warning (warning, args)
   char buf[200];
 
   vsprintf (buf, warning, args);
-  gdbtk_two_elem_cmd ("gdbtk_tcl_warning", buf);
+  if (gdbtk_two_elem_cmd ("gdbtk_tcl_warning", buf) != TCL_OK)
+    report_error();
+}
+
+
+/* Error-handling function for all hooks */
+/* Hooks are not like tcl functions, they do not simply return */
+/* TCL_OK or TCL_ERROR.  Also, the calling function typically */
+/* doesn't care about errors in the hook functions.  Therefore */
+/* after every hook function, report_error should be called. */
+/* report_error can just call Tcl_BackgroundError() which will */
+/* pop up a messagebox, or it can silently log the errors through */
+/* the gdbtk dbug command.  */
 
+static void
+report_error ()
+{
+  TclDebug ('E',Tcl_GetVar(gdbtk_interp,"errorInfo",TCL_GLOBAL_ONLY));
+  /*  Tcl_BackgroundError(gdbtk_interp); */
 }
 
 /*
@@ -313,19 +329,22 @@ gdbtk_warning (warning, args)
  */
 
 void
-gdbtk_ignorable_warning (warning)
+gdbtk_ignorable_warning (class, warning)
+     const char *class;
      const char *warning;
 {
   char buf[512];
-  sprintf (buf, warning);
-  gdbtk_two_elem_cmd ("gdbtk_tcl_ignorable_warning", buf);
+  sprintf (buf, "gdbtk_tcl_ignorable_warning {%s} {%s}", class, warning);
+  if (Tcl_Eval (gdbtk_interp, buf) != TCL_OK)
+    report_error();
 }
 
 static void
 gdbtk_register_changed(regno)
      int regno;
 {
-  Tcl_Eval (gdbtk_interp, "gdbtk_register_changed");
+  if (Tcl_Eval (gdbtk_interp, "gdbtk_register_changed") != TCL_OK)
+    report_error();
 }
 
 static void
@@ -333,7 +352,8 @@ gdbtk_memory_changed(addr, len)
      CORE_ADDR addr;
      int len;
 {
-  Tcl_Eval (gdbtk_interp, "gdbtk_memory_changed");
+  if (Tcl_Eval (gdbtk_interp, "gdbtk_memory_changed") != TCL_OK)
+    report_error();
 }
 
 
diff --git a/gdb/gdbtk.c b/gdb/gdbtk.c
index eaa150e..f69a549 100644
--- a/gdb/gdbtk.c
+++ b/gdb/gdbtk.c
@@ -196,32 +196,38 @@ close_bfds ()
  */
 
 void
-#ifdef ANSI_PROTOTYPES
-TclDebug (const char *fmt, ...)
-#else
-TclDebug (va_alist)
-     va_dcl
-#endif
+TclDebug (char level, const char *fmt, ...)
 {
   va_list args;
-  char buf[512], *v[2], *merge;
-
-#ifdef ANSI_PROTOTYPES
+  char buf[512], *v[3], *merge, *priority;
+  
+  switch (level)
+    {
+    case 'W':
+      priority = "W";
+      break;
+    case 'E':
+      priority = "E";
+      break;
+    case 'X':
+      priority = "X";
+      break;
+    default:
+      priority = "I";
+    }
+  
   va_start (args, fmt);
-#else
-  char *fmt;
-  va_start (args);
-  fmt = va_arg (args, char *);
-#endif
 
-  v[0] = "debug";
-  v[1] = buf;
+  v[0] = "dbug";
+  v[1] = priority;
+  v[2] = buf;
 
   vsprintf (buf, fmt, args);
   va_end (args);
 
-  merge = Tcl_Merge (2, v);
-  Tcl_Eval (gdbtk_interp, merge);
+  merge = Tcl_Merge (3, v);
+  if (Tcl_Eval (gdbtk_interp, merge) != TCL_OK)
+    Tcl_BackgroundError(gdbtk_interp);
   Tcl_Free (merge);
 }
 
diff --git a/gdb/gdbtk.h b/gdb/gdbtk.h
index 4c98de3..9cc81a1 100644
--- a/gdb/gdbtk.h
+++ b/gdb/gdbtk.h
@@ -139,7 +139,7 @@ extern int gdb_context;
 extern int  Gdbtk_Init(Tcl_Interp *interp);
 extern void gdbtk_stop_timer PARAMS ((void));
 extern void gdbtk_start_timer PARAMS ((void));
-extern void gdbtk_ignorable_warning PARAMS ((const char *));
+extern void gdbtk_ignorable_warning PARAMS ((const char *,const char *));
 extern void gdbtk_interactive PARAMS ((void));
 extern void x_event PARAMS ((int));
 extern int gdbtk_two_elem_cmd PARAMS ((char *, char *));
@@ -150,11 +150,7 @@ extern void close_bfds ();
 #endif /* _WIN32 */
 
 extern void
-#ifdef ANSI_PROTOTYPES
-TclDebug (const char *fmt, ...);
-#else
-TclDebug (va_alist);
-#endif
+TclDebug (char level, const char *fmt, ...);
 
 /* A convenience macro for getting the demangled source names,
    regardless of the user's mangling style. */