1 files changed, 126 insertions, 0 deletions
diff --git a/libgui/src/subcommand.c b/libgui/src/subcommand.c
new file mode 100644
index 00000000000..29e7ea12f18
--- /dev/null
+++ b/libgui/src/subcommand.c
@@ -0,0 +1,126 @@
+/* subcommand.c - Automate handling of subcommands in Tcl.
+   Copyright (C) 1997 Cygnus Solutions.
+   Written by Tom Tromey <tromey@cygnus.com>.  */
+
+#include <string.h>
+
+#include <tcl.h>
+
+#include "subcommand.h"
+
+/* A pointer to this structure is the clientdata for
+   subcommand_implementation.  */
+
+struct subcommand_clientdata
+{
+  const struct ide_subcommand_table *commands;
+  ClientData subdata;
+  Tcl_CmdDeleteProc *delete;
+};
+
+/* This is called when one of our commands is deleted.  */
+static void
+subcommand_deleted (ClientData cd)
+{
+  struct subcommand_clientdata *data = (struct subcommand_clientdata *) cd;
+
+  if (data->delete)
+    (*data->delete) (data->subdata);
+  Tcl_Free ((char *) data);
+}
+
+/* This function implements any Tcl command registered as having
+   subcommands.  The ClientData here must be a pointer to the command
+   table.  */
+static int
+subcommand_implementation (ClientData cd, Tcl_Interp *interp,
+			   int argc, char *argv[])
+{
+  struct subcommand_clientdata *data = (struct subcommand_clientdata *) cd;
+  const struct ide_subcommand_table *commands = data->commands;
+  int i;
+
+  if (argc < 2)
+    {
+      Tcl_AppendResult (interp, "wrong # args: must be \"",
+			argv[0], " key ?arg ...?\"", (char *) NULL);
+      return (TCL_ERROR);
+    }
+
+  for (i = 0; commands[i].method != NULL; ++i)
+    {
+      if (! strcmp (argv[1], commands[i].method))
+	{
+	  if (argc < commands[i].min_args)
+	    {
+	      char buf[20];
+	      Tcl_AppendResult (interp, "wrong # args: got ", (char *) NULL);
+	      sprintf (buf, "%d", argc);
+	      Tcl_AppendResult (interp, buf, " but expected at least ",
+				(char *) NULL);
+	      sprintf (buf, "%d", commands[i].min_args);
+	      Tcl_AppendResult (interp, buf, (char *) NULL);
+	      return (TCL_ERROR);
+	    }
+
+	  if (commands[i].max_args > 0 && argc > commands[i].max_args)
+	    {
+	      char buf[20];
+	      Tcl_AppendResult (interp, "wrong # args: got ", (char *) NULL);
+	      sprintf (buf, "%d", argc);
+	      Tcl_AppendResult (interp, buf, " but expected at most ",
+				(char *) NULL);
+	      sprintf (buf, "%d", commands[i].max_args);
+	      Tcl_AppendResult (interp, buf, (char *) NULL);
+	      return (TCL_ERROR);
+	    }
+
+	  return (commands[i].func (data->subdata, interp, argc, argv));
+	}
+    }
+
+  Tcl_AppendResult (interp, "unrecognized key \"", argv[1],
+		    "\"; must be one of ", (char *) NULL);
+  for (i = 0; commands[i].method != NULL; ++i)
+    Tcl_AppendResult (interp, "\"", commands[i].method,
+		      (commands[i + 1].method == NULL) ? "\"" : "\", ",
+		      (char *) NULL);
+  return (TCL_ERROR);
+}
+
+/* Define a command with subcommands.  */
+int
+ide_create_command_with_subcommands (Tcl_Interp *interp, char *name,
+				     const struct ide_subcommand_table *table,
+				     ClientData subdata,
+				     Tcl_CmdDeleteProc *delete)
+{
+  int i;
+  struct subcommand_clientdata *data;
+
+  /* Sanity check.  */
+  for (i = 0; table[i].method != NULL; ++i)
+    {
+      if ((table[i].min_args > table[i].max_args && table[i].max_args != -1)
+	  || table[i].min_args < 2
+	  || table[i].max_args < -1)
+	{
+	  Tcl_AppendResult (interp, "subcommand \"", table[i].method,
+			    "\" of command \"", name,
+			    "\" has bad argument count",
+			    (char *) NULL);
+	  return (TCL_ERROR);
+	}
+    }
+
+  data = (struct subcommand_clientdata *) Tcl_Alloc (sizeof *data);
+  data->commands = table;
+  data->subdata = subdata;
+  data->delete = delete;
+
+  if (Tcl_CreateCommand (interp, name, subcommand_implementation,
+			 (ClientData) data, subcommand_deleted) == NULL)
+    return (TCL_ERROR);
+
+  return (TCL_OK);
+}