summaryrefslogtreecommitdiffstats
path: root/tools/genStubs.tcl
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2012-03-20 08:33:13 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2012-03-20 08:33:13 (GMT)
commit23f5b19d027c7c6f2eec97dd900569b56a9087f7 (patch)
tree26e4c9ca77a9172d456507c85d328b5ae1368326 /tools/genStubs.tcl
parentd61767f9a7d9b5fee5a3e2f460ba5239180f6e8e (diff)
parentfefa2c52da187dad8fac68f63f757cde175bdf8e (diff)
downloadtcl-23f5b19d027c7c6f2eec97dd900569b56a9087f7.zip
tcl-23f5b19d027c7c6f2eec97dd900569b56a9087f7.tar.gz
tcl-23f5b19d027c7c6f2eec97dd900569b56a9087f7.tar.bz2
[Bug 3508771] load tclreg.dll in cygwin tclsh
Diffstat (limited to 'tools/genStubs.tcl')
-rw-r--r--tools/genStubs.tcl77
1 files changed, 42 insertions, 35 deletions
diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl
index 8e8cbfd..5e86b69 100644
--- a/tools/genStubs.tcl
+++ b/tools/genStubs.tcl
@@ -1,8 +1,8 @@
# genStubs.tcl --
#
# This script generates a set of stub files for a given
-# interface.
-#
+# interface.
+#
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# See the file "license.terms" for information on usage and redistribution
@@ -14,7 +14,7 @@ namespace eval genStubs {
# libraryName --
#
# The name of the entire library. This value is used to compute
- # the USE_*_STUB_PROCS macro and the name of the init file.
+ # the USE_*_STUBS macro and the name of the init file.
variable libraryName "UNKNOWN"
@@ -131,10 +131,15 @@ proc genStubs::declare {args} {
variable stubs
variable curName
- if {[llength $args] != 3} {
+ if {[llength $args] == 2} {
+ lassign $args index decl
+ set platformList generic
+ } elseif {[llength $args] == 3} {
+ lassign $args index platformList decl
+ } else {
puts stderr "wrong # args: declare $args"
+ return
}
- lassign $args index platformList decl
# Check for duplicate declarations, then add the declaration and
# bump the lastNum counter if necessary.
@@ -179,6 +184,7 @@ proc genStubs::rewriteFile {file text} {
}
set in [open ${file} r]
set out [open ${file}.new w]
+ fconfigure $out -translation lf
while {![eof $in]} {
set line [gets $in]
@@ -251,7 +257,6 @@ proc genStubs::addPlatformGuard {plat text} {
# None.
proc genStubs::emitSlots {name textVar} {
- variable stubs
upvar $textVar text
forAllStubs $name makeSlot 1 text {" void *reserved$i;\n"}
@@ -379,11 +384,14 @@ proc genStubs::makeDecl {name decl index} {
foreach arg $args {
append line $sep
set next {}
- append next [lindex $arg 0] " " [lindex $arg 1] \
- [lindex $arg 2]
+ 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 $line \n
+ append text [string trimright $line] \n
set line "\t\t\t\t"
set pad 28
}
@@ -393,10 +401,7 @@ proc genStubs::makeDecl {name decl index} {
append line ")"
}
}
- append text $line
-
- append text ");\n"
- return $text
+ return "$text$line);\n"
}
# genStubs::makeMacro --
@@ -538,14 +543,17 @@ proc genStubs::makeSlot {name decl index} {
default {
set sep "("
foreach arg $args {
- append text $sep [lindex $arg 0] " " [lindex $arg 1] \
- [lindex $arg 2]
+ append text $sep [lindex $arg 0]
+ if {[string index $text end] ne "*"} {
+ append text " "
+ }
+ append text [lindex $arg 1] [lindex $arg 2]
set sep ", "
}
append text ")"
}
}
-
+
append text "); /* $index */\n"
return $text
}
@@ -588,7 +596,7 @@ proc genStubs::makeInit {name decl index} {
# Results:
# None.
-proc genStubs::forAllStubs {name slotProc onAll textVar \
+proc genStubs::forAllStubs {name slotProc onAll textVar
{skipString {"/* Slot $i is reserved */\n"}}} {
variable stubs
upvar $textVar text
@@ -607,7 +615,8 @@ proc genStubs::forAllStubs {name slotProc onAll textVar \
set emit 0
if {[info exists stubs($name,generic,$i)]} {
if {[llength $slots] > 1} {
- puts stderr "platform entry duplicates generic entry: $i"
+ puts stderr "conflicting generic and platform entries:\
+ $name $i"
}
append text [$slotProc $name $stubs($name,generic,$i) $i]
set emit 1
@@ -706,10 +715,10 @@ proc genStubs::forAllStubs {name slotProc onAll textVar \
eval {append temp} $skipString
} else {
append temp [$slotProc $name $stubs($name,x11,$i) $i]
- }
}
- append text [addPlatformGuard x11 $temp]
}
+ append text [addPlatformGuard x11 $temp]
+ }
}
}
@@ -725,7 +734,6 @@ proc genStubs::forAllStubs {name slotProc onAll textVar \
# None.
proc genStubs::emitDeclarations {name textVar} {
- variable stubs
upvar $textVar text
append text "\n/*\n * Exported function declarations:\n */\n\n"
@@ -745,14 +753,13 @@ proc genStubs::emitDeclarations {name textVar} {
# None.
proc genStubs::emitMacros {name textVar} {
- variable stubs
variable libraryName
upvar $textVar text
set upName [string toupper $libraryName]
append text "\n#if defined(USE_${upName}_STUBS) && !defined(USE_${upName}_STUB_PROCS)\n"
append text "\n/*\n * Inline function declarations:\n */\n\n"
-
+
forAllStubs $name makeMacro 0 text
append text "\n#endif /* defined(USE_${upName}_STUBS) && !defined(USE_${upName}_STUB_PROCS) */\n"
@@ -794,9 +801,9 @@ proc genStubs::emitHeader {name} {
emitSlots $name text
- append text "} ${capName}Stubs;\n"
+ append text "} ${capName}Stubs;\n\n"
- append text "\n#ifdef __cplusplus\nextern \"C\" {\n#endif\n"
+ append text "#ifdef __cplusplus\nextern \"C\" {\n#endif\n"
append text "extern ${capName}Stubs *${name}StubsPtr;\n"
append text "#ifdef __cplusplus\n}\n#endif\n"
@@ -839,7 +846,6 @@ proc genStubs::emitStubs {name} {
# Returns the formatted output.
proc genStubs::emitInit {name textVar} {
- variable stubs
variable hooks
upvar $textVar text
@@ -847,7 +853,7 @@ proc genStubs::emitInit {name textVar} {
append capName [string range $name 1 end]
if {[info exists hooks($name)]} {
- append text "\nstatic ${capName}StubHooks ${name}StubHooks = \{\n"
+ append text "\nstatic ${capName}StubHooks ${name}StubHooks = \{\n"
set sep " "
foreach sub $hooks($name) {
append text $sep "&${sub}Stubs"
@@ -862,7 +868,7 @@ proc genStubs::emitInit {name textVar} {
} else {
append text " NULL,\n"
}
-
+
forAllStubs $name makeInit 1 text {" NULL, /* $i */\n"}
append text "\};\n"
@@ -953,13 +959,14 @@ proc genStubs::init {} {
# Results:
# Returns any values that were not assigned to variables.
-proc lassign {valueList args} {
- if {[llength $args] == 0} {
- error "wrong # args: lassign list varname ?varname..?"
- }
-
- uplevel [list foreach $args $valueList {break}]
- return [lrange $valueList [llength $args] end]
+if {[string length [namespace which lassign]] == 0} {
+ proc lassign {valueList args} {
+ if {[llength $args] == 0} {
+ error "wrong # args: should be \"lassign list varName ?varName ...?\""
+ }
+ uplevel [list foreach $args $valueList {break}]
+ return [lrange $valueList [llength $args] end]
+ }
}
genStubs::init