diff options
Diffstat (limited to 'tools/genStubs.tcl')
| -rw-r--r-- | tools/genStubs.tcl | 85 |
1 files changed, 46 insertions, 39 deletions
diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl index db26629..c7dbe93 100644 --- a/tools/genStubs.tcl +++ b/tools/genStubs.tcl @@ -5,10 +5,12 @@ # # # Copyright (c) 1998-1999 by Scriptics Corporation. +# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net> +# # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require Tcl 8 +package require Tcl 8.4 namespace eval genStubs { # libraryName -- @@ -248,7 +250,7 @@ proc genStubs::rewriteFile {file text} { while {![eof $in]} { set line [gets $in] - if {[regexp {!BEGIN!} $line]} { + if {[string match "*!BEGIN!*" $line]} { break } puts $out $line @@ -257,7 +259,7 @@ proc genStubs::rewriteFile {file text} { puts $out $text while {![eof $in]} { set line [gets $in] - if {[regexp {!END!} $line]} { + if {[string match "*!END!*" $line]} { break } } @@ -288,7 +290,7 @@ proc genStubs::addPlatformGuard {plat iftxt {eltxt {}} {withCygwin 0}} { append text " || defined(__CYGWIN__)" } append text " /* WIN */\n${iftxt}" - if {$eltxt != ""} { + if {$eltxt ne ""} { append text "#else /* WIN */\n${eltxt}" } append text "#endif /* WIN */\n" @@ -300,21 +302,21 @@ proc genStubs::addPlatformGuard {plat iftxt {eltxt {}} {withCygwin 0}} { } append text " && !defined(MAC_OSX_TCL)\ /* UNIX */\n${iftxt}" - if {$eltxt != ""} { + if {$eltxt ne ""} { append text "#else /* UNIX */\n${eltxt}" } append text "#endif /* UNIX */\n" } macosx { append text "#ifdef MAC_OSX_TCL /* MACOSX */\n${iftxt}" - if {$eltxt != ""} { + if {$eltxt ne ""} { append text "#else /* MACOSX */\n${eltxt}" } append text "#endif /* MACOSX */\n" } aqua { append text "#ifdef MAC_OSX_TK /* AQUA */\n${iftxt}" - if {$eltxt != ""} { + if {$eltxt ne ""} { append text "#else /* AQUA */\n${eltxt}" } append text "#endif /* AQUA */\n" @@ -326,7 +328,7 @@ proc genStubs::addPlatformGuard {plat iftxt {eltxt {}} {withCygwin 0}} { } append text " || defined(MAC_OSX_TK))\ /* X11 */\n${iftxt}" - if {$eltxt != ""} { + if {$eltxt ne ""} { append text "#else /* X11 */\n${eltxt}" } append text "#endif /* X11 */\n" @@ -460,7 +462,7 @@ proc genStubs::makeDecl {name decl index} { lassign $decl rtype fname args append text "/* $index */\n" - if {($rtype != "void") && ($rtype != "pascal void")} { + if {$rtype != "void"} { regsub -all void $rtype VOID rtype } set line "$scspec $rtype" @@ -471,13 +473,13 @@ proc genStubs::makeDecl {name decl index} { append line " " set pad 0 } - if {$args == ""} { + if {$args eq ""} { append line $fname append text $line append text ";\n" return $text } - append line "$fname _ANSI_ARGS_(" + append line $fname regsub -all void $args VOID args set arg1 [lindex $args 0] @@ -486,8 +488,25 @@ proc genStubs::makeDecl {name decl index} { append line "(void)" } TCL_VARARGS { - set arg [lindex $args 1] - append line "TCL_VARARGS([lindex $arg 0],[lindex $arg 1])" + set sep "(" + foreach arg [lrange $args 1 end] { + append line $sep + set next {} + append next [lindex $arg 0] + if {[string index $next end] ne "*"} { + append next " " + } + append next [lindex $arg 1] [lindex $arg 2] + if {[string length $line] + [string length $next] \ + + $pad > 76} { + append text [string trimright $line] \n + set line "\t\t\t\t" + set pad 28 + } + append line $next + set sep ", " + } + append line ", ...)" } default { set sep "(" @@ -495,7 +514,7 @@ proc genStubs::makeDecl {name decl index} { append line $sep set next {} append next [lindex $arg 0] - if {[string index $next end] != "*"} { + if {[string index $next end] ne "*"} { append next " " } append next [lindex $arg 1] [lindex $arg 2] @@ -511,7 +530,9 @@ proc genStubs::makeDecl {name decl index} { append line ")" } } - return "$text$line);\n" + append text $line ";" + format "#ifndef %s_TCL_DECLARED\n#define %s_TCL_DECLARED\n%s\n#endif\n" \ + $fname $fname $text } # genStubs::makeMacro -- @@ -532,25 +553,11 @@ proc genStubs::makeMacro {name decl index} { set lfname [string tolower [string index $fname 0]] 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 ")" - } + set text "#ifndef $fname\n#define $fname \\\n\t(" + if {$args == ""} { + append text "*" } - append text " \\\n\t(${name}StubsPtr->$lfname)" + append text "${name}StubsPtr->$lfname)" append text " /* $index */\n#endif\n" return $text } @@ -578,13 +585,13 @@ proc genStubs::makeSlot {name decl index} { append text $rtype " *" $lfname "; /* $index */\n" return $text } - if {($rtype != "void") && ($rtype != "pascal void")} { + if {$rtype ne "void"} { regsub -all void $rtype VOID rtype } if {[string range $rtype end-8 end] == "__stdcall"} { - append text [string trim [string range $rtype 0 end-9]] " (__stdcall *" $lfname ") _ANSI_ARGS_(" + append text [string trim [string range $rtype 0 end-9]] " (__stdcall *" $lfname ") " } else { - append text $rtype " (*" $lfname ") _ANSI_ARGS_(" + append text $rtype " (*" $lfname ") " } regsub -all void $args VOID args set arg1 [lindex $args 0] @@ -596,7 +603,7 @@ proc genStubs::makeSlot {name decl index} { set sep "(" foreach arg [lrange $args 1 end] { append text $sep [lindex $arg 0] - if {[string index $text end] != "*"} { + if {[string index $text end] ne "*"} { append text " " } append text [lindex $arg 1] [lindex $arg 2] @@ -608,7 +615,7 @@ proc genStubs::makeSlot {name decl index} { set sep "(" foreach arg $args { append text $sep [lindex $arg 0] - if {[string index $text end] != "*"} { + if {[string index $text end] ne "*"} { append text " " } append text [lindex $arg 1] [lindex $arg 2] @@ -618,7 +625,7 @@ proc genStubs::makeSlot {name decl index} { } } - append text "); /* $index */\n" + append text "; /* $index */\n" return $text } |