/usr/share/tcltk/stubs/writer.tcl is in critcl 3.1.9-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 | # -*- tcl -*-
# STUBS handling -- Write stubs table as .decls file
#
# (c) 2011 Andreas Kupries http://wiki.tcl.tk/andreas%20kupries
# A stubs table is represented by a dictionary value.
# A container is a variable holding a stubs table value.
# # ## ### ##### ######## #############
## Requisites
package require Tcl 8.4
package require stubs::gen
package require stubs::container
package require lassign84
namespace eval ::stubs::writer::g {
namespace import ::stubs::gen::*
}
namespace eval ::stubs::writer::c {
namespace import ::stubs::container::*
}
# # ## ### ##### ######## #############
## Implementation.
proc ::stubs::writer::gen {table} {
set defaults [c::new]
set dscspec [c::scspec? $defaults]
set depoch [c::epoch? $defaults]
set name [c::library? $table]
set scspec [c::scspec? $table]
set epoch [c::epoch? $table]
set rev [c::revision? $table]
lappend lines "\# ${name}.decls -- -*- tcl -*-"
lappend lines "\#"
lappend lines "\#\tThis file contains the declarations for all public functions"
lappend lines "\#\tthat are exported by the \"${name}\" library via its stubs table."
lappend lines "\#"
lappend lines ""
lappend lines "library [list $name]"
if {($scspec ne $dscspec) ||
($epoch ne $depoch )} {
if {$scspec ne $dscspec} {
lappend lines "scspec [list $scspec]"
}
if {$epoch ne $depoch } {
lappend lines "epoch [list $epoch]"
lappend lines "revision [list $rev]"
}
}
foreach if [c::interfaces $table] {
lappend lines ""
lappend lines "interface [list $if]"
if {[c::hooks? $table $if]} {
lappend lines "hooks [list [c::hooksof $table $if]]"
}
lappend lines \
[g::forall $table $if \
[list [namespace current]::Make $table] \
0]
}
lappend lines "\# END $name"
return [join $lines \n]
}
# # ## ### #####
## Internal helpers.
proc ::stubs::writer::Make {table if decl index} {
#puts |---------------------------------------
#puts |$if|$index|$decl|
lassign $decl rtype fname arguments
if {[llength $arguments]} {
# what about the third piece of info, array flag?! ...
set suffix {}
foreach a $arguments {
if {$a eq "void"} {
lappend ax $a
} elseif {$a eq "TCL_VARARGS"} {
set suffix ", ..."
} else {
lassign $a atype aname aflag
# aflag either "", or "[]".
lappend ax "$atype $aname$aflag"
#puts \t|$atype|$aname|$aflag|
}
}
set ax [join $ax {, }]$suffix
} else {
set ax void
}
set cdecl "\n $rtype $fname ($ax)\n"
set platforms [c::slotplatforms $table $if $index]
lappend lines ""
lappend lines "declare $index [list $platforms] \{$cdecl\}"
return [join $lines \n]\n
}
# # ## ### #####
namespace eval ::stubs::writer {
namespace export gen
}
# # ## ### #####
package provide stubs::writer 1
return
|