* tools/genStubs.tcl: Updated script to no longer produce the

        _ANSI_ARGS_ wrapper in generated declarations.  Also revised to
        accept variadic prototypes with more than one fixed argument.
        (This is possible since TCL_VARARGS and its limitations are no
        longer in use).
        * generic/tcl.h:        Some reordering so that macro definitions
        do not interfere with the now _ANSI_ARGS_-less stub declarations.

        * generic/tclDecls.h:           make genstubs
        * generic/tclIntDecls.h:
        * generic/tclIntPlatDecls.h:
        * generic/tclPlatDecls.h:
        * generic/tclTomMathDecls.h:


FossilOrigin-Name: 40a5f13181379887fbe3db5ef8d7977393700b19

1 files changed, 40 insertions, 35 deletions

diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl
index 788ab7a..db00f04 100644
--- a/tools/genStubs.tcl
+++ b/tools/genStubs.tcl
@@ -8,7 +8,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 # 
-# RCS: @(#) $Id: genStubs.tcl,v 1.18 2005/09/13 21:23:51 dgp Exp $
+# RCS: @(#) $Id: genStubs.tcl,v 1.19 2006/11/15 14:58:27 dgp Exp $
 
 package require Tcl 8
 
@@ -285,15 +285,16 @@ proc genStubs::parseDecl {decl} {
 	lappend argList [string trim $arg]
     }
     if {![string compare [lindex $argList end] "..."]} {
-	if {[llength $argList] != 2} {
-	    puts stderr "Only one argument is allowed in varargs form: $decl"
-	}
-	set arg [parseArg [lindex $argList 0]]
-	if {$arg == "" || ([llength $arg] != 2)} {
-	    puts stderr "Bad argument: '[lindex $argList 0]' in '$decl'"
-	    return
+	set args TCL_VARARGS
+	foreach arg [lrange $argList 0 end-1] {
+	    set argInfo [parseArg $arg]
+	    if {[llength $argInfo] == 2 || [llength $argInfo] == 3} {
+		lappend args $argInfo
+	    } else {
+		puts stderr "Bad argument: '$arg' in '$decl'"
+		return
+	    }
 	}
-	set args [list TCL_VARARGS $arg]
     } else {
 	set args {}
 	foreach arg $argList {
@@ -362,7 +363,7 @@ proc genStubs::makeDecl {name decl index} {
 	append line " "
 	set pad 0
     }
-    append line "$fname _ANSI_ARGS_("
+    append line "$fname "
 
     set arg1 [lindex $args 0]
     switch -exact $arg1 {
@@ -370,8 +371,22 @@ proc genStubs::makeDecl {name decl index} {
 	    append line "(void)"
 	}
 	TCL_VARARGS {
-	    set arg [lindex $args 1]
-	    append line "([lindex $arg 0][lindex $arg 1], ...)"
+	    set sep "("
+	    foreach arg [lrange $args 1 end] {
+		append line $sep
+		set next {}
+		append next [lindex $arg 0] " " [lindex $arg 1] \
+			[lindex $arg 2]
+		if {[string length $line] + [string length $next] \
+			+ $pad > 76} {
+		    append text $line \n
+		    set line "\t\t\t\t"
+		    set pad 28
+		}
+		append line $next
+		set sep ", "
+	    }
+	    append line ", ...)"
 	}
 	default {
 	    set sep "("
@@ -394,7 +409,7 @@ proc genStubs::makeDecl {name decl index} {
     }
     append text $line
     
-    append text ");"
+    append text ";"
     format "#ifndef %s_TCL_DECLARED\n#define %s_TCL_DECLARED\n%s\n#endif\n" \
 	    $fname $fname $text
 }
@@ -418,23 +433,6 @@ proc genStubs::makeMacro {name decl index} {
     append lfname [string range $fname 1 end]
 
     set text "#ifndef $fname\n#define $fname"
-    set arg1 [lindex $args 0]
-    set argList ""
-    switch -exact $arg1 {
-	void {
-	    set argList "()"
-	}
-	TCL_VARARGS {
-	}
-	default {
-	    set sep "("
-	    foreach arg $args {
-		append argList $sep [lindex $arg 1]
-		set sep ", "
-	    }
-	    append argList ")"
-	}
-    }
     append text " \\\n\t(${name}StubsPtr->$lfname)"
     append text " /* $index */\n#endif\n"
     return $text
@@ -524,7 +522,7 @@ proc genStubs::makeSlot {name decl index} {
     append lfname [string range $fname 1 end]
 
     set text "    "
-    append text $rtype " (*" $lfname ") _ANSI_ARGS_("
+    append text $rtype " (*" $lfname ") "
 
     set arg1 [lindex $args 0]
     switch -exact $arg1 {
@@ -532,8 +530,13 @@ proc genStubs::makeSlot {name decl index} {
 	    append text "(void)"
 	}
 	TCL_VARARGS {
-	    set arg [lindex $args 1]
-	    append text "([lindex $arg 0][lindex $arg 1], ...)"
+	    set sep "("
+	    foreach arg [lrange $args 1 end] {
+		append text $sep [lindex $arg 0] " " [lindex $arg 1] \
+			[lindex $arg 2]
+		set sep ", "
+	    }
+	    append text ", ...)"
 	}
 	default {
 	    set sep "("
@@ -546,7 +549,7 @@ proc genStubs::makeSlot {name decl index} {
 	}
     }
     
-    append text "); /* $index */\n"
+    append text "; /* $index */\n"
     return $text
 }
 
@@ -958,6 +961,7 @@ proc genStubs::init {} {
 # Results:
 #	Returns any values that were not assigned to variables.
 
+if {[string length [namespace which lassign]] == 0} {
 proc lassign {valueList args} {
   if {[llength $args] == 0} {
       error "wrong # args: lassign list varname ?varname..?"
@@ -966,5 +970,6 @@ proc lassign {valueList args} {
   uplevel [list foreach $args $valueList {break}]
   return [lrange $valueList [llength $args] end]
 }
-
+}
+ 
 genStubs::init