/usr/share/tcltk/stubs/gen_decl.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 | # -*- tcl -*-
# STUBS handling -- Code generation: Writing declarations.
#
# (c) 2011 Andreas Kupries http://wiki.tcl.tk/andreas%20kupries
# A stubs table is represented by a dictionary value.
# A gen 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::gen::decl::g {
namespace import ::stubs::gen::*
}
namespace eval ::stubs::gen::decl::c {
namespace import ::stubs::container::*
}
# # ## ### ##### ######## #############
## Implementation.
proc ::stubs::gen::decl::gen {table name} {
set text "\n/*\n * Exported function declarations:\n */\n\n"
append text [g::forall $table $name [list [namespace current]::Make $table] 0]
return $text
}
# # ## ### #####
## Internal helpers.
proc ::stubs::gen::decl::Make {table name decl index} {
#puts "DECL($name $index) = |$decl|"
lassign $decl rtype fname args
append text "/* $index */\n"
set line "[c::scspec? $table] $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]}]
if {$pad <= 0} {
append line " "
set pad 0
}
if {![llength $args]} {
append text $line $fname ";\n"
return $text
}
set arg1 [lindex $args 0]
switch -exact -- $arg1 {
void {
append text $line $fname "(void)"
}
TCL_VARARGS {
append line $fname
append text [MakeArgs $line $pad [lrange $args 1 end] ", ..."]
}
default {
append line $fname
append text [MakeArgs $line $pad $args]
}
}
append text ";\n"
return $text
}
proc ::stubs::gen::decl::MakeArgs {line pad arguments {suffix {}}} {
#checker -scope local exclude warnArgWrite
set text ""
set sep "("
foreach arg $arguments {
append line $sep
set next {}
lassign $arg atype aname aind
append next $atype
if {[string index $next end] ne "*"} {
append next " "
}
append next $aname $aind
if {([string length $line] + [string length $next] + $pad) > 76} {
append text [string trimright $line] \n
set line "\t\t\t\t"
set pad 28
}
append line $next
set sep ", "
}
append line "$suffix)"
if {[lindex $arguments end] eq "{const char *} format"} {
# TCL_VARARGS case... arguments list already shrunken.
set n [llength $arguments]
append line " TCL_FORMAT_PRINTF(" $n ", " [expr {$n + 1}] ")"
}
return $text$line
}
# # ## ### #####
namespace eval ::stubs::gen::decl {
namespace export gen
}
# # ## ### #####
package provide stubs::gen::decl 1
return
|