← Back to branch summary

~ubuntu-branches/ubuntu/utopic/critcl/utopic

« back to all changes in this revision

Viewing changes to lib/stubs/writer.tcl

  • Committer: Package Import Robot
  • Author(s): Andrew Shadura
  • Date: 2013-05-11 00:08:06 UTC
  • Revision ID: package-import@ubuntu.com-20130511000806-7hq1zc3fnn0gat79
Tags: upstream-3.1.9
Import upstream version 3.1.9

Show diffs side-by-side

added added

removed removed

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