summaryrefslogtreecommitdiffstats
path: root/tools
diff options
context:
space:
mode:
Diffstat (limited to 'tools')
-rw-r--r--tools/genStubs.tcl258
1 files changed, 186 insertions, 72 deletions
diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl
index 96354f0..c29f6c9 100644
--- a/tools/genStubs.tcl
+++ b/tools/genStubs.tcl
@@ -157,7 +157,7 @@ proc genStubs::hooks {names} {
# Arguments:
# index The index number of the interface.
# platform The platform the interface belongs to. Should be one
-# of generic, win, unix, or mac, or macosx or aqua or x11.
+# of generic, win, unix, or macosx or aqua or x11.
# decl The C function declaration, or {} for an undefined
# entry.
#
@@ -298,19 +298,12 @@ proc genStubs::addPlatformGuard {plat iftxt {eltxt {}} {withCygwin 0}} {
if {$withCygwin} {
append text " && !defined(__CYGWIN__)"
}
- append text " && !defined(MAC_TCL)\
+ append text " && !defined(MAC_OSX_TCL)\
/* UNIX */\n${iftxt}"
if {$eltxt != ""} {
append text "#else /* UNIX */\n${eltxt}"
}
append text "#endif /* UNIX */\n"
- }
- mac {
- append text "#ifdef MAC_TCL\n${iftxt}"
- if {$eltxt != ""} {
- append text "#else /* MAC_TCL */\n${eltxt}"
- }
- append text "#endif /* MAC_TCL */\n"
}
macosx {
append text "#ifdef MAC_OSX_TCL /* MACOSX */\n${iftxt}"
@@ -331,7 +324,7 @@ proc genStubs::addPlatformGuard {plat iftxt {eltxt {}} {withCygwin 0}} {
if {$withCygwin} {
append text " || defined(__CYGWIN__)"
}
- append text " || defined(MAC_TCL) || defined(MAC_OSX_TK))\
+ append text " || defined(MAC_OSX_TK))\
/* X11 */\n${iftxt}"
if {$eltxt != ""} {
append text "#else /* X11 */\n${eltxt}"
@@ -696,100 +689,221 @@ proc genStubs::forAllStubs {name slotProc onAll textVar
append text [$slotProc $name $stubs($name,generic,$i) $i]
set emit 1
} elseif {[llength $slots] > 0} {
- foreach plat {unix win mac} {
- if {[info exists stubs($name,$plat,$i)]} {
- append text [addPlatformGuard $plat \
- [$slotProc $name $stubs($name,$plat,$i) $i]]
- set emit 1
+ array set slot {unix 0 x11 0 win 0 macosx 0 aqua 0}
+ foreach s $slots {
+ set slot([lindex [split $s ,] 1]) 1
+ }
+ # "aqua", "macosx" and "x11" are special cases:
+ # "macosx" implies "unix", "aqua" implies "macosx" and "x11"
+ # implies "unix", so we need to be careful not to emit
+ # duplicate stubs entries:
+ if {($slot(unix) && $slot(macosx)) || (
+ ($slot(unix) || $slot(macosx)) &&
+ ($slot(x11) || $slot(aqua)))} {
+ puts stderr "conflicting platform entries: $name $i"
+ }
+ ## unix ##
+ set temp {}
+ set plat unix
+ if {!$slot(aqua) && !$slot(x11)} {
+ if {$slot($plat)} {
+ append temp [$slotProc $name $stubs($name,$plat,$i) $i]
} elseif {$onAll} {
- append text [eval {addPlatformGuard $plat} $skipString]
- set emit 1
+ eval {append temp} $skipString
}
}
- #
- # "aqua" and "macosx" and "x11" are special cases,
- # since "macosx" always implies "unix" and "aqua",
- # "macosx", so we need to be careful not to
- # emit duplicate stubs entries for the two.
- #
- if {[info exists stubs($name,aqua,$i)]
- && ![info exists stubs($name,macosx,$i)]} {
- append text [addPlatformGuard aqua \
- [$slotProc $name $stubs($name,aqua,$i) $i]]
+ if {$temp ne ""} {
+ append text [addPlatformGuard $plat $temp]
set emit 1
}
- if {[info exists stubs($name,macosx,$i)]
- && ![info exists stubs($name,unix,$i)]} {
- append text [addPlatformGuard macosx \
- [$slotProc $name $stubs($name,macosx,$i) $i]]
+ ## x11 ##
+ set temp {}
+ set plat x11
+ if {!$slot(unix) && !$slot(macosx)} {
+ if {$slot($plat)} {
+ append temp [$slotProc $name $stubs($name,$plat,$i) $i]
+ } elseif {$onAll} {
+ eval {append temp} $skipString
+ }
+ }
+ if {$temp ne ""} {
+ append text [addPlatformGuard $plat $temp]
set emit 1
}
- if {[info exists stubs($name,x11,$i)]
- && ![info exists stubs($name,unix,$i)]} {
- append text [addPlatformGuard x11 \
- [$slotProc $name $stubs($name,x11,$i) $i]]
+ ## win ##
+ set temp {}
+ set plat win
+ if {$slot($plat)} {
+ append temp [$slotProc $name $stubs($name,$plat,$i) $i]
+ } elseif {$onAll} {
+ eval {append temp} $skipString
+ }
+ if {$temp ne ""} {
+ append text [addPlatformGuard $plat $temp]
+ set emit 1
+ }
+ ## macosx ##
+ set temp {}
+ set plat macosx
+ if {!$slot(aqua) && !$slot(x11)} {
+ if {$slot($plat)} {
+ append temp [$slotProc $name $stubs($name,$plat,$i) $i]
+ } elseif {$slot(unix)} {
+ append temp [$slotProc $name $stubs($name,unix,$i) $i]
+ } elseif {$onAll} {
+ eval {append temp} $skipString
+ }
+ }
+ if {$temp ne ""} {
+ append text [addPlatformGuard $plat $temp]
+ set emit 1
+ }
+ ## aqua ##
+ set temp {}
+ set plat aqua
+ if {!$slot(unix) && !$slot(macosx)} {
+ if {[string range $skipString 1 2] ne "/*"} {
+ # genStubs.tcl previously had a bug here causing it to
+ # erroneously generate both a unix entry and an aqua
+ # entry for a given stubs table slot. To preserve
+ # backwards compatibility, generate a dummy stubs entry
+ # before every aqua entry (note that this breaks the
+ # correspondence between emitted entry number and
+ # actual position of the entry in the stubs table, e.g.
+ # TkIntStubs entry 113 for aqua is in fact at position
+ # 114 in the table, entry 114 at position 116 etc).
+ eval {append temp} $skipString
+ set temp "[string range $temp 0 end-1] /*\
+ Dummy entry for stubs table backwards\
+ compatibility */\n"
+ }
+ if {$slot($plat)} {
+ append temp [$slotProc $name $stubs($name,$plat,$i) $i]
+ } elseif {$onAll} {
+ eval {append temp} $skipString
+ }
+ }
+ if {$temp ne ""} {
+ append text [addPlatformGuard $plat $temp]
set emit 1
}
}
- if {$emit == 0} {
+ if {!$emit} {
eval {append text} $skipString
}
}
-
} else {
# Emit separate stubs blocks per platform
- foreach plat {unix win mac} {
- if {[info exists stubs($name,$plat,lastNum)]} {
- set lastNum $stubs($name,$plat,lastNum)
- set temp {}
- for {set i 0} {$i <= $lastNum} {incr i} {
- if {![info exists stubs($name,$plat,$i)]} {
- eval {append temp} $skipString
- } else {
- append temp [$slotProc $name $stubs($name,$plat,$i) $i]
- }
+ array set block {unix 0 x11 0 win 0 macosx 0 aqua 0}
+ foreach s [array names stubs $name,*,lastNum] {
+ set block([lindex [split $s ,] 1]) 1
+ }
+ ## unix ##
+ if {$block(unix) && !$block(x11)} {
+ set temp {}
+ set plat unix
+ set lastNum $stubs($name,$plat,lastNum)
+ for {set i 0} {$i <= $lastNum} {incr i} {
+ if {[info exists stubs($name,$plat,$i)]} {
+ append temp [$slotProc $name $stubs($name,$plat,$i) $i]
+ } else {
+ eval {append temp} $skipString
}
- append text [addPlatformGuard $plat $temp {} true]
}
+ append text [addPlatformGuard $plat $temp {} true]
}
- # Again, make sure you don't duplicate entries for macosx & aqua.
- if {[info exists stubs($name,aqua,lastNum)]
- && ![info exists stubs($name,macosx,lastNum)]} {
- set lastNum $stubs($name,aqua,lastNum)
+ ## win ##
+ if {$block(win)} {
set temp {}
+ set plat win
+ set lastNum $stubs($name,$plat,lastNum)
for {set i 0} {$i <= $lastNum} {incr i} {
- if {![info exists stubs($name,aqua,$i)]} {
- eval {append temp} $skipString
+ if {[info exists stubs($name,$plat,$i)]} {
+ append temp [$slotProc $name $stubs($name,$plat,$i) $i]
} else {
- append temp [$slotProc $name $stubs($name,aqua,$i) $i]
- }
+ eval {append temp} $skipString
}
- append text [addPlatformGuard aqua $temp]
}
- # Again, make sure you don't duplicate entries for macosx & unix.
- if {[info exists stubs($name,macosx,lastNum)]
- && ![info exists stubs($name,unix,lastNum)]} {
- set lastNum $stubs($name,macosx,lastNum)
+ append text [addPlatformGuard $plat $temp {} true]
+ }
+ ## macosx ##
+ if {$block(macosx) && !$block(aqua) && !$block(x11)} {
set temp {}
+ set lastNum -1
+ foreach plat {unix macosx} {
+ if {$block($plat)} {
+ set lastNum [expr {$lastNum > $stubs($name,$plat,lastNum)
+ ? $lastNum : $stubs($name,$plat,lastNum)}]
+ }
+ }
for {set i 0} {$i <= $lastNum} {incr i} {
- if {![info exists stubs($name,macosx,$i)]} {
+ set emit 0
+ foreach plat {unix macosx} {
+ if {[info exists stubs($name,$plat,$i)]} {
+ append temp [$slotProc $name $stubs($name,$plat,$i) $i]
+ set emit 1
+ break
+ }
+ }
+ if {!$emit} {
eval {append temp} $skipString
- } else {
- append temp [$slotProc $name $stubs($name,macosx,$i) $i]
+ }
+ }
+ append text [addPlatformGuard macosx $temp]
+ }
+ ## aqua ##
+ if {$block(aqua)} {
+ set temp {}
+ set lastNum -1
+ foreach plat {unix macosx aqua} {
+ if {$block($plat)} {
+ set lastNum [expr {$lastNum > $stubs($name,$plat,lastNum)
+ ? $lastNum : $stubs($name,$plat,lastNum)}]
+ }
+ }
+ for {set i 0} {$i <= $lastNum} {incr i} {
+ set emit 0
+ foreach plat {unix macosx aqua} {
+ if {[info exists stubs($name,$plat,$i)]} {
+ append temp [$slotProc $name $stubs($name,$plat,$i) $i]
+ set emit 1
+ break
}
}
- append text [addPlatformGuard macosx $temp]
+ if {!$emit} {
+ eval {append temp} $skipString
+ }
}
- # Again, make sure you don't duplicate entries for x11 & unix.
- if {[info exists stubs($name,x11,lastNum)]
- && ![info exists stubs($name,unix,lastNum)]} {
- set lastNum $stubs($name,x11,lastNum)
+ append text [addPlatformGuard aqua $temp]
+ }
+ ## x11 ##
+ if {$block(x11)} {
set temp {}
+ set lastNum -1
+ foreach plat {unix macosx x11} {
+ if {$block($plat)} {
+ set lastNum [expr {$lastNum > $stubs($name,$plat,lastNum)
+ ? $lastNum : $stubs($name,$plat,lastNum)}]
+ }
+ }
for {set i 0} {$i <= $lastNum} {incr i} {
- if {![info exists stubs($name,x11,$i)]} {
+ set emit 0
+ foreach plat {unix macosx x11} {
+ if {[info exists stubs($name,$plat,$i)]} {
+ if {$plat ne "macosx"} {
+ append temp [$slotProc $name \
+ $stubs($name,$plat,$i) $i]
+ } else {
+ eval {set etxt} $skipString
+ append temp [addPlatformGuard $plat [$slotProc \
+ $name $stubs($name,$plat,$i) $i] $etxt true]
+ }
+ set emit 1
+ break
+ }
+ }
+ if {!$emit} {
eval {append temp} $skipString
- } else {
- append temp [$slotProc $name $stubs($name,x11,$i) $i]
}
}
append text [addPlatformGuard x11 $temp {} true]