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