[Patch 3034251] backport ttkGenStubs.tcl

features to genStubs.tcl. Make the "generic"
argument in the *.decls files optional
(no change to any tcl*Decls.h files)
This allows genStubs.tcl to generate the ttk stub files as well,
while keeping full compatibility with existing *.decls files.

1 files changed, 48 insertions, 4 deletions

diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl
index 81752d6..3e896a1 100644
--- a/tools/genStubs.tcl
+++ b/tools/genStubs.tcl
@@ -10,7 +10,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.43 2010/09/13 21:17:03 nijtmans Exp $
+# RCS: @(#) $Id: genStubs.tcl,v 1.44 2010/09/15 07:33:56 nijtmans Exp $
 
 package require Tcl 8.4
 
@@ -42,6 +42,15 @@ namespace eval genStubs {
     #
     variable scspec "EXTERN"
 
+    # epoch, revision --
+    #
+    #	The epoch and revision numbers of the interface currently being defined.
+    #   (@@@TODO: should be an array mapping interface names -> numbers)
+    #
+
+    variable epoch {}
+    variable revision 0
+
     # hooks --
     #
     #	An array indexed by interface name that contains the set of
@@ -114,6 +123,16 @@ proc genStubs::scspec {value} {
     variable scspec $value
 }
 
+# genStubs::epoch --
+#
+#	Define the epoch number for this library.  The epoch
+#	should be incrememented when a release is made that
+#	contains incompatible changes to the public API.
+#
+proc genStubs::epoch {value} {
+    variable epoch $value
+}
+
 # genStubs::hooks --
 #
 #	This function defines the subinterface hooks for the current
@@ -152,12 +171,18 @@ proc genStubs::hooks {names} {
 proc genStubs::declare {args} {
     variable stubs
     variable curName
-
-    if {[llength $args] != 3} {
+    variable revision
+
+    incr revision
+    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.
@@ -929,10 +954,19 @@ proc genStubs::emitMacros {name textVar} {
 proc genStubs::emitHeader {name} {
     variable outDir
     variable hooks
+    variable epoch
+    variable revision
 
     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"
+    }
+
     emitDeclarations $name text
 
     if {[info exists hooks($name)]} {
@@ -946,6 +980,10 @@ 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"
+    }
     append text "    const struct ${capName}StubHooks *hooks;\n\n"
 
     emitSlots $name text
@@ -976,6 +1014,7 @@ proc genStubs::emitHeader {name} {
 proc genStubs::emitInit {name textVar} {
     variable hooks
     variable interfaces
+    variable epoch
     upvar $textVar text
     set root 1
 
@@ -1005,6 +1044,11 @@ proc genStubs::emitInit {name textVar} {
 	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 {[info exists hooks($name)]} {
 	append text "    &${name}StubHooks,\n"
     } else {