1#
2# $Id$
3#
4
5#
6# sttp_buffer ... create or use a ctable from a ctable server
7#
8
9namespace eval ::sttp_buffer:: {
10
11# tables(URL) contains the name of the buffer associated with the URL
12variable tables
13
14# auto(URL) contains the name of the autogenerated buffer for the URL
15variable auto
16
17# meta(definition) contains the name of the meta-table for a given definition
18variable meta
19
20# metatable sequence number for autogenerated tables
21variable metasequence 0
22
23# definitions(URL) contains the definition for the URL
24variable definitions
25
26# extensions(URL) contains the CTable extension for the URL
27variable extensions
28
29#
30# Forget everything about a URL
31#
32proc forget {cttpUrl} {
33    variable extensions
34    variable definitions
35    variable tables
36
37    autodestroy $cttpUrl
38    unset -nocomplain tables($cttpUrl)
39    unset -nocomplain definitions($cttpUrl)
40    unset -nocomplain extensions($cttpUrl)
41}
42
43#
44# Create a table given the definition
45#
46proc metacreate {definition} {
47    variable meta
48    variable metaseqence
49
50    if [info exists meta($definition)] {
51	return $meta($definition)
52    }
53
54    set name c_meta$metasequence
55    set package C_meta$metasequence
56    incr metasequence
57
58    CExtension $name 1.0 [list Ctable $name $definition]
59    package require $package
60
61    set meta($definition) $name
62    return $name
63}
64
65#
66# recreate a speed table definition from its properties
67#
68proc getdefinition {cttpUrl {class ""}} {
69  set table [uplevel 1 [list namespace which $table]]
70
71  foreach field [remote_ctable_send $cttpUrl fields] {
72    array unset props
73    array set props [remote_ctable_send $cttpUrl [list field $field proplist]]
74    set type $props(type)
75    unset props(type)
76    set name $props(name)
77    unset props(name)
78    unset -nocomplain props(needsQuoting)
79    lappend definition [linsert [array get props] 0 $type $field]
80  }
81
82  if {![info exists definition]} {
83    return -code error "No definition for $table"
84  }
85
86  if {"$class" == ""} {
87    set class [remote_ctable_send $cttpUrl type]
88  }
89  return "CTable $class {
90	[join $definition "\n\t"]
91  }"
92}
93
94proc autocreate {cttpUrl} {
95    variable definitions
96    variable extensions
97    variable auto
98
99    if {[info exists auto($cttpUrl)]} {
100	$auto($cttpUrl) reset
101    } else {
102        if {![info exists definitions($cttpUrl)]} {
103	    set definitions($cttpUrl) [getdefinition $cttpUrl]
104        }
105
106        if {![info exists extensions($cttpUrl)]} {
107	    set extensions($cttpUrl) [metacreate $definitions($cttpUrl)]
108        }
109
110        set auto($cttpUrl) [$extensions($cttpUrl) create #auto]
111    }
112
113    return $auto($cttpUrl)
114}
115
116#
117# Destroy the autocreated ctable for cttpUrl if it exists
118#
119proc autodestroy {cttpUrl} {
120    variable auto
121
122    if [info exists auto($cttpUrl)] {
123	$auto($cttpUrl) destroy
124	unset auto($cttpUrl)
125    }
126}
127
128#
129# Attach a buffer table, creating it if necessary
130#
131proc attach {cttpUrl {ctable #auto}} {
132    variable tables
133
134    if {"$ctable" == "#auto"} {
135	if {[info exists tables($cttpUrl)]} {
136	    set ctable $tables($cttpUrl)
137	} else {
138	    set ctable [autocreate $cttpUrl]
139	}
140    } else {
141        if {[info exists tables($cttpUrl)]} {
142	    if {"$tables($cttpUrl)" != "$ctable"} {
143	        autodestroy $cttpUrl
144	    }
145	}
146    }
147
148    set tables($cttpUrl) $ctable
149
150    return $ctable
151}
152
153#
154# Detach a buffer table, destroying it if necessary
155#
156proc detach {cttpUrl} {
157    variable tables
158
159    if {[info exists tables($cttpUrl)]} {
160    	unset tables($cttpUrl)
161    	autodestroy $cttpUrl
162    }
163}
164
165#
166# Return the buffer table associated with the URL, or NULL
167#
168proc table {cttpUrl} {
169    variable tables
170
171    if {[info exists tables($cttpUrl)]} {
172        return $tables($cttpUrl)
173    }
174
175    return [attach $cttpUrl #auto]
176}
177
178}
179
180package provide sttp_buffer 1.13.12
181
182# vim: set ts=8 sw=4 sts=4 noet :
183