← Back to branch summary

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

« back to all changes in this revision

Viewing changes to lib/critcl-iassoc/iassoc.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/critcl-iassoc/iassoc.tcl
 
1
## -*- tcl -*-
 
2
# # ## ### ##### ######## ############# #####################
 
3
# Pragmas for MetaData Scanner.
 
4
# @mdgen OWNER: iassoc.h
 
5
 
 
6
# CriTcl Utility Commands. Specification of a C function and structure
 
7
# associated with an interpreter made easy.
 
8
 
 
9
package provide critcl::iassoc 1.0.1
 
10
 
 
11
# # ## ### ##### ######## ############# #####################
 
12
## Requirements.
 
13
 
 
14
package require Tcl    8.4   ; # Min supported version.
 
15
package require critcl 3.1   ; # Need 'meta?' to get the package name.
 
16
package require critcl::util ; # Use the package's Get/Put commands.
 
17
 
 
18
namespace eval ::critcl::iassoc {}
 
19
 
 
20
# # ## ### ##### ######## ############# #####################
 
21
## API: Generate the declaration and implementation files for the iassoc.
 
22
 
 
23
proc ::critcl::iassoc::def {name arguments struct constructor destructor} {
 
24
    critcl::at::caller
 
25
    critcl::at::incrt $arguments   ; set sloc [critcl::at::get*]
 
26
    critcl::at::incrt $struct      ; set cloc [critcl::at::get*]
 
27
    critcl::at::incrt $constructor ; set dloc [critcl::at::get]
 
28
 
 
29
    set struct      $sloc$struct
 
30
    set constructor $cloc$constructor
 
31
    set destructor  $dloc$destructor
 
32
 
 
33
 
 
34
    # Arguments:
 
35
    # - name of the C function which will provide access to the
 
36
    #   structure. This name, with a fixed prefix is also used to
 
37
    #   identify the association within the interpreter, and for
 
38
    #   the structure's type.
 
39
    #
 
40
    # - C code declaring the structure's contents.
 
41
    # - C code executed to initialize the structure.
 
42
    # - C code executed to destroy the structure.
 
43
 
 
44
    # Note that this is, essentially, a singleton object, without
 
45
    # methods.
 
46
 
 
47
    # Pull the package we are working on out of the system.
 
48
 
 
49
    set package [critcl::meta? name]
 
50
 
 
51
    #puts "%%% Pkg  |$package|"
 
52
    #puts "%%% Name |$name|"
 
53
 
 
54
    #puts "@@@ <<$data>>"
 
55
 
 
56
    set stem  ${package}_iassoc_${name}
 
57
    set type  ${name}_data
 
58
    set label critcl::iassoc/p=$package/a=$name
 
59
 
 
60
    set anames {}
 
61
    if {[llength $arguments]} {
 
62
        foreach {t v} $arguments {
 
63
            lappend alist "$t $v"
 
64
            lappend anames $v
 
65
        }
 
66
        set arguments ", [join $alist {, }]"
 
67
        set anames ", [join $anames {, }]"
 
68
    }
 
69
 
 
70
    lappend map @package@     $package
 
71
    lappend map @name@        $name
 
72
    lappend map @stem@        $stem
 
73
    lappend map @label@       $label
 
74
    lappend map @type@        $type
 
75
    lappend map @struct@      $struct
 
76
    lappend map @argdecls@    $arguments
 
77
    lappend map @argnames@    $anames
 
78
    lappend map @constructor@ $constructor
 
79
    lappend map @destructor@  $destructor
 
80
 
 
81
    set hdr      ${stem}.h
 
82
    set header   [file join [critcl::cache] $hdr]
 
83
    set template [Template iassoc.h]
 
84
 
 
85
    #puts T=[string length $template]
 
86
 
 
87
    file mkdir [critcl::cache]
 
88
    critcl::util::Put $header [string map $map $template]
 
89
 
 
90
    critcl::ccode "#include <$hdr>"
 
91
    return
 
92
}
 
93
 
 
94
proc ::critcl::iassoc::Template {path} {
 
95
    variable selfdir
 
96
    set path $selfdir/$path
 
97
    #puts T=$path
 
98
    return [critcl::util::Get $path]
 
99
}
 
100
 
 
101
# # ## ### ##### ######## ############# #####################
 
102
##
 
103
# Internal: Namespace holding the specification commands and related
 
104
# state. Treat like a sub-package, with a proper API.
 
105
##
 
106
# # ## ### ##### ######## ############# #####################
 
107
 
 
108
namespace eval ::critcl::iassoc::spec {}
 
109
 
 
110
# # ## ### ##### ######## ############# #####################
 
111
 
 
112
# # ## ### ##### ######## ############# #####################
 
113
## State
 
114
 
 
115
namespace eval ::critcl::iassoc {
 
116
    variable selfdir [file dirname [file normalize [info script]]]
 
117
}
 
118
 
 
119
# # ## ### ##### ######## ############# #####################
 
120
## Export API
 
121
 
 
122
namespace eval ::critcl::iassoc {
 
123
    namespace export def
 
124
    catch { namespace ensemble create }
 
125
}
 
126
 
 
127
# # ## ### ##### ######## ############# #####################
 
128
## Ready
 
129
return