summaryrefslogtreecommitdiffstats
path: root/tools
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2017-01-17 12:02:43 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2017-01-17 12:02:43 (GMT)
commitc3dbeb6e6ff78ff7393f4546ab4156aa1262e859 (patch)
treeaacef7d69f6a386afadcde38e35f349e0d1a7bb7 /tools
parent2e3b90219eb6b3241c308d556d9b2ead4f078cfc (diff)
downloadtcl-c3dbeb6e6ff78ff7393f4546ab4156aa1262e859.zip
tcl-c3dbeb6e6ff78ff7393f4546ab4156aa1262e859.tar.gz
tcl-c3dbeb6e6ff78ff7393f4546ab4156aa1262e859.tar.bz2
Implement tag "deprecated" in genStubs.tcl. Will be used in Tk 8.7, for tagging the deprecated function Tk_FreeXId()
Diffstat (limited to 'tools')
-rw-r--r--tools/genStubs.tcl18
1 files changed, 17 insertions, 1 deletions
diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl
index 9f2c6ca..742aa46 100644
--- a/tools/genStubs.tcl
+++ b/tools/genStubs.tcl
@@ -199,6 +199,13 @@ proc genStubs::declare {args} {
set stubs($curName,$platform,lastNum) $index
}
}
+ if {$platformList eq "deprecated"} {
+ set stubs($curName,generic,$index) $decl
+ if {![info exists stubs($curName,generic,lastNum)] \
+ || ($index > $stubs($curName,generic,lastNum))} {
+ set stubs($curName,$platform,lastNum) $index
+ }
+ }
}
return
}
@@ -455,10 +462,16 @@ proc genStubs::parseArg {arg} {
proc genStubs::makeDecl {name decl index} {
variable scspec
+ variable stubs
+ variable libraryName
lassign $decl rtype fname args
append text "/* $index */\n"
+ if {[info exists stubs($name,deprecated,$index)]} {
+ set line "[string toupper $libraryName]_DEPRECATED $rtype"
+ } else {
set line "$scspec $rtype"
+ }
set count [expr {2 - ([string length $line] / 8)}]
append line [string range "\t\t\t" 0 $count]
set pad [expr {24 - [string length $line]}]
@@ -682,7 +695,10 @@ proc genStubs::forAllStubs {name slotProc onAll textVar
for {set i 0} {$i <= $lastNum} {incr i} {
set slots [array names stubs $name,*,$i]
set emit 0
- if {[info exists stubs($name,generic,$i)]} {
+ if {[info exists stubs($name,deprecated,$i)]} {
+ append text [$slotProc $name $stubs($name,generic,$i) $i]
+ set emit 1
+ } elseif {[info exists stubs($name,generic,$i)]} {
if {[llength $slots] > 1} {
puts stderr "conflicting generic and platform entries:\
$name $i"