summaryrefslogtreecommitdiffstats
path: root/tools/genStubs.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'tools/genStubs.tcl')
-rw-r--r--tools/genStubs.tcl75
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