summaryrefslogtreecommitdiffstats
path: root/generic/ttk/ttkGenStubs.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'generic/ttk/ttkGenStubs.tcl')
-rw-r--r--generic/ttk/ttkGenStubs.tcl175
1 files changed, 66 insertions, 109 deletions
diff --git a/generic/ttk/ttkGenStubs.tcl b/generic/ttk/ttkGenStubs.tcl
index d8e9a8a..90dea25 100644
--- a/generic/ttk/ttkGenStubs.tcl
+++ b/generic/ttk/ttkGenStubs.tcl
@@ -5,20 +5,26 @@
#
#
# 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.
#
-# SOURCE: tcl/tools/genStubs.tcl, revision 1.44
+# SOURCE: tcl/tools/genStubs.tcl, revision 1.20
#
-# CHANGES:
+# CHANGES:
+# + Remove xxx_TCL_DECLARED #ifdeffery
+# + Use application-defined storage class specifier instead of "EXTERN"
+# + Add "epoch" and "revision" fields to stubs table record
+# + Remove dead code related to USE_*_STUB_PROCS (emitStubs, makeStub)
# + Second argument to "declare" is used as a status guard
# instead of a platform guard.
+# + Use void (*reserved$i)(void) = 0 instead of void *reserved$i = NULL
+# for unused stub entries, in case pointer-to-function and
+# pointer-to-object are different sizes.
# + Allow trailing semicolon in function declarations
+# + stubs table is const-qualified
#
-package require Tcl 8.4
+package require Tcl 8
namespace eval genStubs {
# libraryName --
@@ -44,9 +50,9 @@ namespace eval genStubs {
# scspec --
#
# Storage class specifier for external function declarations.
- # Normally "EXTERN", may be set to something like XYZAPI
+ # Normally "extern", may be set to something like XYZAPI
#
- variable scspec "EXTERN"
+ variable scspec "extern"
# epoch, revision --
#
@@ -54,7 +60,7 @@ namespace eval genStubs {
# (@@@TODO: should be an array mapping interface names -> numbers)
#
- variable epoch {}
+ variable epoch 0
variable revision 0
# hooks --
@@ -175,15 +181,13 @@ proc genStubs::hooks {names} {
# decl The C function declaration, or {} for an undefined
# entry.
#
-# Results:
-# None.
-
proc genStubs::declare {args} {
variable stubs
variable curName
variable revision
incr revision
+
if {[llength $args] == 2} {
lassign $args index decl
set status current
@@ -200,6 +204,7 @@ proc genStubs::declare {args} {
if {[info exists stubs($curName,decl,$index)]} {
puts stderr "Duplicate entry: $index"
}
+ regsub -all const $decl CONST decl
regsub -all "\[ \t\n\]+" [string trim $decl] " " decl
set decl [parseDecl $decl]
@@ -209,25 +214,7 @@ proc genStubs::declare {args} {
if {$index > $stubs($curName,lastNum)} {
set stubs($curName,lastNum) $index
}
- return
-}
-
-# genStubs::export --
-#
-# This function is used in the declarations file to declare a symbol
-# that is exported from the library but is not in the stubs table.
-#
-# Arguments:
-# decl The C function declaration, or {} for an undefined
-# entry.
-#
-# Results:
-# None.
-proc genStubs::export {args} {
- if {[llength $args] != 1} {
- puts stderr "wrong # args: export $args"
- }
return
}
@@ -286,48 +273,22 @@ proc genStubs::rewriteFile {file text} {
# Results:
# Returns the original text inside an appropriate #ifdef.
-proc genStubs::addPlatformGuard {plat iftxt {eltxt {}}} {
- set text ""
+proc genStubs::addPlatformGuard {plat text} {
switch $plat {
win {
- append text "#ifdef __WIN32__ /* WIN */\n${iftxt}"
- if {$eltxt ne ""} {
- append text "#else /* WIN */\n${eltxt}"
- }
- append text "#endif /* WIN */\n"
+ return "#ifdef __WIN32__\n${text}#endif /* __WIN32__ */\n"
}
unix {
- append text "#if !defined(__WIN32__) && !defined(MAC_OSX_TCL)\
- /* UNIX */\n${iftxt}"
- if {$eltxt ne ""} {
- append text "#else /* UNIX */\n${eltxt}"
- }
- append text "#endif /* UNIX */\n"
+ return "#if !defined(__WIN32__) /* UNIX */\n${text}#endif /* UNIX */\n"
}
macosx {
- append text "#ifdef MAC_OSX_TCL /* MACOSX */\n${iftxt}"
- if {$eltxt ne ""} {
- append text "#else /* MACOSX */\n${eltxt}"
- }
- append text "#endif /* MACOSX */\n"
+ return "#ifdef MAC_OSX_TCL\n${text}#endif /* MAC_OSX_TCL */\n"
}
aqua {
- append text "#ifdef MAC_OSX_TK /* AQUA */\n${iftxt}"
- if {$eltxt ne ""} {
- append text "#else /* AQUA */\n${eltxt}"
- }
- append text "#endif /* AQUA */\n"
+ return "#ifdef MAC_OSX_TK\n${text}#endif /* MAC_OSX_TK */\n"
}
x11 {
- append text "#if !(defined(__WIN32__) || defined(MAC_OSX_TK))\
- /* X11 */\n${iftxt}"
- if {$eltxt ne ""} {
- append text "#else /* X11 */\n${eltxt}"
- }
- append text "#endif /* X11 */\n"
- }
- default {
- append text "${iftxt}${eltxt}"
+ return "#if !(defined(__WIN32__) || defined(MAC_OSX_TK)) /* X11 */\n${text}#endif /* X11 */\n"
}
}
return $text
@@ -335,9 +296,7 @@ proc genStubs::addPlatformGuard {plat iftxt {eltxt {}}} {
# genStubs::emitSlots --
#
-# Generate the stub table slots for the given interface. If there
-# are no generic slots, then one table is generated for each
-# platform, otherwise one table is generated for all platforms.
+# Generate the stub table slots for the given interface.
#
# Arguments:
# name The name of the interface being emitted.
@@ -348,7 +307,6 @@ proc genStubs::addPlatformGuard {plat iftxt {eltxt {}}} {
proc genStubs::emitSlots {name textVar} {
upvar $textVar text
-
forAllStubs $name makeSlot noGuard text {" void (*reserved$i)(void);\n"}
return
}
@@ -377,7 +335,7 @@ proc genStubs::parseDecl {decl} {
return
}
set rtype [string trim $rtype]
- if {$args eq ""} {
+ if {$args == ""} {
return [list $rtype $fname {}]
}
foreach arg [split $args ,] {
@@ -425,14 +383,14 @@ proc genStubs::parseDecl {decl} {
proc genStubs::parseArg {arg} {
if {![regexp {^(.+[ ][*]*)([^][ *]+)(\[\])?$} $arg all type name array]} {
- if {$arg eq "void"} {
+ if {$arg == "void"} {
return $arg
} else {
return
}
}
set result [list [string trim $type] $name]
- if {$array ne ""} {
+ if {$array != ""} {
lappend result $array
}
return $result
@@ -452,9 +410,13 @@ proc genStubs::parseArg {arg} {
proc genStubs::makeDecl {name decl index} {
variable scspec
+
lassign $decl rtype fname args
append text "/* $index */\n"
+ if {$rtype != "void"} {
+ regsub -all void $rtype VOID rtype
+ }
set line "$scspec $rtype"
set count [expr {2 - ([string length $line] / 8)}]
append line [string range "\t\t\t" 0 $count]
@@ -463,7 +425,7 @@ proc genStubs::makeDecl {name decl index} {
append line " "
set pad 0
}
- if {$args eq ""} {
+ if {$args == ""} {
append line $fname
append text $line
append text ";\n"
@@ -471,9 +433,10 @@ proc genStubs::makeDecl {name decl index} {
}
append line $fname
+ regsub -all void $args VOID args
set arg1 [lindex $args 0]
switch -exact $arg1 {
- void {
+ VOID {
append line "(void)"
}
TCL_VARARGS {
@@ -541,7 +504,7 @@ proc genStubs::makeMacro {name decl index} {
append lfname [string range $fname 1 end]
set text "#define $fname \\\n\t("
- if {$args eq ""} {
+ if {$args == ""} {
append text "*"
}
append text "${name}StubsPtr->$lfname)"
@@ -568,18 +531,19 @@ proc genStubs::makeSlot {name decl index} {
append lfname [string range $fname 1 end]
set text " "
- if {$args eq ""} {
+ if {$rtype != "void"} {
+ regsub -all void $rtype VOID rtype
+ }
+ if {$args == ""} {
append text $rtype " *" $lfname "; /* $index */\n"
return $text
}
- if {[string range $rtype end-8 end] eq "__stdcall"} {
- append text [string trim [string range $rtype 0 end-9]] " (__stdcall *" $lfname ") "
- } else {
- append text $rtype " (*" $lfname ") "
- }
+ append text $rtype " (*" $lfname ") "
+
+ regsub -all void $args VOID args
set arg1 [lindex $args 0]
switch -exact $arg1 {
- void {
+ VOID {
append text "(void)"
}
TCL_VARARGS {
@@ -625,7 +589,7 @@ proc genStubs::makeSlot {name decl index} {
# Returns the formatted declaration string.
proc genStubs::makeInit {name decl index} {
- if {[lindex $decl 2] eq ""} {
+ if {[lindex $decl 2] == ""} {
append text " &" [lindex $decl 1] ", /* " $index " */\n"
} else {
append text " " [lindex $decl 1] ", /* " $index " */\n"
@@ -655,7 +619,7 @@ proc genStubs::makeInit {name decl index} {
# None.
proc genStubs::forAllStubs {name slotProc guardProc textVar
- {skipString {"/* Slot $i is reserved */\n"}}} {
+ {skipString {"/* Slot $i is reserved */\n"}}} {
variable stubs
upvar $textVar text
@@ -678,7 +642,7 @@ proc genStubs::addGuard {status text} {
set upName [string toupper $libraryName]
switch -- $status {
- current {
+ current {
# No change
}
deprecated {
@@ -691,7 +655,7 @@ proc genStubs::addGuard {status text} {
puts stderr "Unrecognized status code $status"
}
}
- return $text
+ return $text
}
proc genStubs::ifdeffed {macro text} {
@@ -762,17 +726,15 @@ proc genStubs::emitHeader {name} {
set capName [string toupper [string index $name 0]]
append capName [string range $name 1 end]
- if {$epoch ne ""} {
- set CAPName [string toupper $name]
- append text "\n"
- append text "#define ${CAPName}_STUBS_EPOCH $epoch\n"
- append text "#define ${CAPName}_STUBS_REVISION $revision\n"
- }
+ set CAPName [string toupper $name]
+ append text "\n"
+ append text "#define ${CAPName}_STUBS_EPOCH $epoch\n"
+ append text "#define ${CAPName}_STUBS_REVISION $revision\n"
emitDeclarations $name text
if {[info exists hooks($name)]} {
- append text "\ntypedef struct {\n"
+ append text "\ntypedef struct ${capName}StubHooks {\n"
foreach hook $hooks($name) {
set capHook [string toupper [string index $hook 0]]
append capHook [string range $hook 1 end]
@@ -782,15 +744,9 @@ proc genStubs::emitHeader {name} {
}
append text "\ntypedef struct ${capName}Stubs {\n"
append text " int magic;\n"
- if {$epoch ne ""} {
- append text " int epoch;\n"
- append text " int revision;\n"
- }
- if {[info exists hooks($name)]} {
- append text " const ${capName}StubHooks *hooks;\n\n"
- } else {
- append text " void *hooks;\n\n"
- }
+ append text " int epoch;\n"
+ append text " int revision;\n"
+ append text " const struct ${capName}StubHooks *hooks;\n\n"
emitSlots $name text
@@ -821,11 +777,14 @@ proc genStubs::emitInit {name textVar} {
variable hooks
variable interfaces
variable epoch
+ variable revision
+
upvar $textVar text
set root 1
set capName [string toupper [string index $name 0]]
append capName [string range $name 1 end]
+ set CAPName [string toupper $name]
if {[info exists hooks($name)]} {
append text "\nstatic const ${capName}StubHooks ${name}StubHooks = \{\n"
@@ -838,23 +797,21 @@ proc genStubs::emitInit {name textVar} {
}
foreach intf [array names interfaces] {
if {[info exists hooks($intf)]} {
- if {[lsearch -exact $hooks($intf) $name] >= 0} {
+ if {0<=[lsearch -exact $hooks($intf) $name]} {
set root 0
- break
+ break;
}
}
}
- append text "\n"
- if {!$root} {
- append text "static "
- }
- append text "const ${capName}Stubs ${name}Stubs = \{\n TCL_STUB_MAGIC,\n"
- if {$epoch ne ""} {
- set CAPName [string toupper $name]
- append text " ${CAPName}_STUBS_EPOCH,\n"
- append text " ${CAPName}_STUBS_REVISION,\n"
+ if {$root} {
+ append text "\nconst ${capName}Stubs ${name}Stubs = \{\n"
+ } else {
+ append text "\nstatic const ${capName}Stubs ${name}Stubs = \{\n"
}
+ append text " TCL_STUB_MAGIC,\n"
+ append text " ${CAPName}_STUBS_EPOCH,\n"
+ append text " ${CAPName}_STUBS_REVISION,\n"
if {[info exists hooks($name)]} {
append text " &${name}StubHooks,\n"
} else {