clean-up, port all genStubs.tcl changes

from Tcl to ttkGenStubs.tcl as well
(no change in any output files)

2 files changed, 159 insertions, 118 deletions

diff --git a/generic/ttk/ttk.decls b/generic/ttk/ttk.decls
index d18d5a8..4567135 100644
--- a/generic/ttk/ttk.decls
+++ b/generic/ttk/ttk.decls
@@ -1,5 +1,5 @@
 #
-# $Id: ttk.decls,v 1.5 2010/02/05 17:42:21 nijtmans Exp $
+# $Id: ttk.decls,v 1.6 2010/09/20 21:18:23 nijtmans Exp $
 #
 
 library 	ttk
@@ -7,148 +7,148 @@ interface 	ttk
 epoch  		0
 scspec		TTKAPI
 
-declare 0 current {
-    Ttk_Theme Ttk_GetTheme(Tcl_Interp *interp, const char *name);
+declare 0 {
+    Ttk_Theme Ttk_GetTheme(Tcl_Interp *interp, const char *name)
 }
-declare 1 current {
-    Ttk_Theme Ttk_GetDefaultTheme(Tcl_Interp *interp);
+declare 1 {
+    Ttk_Theme Ttk_GetDefaultTheme(Tcl_Interp *interp)
 }
-declare 2 current {
-    Ttk_Theme Ttk_GetCurrentTheme(Tcl_Interp *interp);
+declare 2 {
+    Ttk_Theme Ttk_GetCurrentTheme(Tcl_Interp *interp)
 }
-declare 3 current {
+declare 3 {
     Ttk_Theme Ttk_CreateTheme(
-	Tcl_Interp *interp, const char *name, Ttk_Theme parent);
+	Tcl_Interp *interp, const char *name, Ttk_Theme parent)
 }
-declare 4 current {
+declare 4 {
     void Ttk_RegisterCleanup(
-	Tcl_Interp *interp, void *deleteData, Ttk_CleanupProc *cleanupProc);
+	Tcl_Interp *interp, void *deleteData, Ttk_CleanupProc *cleanupProc)
 }
 
-declare 5 current {
+declare 5 {
     int Ttk_RegisterElementSpec(
 	Ttk_Theme theme,
 	const char *elementName,
 	Ttk_ElementSpec *elementSpec,
-	void *clientData);
+	void *clientData)
 }
 
-declare 6 current {
+declare 6 {
     Ttk_ElementClass *Ttk_RegisterElement(
 	Tcl_Interp *interp,
 	Ttk_Theme theme,
 	const char *elementName,
 	Ttk_ElementSpec *elementSpec,
-	void *clientData);
+	void *clientData)
 }
 
-declare 7 current {
+declare 7 {
     int Ttk_RegisterElementFactory(
 	Tcl_Interp *interp,
 	const char *name,
 	Ttk_ElementFactory factoryProc,
-	void *clientData);
+	void *clientData)
 }
 
-declare 8 current {
+declare 8 {
     void Ttk_RegisterLayout(
-	Ttk_Theme theme, const char *className, Ttk_LayoutSpec layoutSpec);
+	Ttk_Theme theme, const char *className, Ttk_LayoutSpec layoutSpec)
 }
 
 #
 # State maps.
 #
-declare 10 current {
+declare 10 {
     int Ttk_GetStateSpecFromObj(
-    	Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_StateSpec *spec_rtn);
+    	Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_StateSpec *spec_rtn)
 }
-declare 11 current {
+declare 11 {
     Tcl_Obj *Ttk_NewStateSpecObj(
-    	unsigned int onbits, unsigned int offbits);
+    	unsigned int onbits, unsigned int offbits)
 }
-declare 12 current {
+declare 12 {
     Ttk_StateMap Ttk_GetStateMapFromObj(
-    	Tcl_Interp *interp, Tcl_Obj *objPtr);
+    	Tcl_Interp *interp, Tcl_Obj *objPtr)
 }
-declare 13 current {
+declare 13 {
     Tcl_Obj *Ttk_StateMapLookup(
-	Tcl_Interp *interp, Ttk_StateMap map, Ttk_State state);
+	Tcl_Interp *interp, Ttk_StateMap map, Ttk_State state)
 }
-declare 14 current {
+declare 14 {
     int Ttk_StateTableLookup(
-    	Ttk_StateTable map[], Ttk_State state);
+    	Ttk_StateTable map[], Ttk_State state)
 }
 
 
 #
 # Low-level geometry utilities.
 #
-declare 20 current {
+declare 20 {
     int Ttk_GetPaddingFromObj(
     	Tcl_Interp *interp,
 	Tk_Window tkwin,
 	Tcl_Obj *objPtr,
-	Ttk_Padding *pad_rtn);
+	Ttk_Padding *pad_rtn)
 }
-declare 21 current {
+declare 21 {
     int Ttk_GetBorderFromObj(
     	Tcl_Interp *interp,
 	Tcl_Obj *objPtr,
-	Ttk_Padding *pad_rtn);
+	Ttk_Padding *pad_rtn)
 }
-declare 22 current {
+declare 22 {
     int Ttk_GetStickyFromObj(
-    	Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_Sticky *sticky_rtn);
+    	Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_Sticky *sticky_rtn)
 }
-declare 23 current {
+declare 23 {
     Ttk_Padding Ttk_MakePadding(
-    	short l, short t, short r, short b);
+    	short l, short t, short r, short b)
 }
-declare 24 current {
+declare 24 {
     Ttk_Padding Ttk_UniformPadding(
-    	short borderWidth);
+    	short borderWidth)
 }
-declare 25 current {
-    Ttk_Padding Ttk_AddPadding(Ttk_Padding pad1, Ttk_Padding pad2);
+declare 25 {
+    Ttk_Padding Ttk_AddPadding(Ttk_Padding pad1, Ttk_Padding pad2)
 }
-declare 26 current {
+declare 26 {
     Ttk_Padding Ttk_RelievePadding(
-    	Ttk_Padding padding, int relief, int n);
+    	Ttk_Padding padding, int relief, int n)
 }
-declare 27 current {
-    Ttk_Box Ttk_MakeBox(int x, int y, int width, int height);
+declare 27 {
+    Ttk_Box Ttk_MakeBox(int x, int y, int width, int height)
 }
-declare 28 current {
-    int Ttk_BoxContains(Ttk_Box box, int x, int y);
+declare 28 {
+    int Ttk_BoxContains(Ttk_Box box, int x, int y)
 }
-declare 29 current {
-    Ttk_Box Ttk_PackBox(Ttk_Box *cavity, int w, int h, Ttk_Side side);
+declare 29 {
+    Ttk_Box Ttk_PackBox(Ttk_Box *cavity, int w, int h, Ttk_Side side)
 }
-declare 30 current {
-    Ttk_Box Ttk_StickBox(Ttk_Box parcel, int w, int h, Ttk_Sticky sticky);
+declare 30 {
+    Ttk_Box Ttk_StickBox(Ttk_Box parcel, int w, int h, Ttk_Sticky sticky)
 }
-declare 31 current {
-    Ttk_Box Ttk_AnchorBox(Ttk_Box parcel, int w, int h, Tk_Anchor anchor);
+declare 31 {
+    Ttk_Box Ttk_AnchorBox(Ttk_Box parcel, int w, int h, Tk_Anchor anchor)
 }
-declare 32 current {
-    Ttk_Box Ttk_PadBox(Ttk_Box b, Ttk_Padding p);
+declare 32 {
+    Ttk_Box Ttk_PadBox(Ttk_Box b, Ttk_Padding p)
 }
-declare 33 current {
-    Ttk_Box Ttk_ExpandBox(Ttk_Box b, Ttk_Padding p);
+declare 33 {
+    Ttk_Box Ttk_ExpandBox(Ttk_Box b, Ttk_Padding p)
 }
-declare 34 current {
+declare 34 {
     Ttk_Box Ttk_PlaceBox(
-	Ttk_Box *cavity, int w, int h, Ttk_Side side, Ttk_Sticky sticky);
+	Ttk_Box *cavity, int w, int h, Ttk_Side side, Ttk_Sticky sticky)
 }
-declare 35 current {
-    Tcl_Obj *Ttk_NewBoxObj(Ttk_Box box);
+declare 35 {
+    Tcl_Obj *Ttk_NewBoxObj(Ttk_Box box)
 }
 
 #
 # Utilities.
 #
-declare 40 current {
-    int Ttk_GetOrientFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *orient);
+declare 40 {
+    int Ttk_GetOrientFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *orient)
 }
 
 
diff --git a/generic/ttk/ttkGenStubs.tcl b/generic/ttk/ttkGenStubs.tcl
index d0f8c0d..a96f815 100644
--- a/generic/ttk/ttkGenStubs.tcl
+++ b/generic/ttk/ttkGenStubs.tcl
@@ -5,34 +5,28 @@
 #
 #
 # 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.
-# 
-# $Id: ttkGenStubs.tcl,v 1.9 2010/08/19 05:05:55 nijtmans Exp $
 #
-# SOURCE: tcl/tools/genStubs.tcl, revision 1.20
+# RCS: @(#) $Id: ttkGenStubs.tcl,v 1.10 2010/09/20 21:18:23 nijtmans Exp $
+#
+# SOURCE: tcl/tools/genStubs.tcl, revision 1.44
 #
 # 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
+package require Tcl 8.4
 
 namespace eval genStubs {
     # libraryName --
     #
     #	The name of the entire library.  This value is used to compute
-    #	the USE_*_STUBS macro, the name of the init file, and others.
+    #	the USE_*_STUBS macro and the name of the init file.
 
     variable libraryName "UNKNOWN"
 
@@ -52,9 +46,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 --
     #
@@ -62,7 +56,7 @@ namespace eval genStubs {
     #   (@@@TODO: should be an array mapping interface names -> numbers)
     #
 
-    variable epoch 0
+    variable epoch {}
     variable revision 0
 
     # hooks --
@@ -183,12 +177,24 @@ proc genStubs::hooks {names} {
 #	decl		The C function declaration, or {} for an undefined
 #			entry.
 #
-proc genStubs::declare {index status decl} {
+# 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
+    } elseif {[llength $args] == 3} {
+	lassign $args index status decl
+    } else {
+	puts stderr "wrong # args: declare $args"
+	return
+    }
 
     # Check for duplicate declarations, then add the declaration and
     # bump the lastNum counter if necessary.
@@ -229,6 +235,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]
@@ -263,22 +270,48 @@ proc genStubs::rewriteFile {file text} {
 # Results:
 #	Returns the original text inside an appropriate #ifdef.
 
-proc genStubs::addPlatformGuard {plat text} {
+proc genStubs::addPlatformGuard {plat iftxt {eltxt {}}} {
+    set text ""
     switch $plat {
 	win {
-	    return "#ifdef __WIN32__\n${text}#endif /* __WIN32__ */\n"
+	    append text "#ifdef __WIN32__ /* WIN */\n${iftxt}"
+	    if {$eltxt ne ""} {
+		append text "#else /* WIN */\n${eltxt}"
+	    }
+	    append text "#endif /* WIN */\n"
 	}
 	unix {
-	    return "#if !defined(__WIN32__) /* UNIX */\n${text}#endif /* UNIX */\n"
-	}		    
+	    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"
+	}
 	macosx {
-	    return "#ifdef MAC_OSX_TCL\n${text}#endif /* MAC_OSX_TCL */\n"
+	    append text "#ifdef MAC_OSX_TCL /* MACOSX */\n${iftxt}"
+	    if {$eltxt ne ""} {
+		append text "#else /* MACOSX */\n${eltxt}"
+	    }
+	    append text "#endif /* MACOSX */\n"
 	}
 	aqua {
-	    return "#ifdef MAC_OSX_TK\n${text}#endif /* MAC_OSX_TK */\n"
+	    append text "#ifdef MAC_OSX_TK /* AQUA */\n${iftxt}"
+	    if {$eltxt ne ""} {
+		append text "#else /* AQUA */\n${eltxt}"
+	    }
+	    append text "#endif /* AQUA */\n"
 	}
 	x11 {
-	    return "#if !(defined(__WIN32__) || defined(MAC_OSX_TK)) /* X11 */\n${text}#endif /* X11 */\n"
+	    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 $text
@@ -286,7 +319,9 @@ proc genStubs::addPlatformGuard {plat text} {
 
 # genStubs::emitSlots --
 #
-#	Generate the stub table slots for the given interface.
+#	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.
 #
 # Arguments:
 #	name	The name of the interface being emitted.
@@ -297,6 +332,7 @@ proc genStubs::addPlatformGuard {plat text} {
 
 proc genStubs::emitSlots {name textVar} {
     upvar $textVar text
+
     forAllStubs $name makeSlot noGuard text {"    void (*reserved$i)(void);\n"}
     return
 }
@@ -325,7 +361,7 @@ proc genStubs::parseDecl {decl} {
 	return
     }
     set rtype [string trim $rtype]
-    if {$args == ""} {
+    if {$args eq ""} {
 	return [list $rtype $fname {}]
     }
     foreach arg [split $args ,] {
@@ -373,14 +409,14 @@ proc genStubs::parseDecl {decl} {
 
 proc genStubs::parseArg {arg} {
     if {![regexp {^(.+[ ][*]*)([^][ *]+)(\[\])?$} $arg all type name array]} {
-	if {$arg == "void"} {
+	if {$arg eq "void"} {
 	    return $arg
 	} else {
 	    return
 	}
     }
     set result [list [string trim $type] $name]
-    if {$array != ""} {
+    if {$array ne ""} {
 	lappend result $array
     }
     return $result
@@ -400,7 +436,6 @@ proc genStubs::parseArg {arg} {
 
 proc genStubs::makeDecl {name decl index} {
     variable scspec
-
     lassign $decl rtype fname args
 
     append text "/* $index */\n"
@@ -412,7 +447,7 @@ 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"
@@ -490,7 +525,7 @@ proc genStubs::makeMacro {name decl index} {
     append lfname [string range $fname 1 end]
 
     set text "#define $fname \\\n\t("
-    if {$args == ""} {
+    if {$args eq ""} {
 	append text "*"
     }
     append text "${name}StubsPtr->$lfname)"
@@ -517,12 +552,15 @@ proc genStubs::makeSlot {name decl index} {
     append lfname [string range $fname 1 end]
 
     set text "    "
-    if {$args == ""} {
+    if {$args eq ""} {
 	append text $rtype " *" $lfname "; /* $index */\n"
 	return $text
     }
-    append text $rtype " (*" $lfname ") "
-
+    if {[string range $rtype end-7 end] eq "CALLBACK"} {
+	append text [string trim [string range $rtype 0 end-8]] " (CALLBACK *" $lfname ") "
+    } else {
+	append text $rtype " (*" $lfname ") "
+    }
     set arg1 [lindex $args 0]
     switch -exact $arg1 {
 	void {
@@ -571,7 +609,7 @@ proc genStubs::makeSlot {name decl index} {
 #	Returns the formatted declaration string.
 
 proc genStubs::makeInit {name decl index} {
-    if {[lindex $decl 2] == ""} {
+    if {[lindex $decl 2] eq ""} {
 	append text "    &" [lindex $decl 1] ", /* " $index " */\n"
     } else {
 	append text "    " [lindex $decl 1] ", /* " $index " */\n"
@@ -600,8 +638,8 @@ proc genStubs::makeInit {name decl index} {
 # Results:
 #	None.
 
-proc genStubs::forAllStubs {name slotProc guardProc textVar 
-    	{skipString {"/* Slot $i is reserved */\n"}}} {
+proc genStubs::forAllStubs {name slotProc guardProc textVar
+	{skipString {"/* Slot $i is reserved */\n"}}} {
     variable stubs
     upvar $textVar text
 
@@ -708,10 +746,12 @@ proc genStubs::emitHeader {name} {
     set capName [string toupper [string index $name 0]]
     append capName [string range $name 1 end]
 
-    set CAPName [string toupper $name]
-    append text "\n"
-    append text "#define ${CAPName}_STUBS_EPOCH $epoch\n"
-    append text "#define ${CAPName}_STUBS_REVISION $revision\n"
+    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
 
@@ -726,8 +766,10 @@ proc genStubs::emitHeader {name} {
     }
     append text "\ntypedef struct ${capName}Stubs {\n"
     append text "    int magic;\n"
-    append text "    int epoch;\n"
-    append text "    int revision;\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
@@ -759,14 +801,11 @@ 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"
@@ -779,21 +818,23 @@ proc genStubs::emitInit {name textVar} {
     }
     foreach intf [array names interfaces] {
 	if {[info exists hooks($intf)]} {
-	    if {0<=[lsearch -exact $hooks($intf) $name]} {
+	    if {[lsearch -exact $hooks($intf) $name] >= 0} {
 		set root 0
-		break;
+		break
 	    }
 	}
     }
 
-    if {$root} {
-	append text "\nconst ${capName}Stubs ${name}Stubs = \{\n"
-    } else {
-	append text "\nstatic const ${capName}Stubs ${name}Stubs = \{\n"
+    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"
     }
-    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 {