X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=chiark-tcl.git;a=blobdiff_plain;f=base%2Ftcmdifgen;h=4b675968217e6d0f09dc6dfa2339749551db37d9;hp=f14249ca4dd2441e3b9745d1fa625f76fc9cf1aa;hb=da1c2c3cbb87a600f19e250f93ef9fa4f89844fc;hpb=40a4738e440a8412c61a12eca34ed6aa98d71a5a

diff --git a/base/tcmdifgen b/base/tcmdifgen
index f14249c..4b67596 100755
--- a/base/tcmdifgen
+++ b/base/tcmdifgen
@@ -56,15 +56,15 @@
 #     Arranges for generated .h files to #include the specified
 #     file.  C-INCLUDE-SPECIFIER should include the <..> or "..".
 #
-#  Table TABLENAME C-ENTRY-TYPE
+#  Table [*]TABLENAME C-ENTRY-TYPE
 #     Starts a table of commands or subcommands.  The generated .h
 #     will contain a definition of C-ENTRY-TYPE containing
 #         const char *name;
 #         Tcl_ObjCmdProc *func;
 #     and the generated .c will contain
 #         const C-ENTRY-TYPE C-ARRAY-NAME[];
-#     where C-ARRAY-NAME is C-ENTRY-TYPE lowercased, with
-#     `s' appended.  The entries are indented one level (one
+#     where C-ARRAY-NAME is TABLENAME, with `_entries' appended
+#     and `cht_' prepended.  The entries are indented one level (one
 #     or more spaces) and look like this:
 #        ENTRYNAME
 #            FORMALARGNAME   TYPE
@@ -89,6 +89,10 @@
 #     arguments, processes the command, and sets any result, as
 #     applicable.
 #
+#     `*' should be used if the table name is not useful for error
+#     messages.  It suppresses `TABLENAME ' from the front of the
+#     autogenerated argument parsing error strings.
+#
 #  ExtraEntry C-ENTRY-TYPE
 #     Introduces a section of additional C code which will be inserted
 #     into the definition of C-ENTRY-TYPE by `Table'.  The C
@@ -150,6 +154,17 @@ sub zilch () {
     undef $c_of;
 }
 
+sub enumargs ($) {
+    my ($a) = @_;
+    $a =~ m:/(.*),: or die "invalid enum type \`$a'\n";
+    my ($a_tab, $ee_type, $estr) = ($`,$1,$');
+    if ($ee_type !~ m/^[^_]/) {
+	$ee_type= $a_tab.$ee_type;
+	$a_tab= lc($a_tab).'_entries';
+    }
+    return ($a_tab, $ee_type, $estr);
+}
+
 sub parse ($$) {
     my ($wh,$f) = @_;
     while (defined($_= $f->getline)) {
@@ -167,11 +182,12 @@ sub parse ($$) {
 	    unshift @i, $this_indent;
 	}
 
-	if (@i==0 && m/^Table\s+(\*toplevel\*|\w+)\s+(\w+)$/) {
+	if (@i==0 && m/^Table\s+(\*?)(\w+)\s+(\w+)$/) {
 	    zilch();
-	    $c_table= $1;
-	    $table_x{$c_table}{C}= $2;
-	    $entrytype_x{$2}= '' unless exists $entrytype_x{$2};
+	    $c_table= $2;
+	    $table_x{$c_table}{T}= $1;
+	    $table_x{$c_table}{C}= $3;
+	    $entrytype_x{$3}= '' unless exists $entrytype_x{$3};
 	} elsif (@i==0 && m/^Untabled$/) {
 	    zilch();
 	    $c_table= '';
@@ -280,7 +296,8 @@ foreach $c_table (sort keys %tables) {
 	$any_eerr= 0;
 	$any_eargc= 0;
 	$pa_hint= '';
-	$pa_hint .= "$c_table " if length $c_table;
+	$pa_hint .= "$c_table " if length $c_table &&
+	    !length $table_x{$c_table}{T};
 	$pa_hint.= $c_entry;
 	foreach $arg (@{ $r_entry->{A} }) {
 	    $n= $arg->{N};
@@ -310,10 +327,9 @@ foreach $c_table (sort keys %tables) {
 		$pa_vars .= "  const void *v_$n= 0;\n";
 		$paarg= "&v_$n";
 		$pafin= "\n  a_$n= v_$n; ";
-		$a =~ m/\,/ or die "invalid enum type \`$a'\n";
-		$a_tab = lc($`).'s';
-		$a = "$a_tab, sizeof($`), $'";
-		o('h', 210, "extern const $` $a_tab".'[]'.";\n");
+		($a_tab, $ee_type, $estr) = enumargs($a);
+		$a = "cht_$a_tab, sizeof($ee_type), $estr";
+		o('h', 210, "extern const $ee_type cht_$a_tab".'[]'.";\n");
 	    }
 	    if (exists $type_fini{$t}) {
 		$pa_fini .= '  '.subst_in("a_$n", $type_fini{$t})."\n";
@@ -369,7 +385,7 @@ foreach $c_table (sort keys %tables) {
 	    $pa_vars .= "  const char *e;\n";
 	    $pa_fini .= "\n";
 	    $pa_fini .= "e_err:\n";
-	    $pa_fini .= "  setstringresult(ip,e);\n";
+	    $pa_fini .= "  cht_setstringresult(ip,e);\n";
 	    $pa_fini .= "  rc= TCL_ERROR; goto rc_err;\n";
 	}
 	$pa_vars .= "\n";
@@ -402,7 +418,7 @@ foreach $c_table (sort keys %tables) {
 			   $r_entry->{I});
     }
     if (length $c_table) {
-	$decl= "const $x_table->{C} ".lc($x_table->{C}).'s[]';
+	$decl= "const $x_table->{C} cht_${c_table}_entries[]";
 	o('h', 500, "extern $decl;\n");
 	o('c', 100,
 	  "$decl = {\n".
@@ -416,8 +432,7 @@ o(c, 0, "#include \"$prefix.h\"\n");
 
 o(h, 0,
   "#ifndef INCLUDED_\U${prefix}_H\n".
-  "#define INCLUDED_\U${prefix}_H\n\n".
-  "#include <tcl8.3/tcl.h>\n");
+  "#define INCLUDED_\U${prefix}_H\n\n");
 
 o(h, 999,
   "#endif /*INCLUDED_\U${prefix}_H*/\n");
@@ -478,8 +493,8 @@ sub make_decl ($$$$) {
     my ($n, $t, $ta, $why) = @_;
     my ($type);
     if ($t eq 'enum') {
-	$ta =~ m/\,/ or die "invalid enum type \`$t' ($why)\n";
-	$c= "const $` *@";
+	($a_tab, $ee_type, $estr) = enumargs($ta);
+	$c= "const $ee_type* @";
     } else { 
 	defined $types{$t} or die "unknown type $t ($why)\n";
 	$c= $types{$t}{C};