import insight-2000-02-04 snapshot (2nd try)

1 files changed, 89 insertions, 0 deletions

diff --git a/libgui/src/tclwinmode.c b/libgui/src/tclwinmode.c
new file mode 100644
index 00000000000..958d5c9c607
--- /dev/null
+++ b/libgui/src/tclwinmode.c
@@ -0,0 +1,89 @@
+/* tclwinmode.c - Tcl access to SetErrorMode function.
+   Copyright (C) 1998 Cygnus Solutions.
+   Written by Tom Tromey <tromey@cygnus.com>.  */
+
+#include <tcl.h>
+#include "guitcl.h"
+
+#ifdef __CYGWIN32__
+
+#include <windows.h>
+
+struct pair
+{
+  const char *name;
+  UINT value;
+};
+
+static struct pair values[] =
+{
+  { "failcriticalerrors", SEM_FAILCRITICALERRORS },
+  { "noalignmentfaultexcept", SEM_NOALIGNMENTFAULTEXCEPT },
+  { "nogpfaulterrorbox", SEM_NOGPFAULTERRORBOX },
+  { "noopenfileerrorbox", SEM_NOOPENFILEERRORBOX },
+  { NULL, 0 }
+};
+
+#endif
+
+static int
+seterrormode_command (ClientData cd, Tcl_Interp *interp,
+		      int argc, char *argv[])
+{
+#ifdef __CYGWIN32__
+  int len, i;
+  char **list;
+  UINT val = 0;
+
+  if (argc != 2)
+    {
+      Tcl_AppendResult (interp, "wrong # args: should be \"",
+			argv[0], " modelist\"", (char *) NULL);
+      return TCL_ERROR;
+    }
+
+  if (Tcl_SplitList (interp, argv[1], &len, &list) != TCL_OK)
+    return TCL_ERROR;
+
+  for (i = 0; i < len; ++i)
+    {
+      int j, found = 0;
+      for (j = 0; values[j].name; ++j)
+	{
+	  if (! strcmp (values[j].name, list[i]))
+	    {
+	      found = 1;
+	      val |= values[j].value;
+	      break;
+	    }
+	}
+      if (! found)
+	{
+	  Tcl_AppendResult (interp, "unrecognized key \"", list[i],
+			    "\"", (char *) NULL);
+	  Tcl_Free ((char *) list);
+	  return TCL_ERROR;
+	}
+    }
+  Tcl_Free ((char *) list);
+
+  val = SetErrorMode (val);
+
+  for (i = 0; values[i].name; ++i)
+    {
+      if (val & values[i].value)
+	Tcl_AppendElement (interp, values[i].name);
+    }
+#endif /* __CYGWIN32__ */
+
+  return TCL_OK;
+}
+
+int
+ide_create_set_error_mode_command (Tcl_Interp *interp)
+{
+  if (Tcl_CreateCommand (interp, "ide_set_error_mode",
+			 seterrormode_command, NULL, NULL) == NULL)
+    return TCL_ERROR;
+  return TCL_OK;
+}