1# docidx.tcl -- 2# 3# Implementation of docidx objects for Tcl. v2. 4# 5# Copyright (c) 2009 Andreas Kupries <andreas_kupries@sourceforge.net> 6# 7# See the file "license.terms" for information on usage and redistribution 8# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 9# 10# RCS: @(#) $Id: container.tcl,v 1.3 2009/08/11 22:52:47 andreas_kupries Exp $ 11 12# Each object manages one index, with methods to add and remove keys 13# and references, singly, or in bulk. The bulk methods accept various 14# forms of textual serializations, among them text using the docidx 15# markup language. 16 17# ### ### ### ######### ######### ######### 18## Requisites 19 20package require Tcl 8.4 21package require doctools::idx::structure 22package require snit 23 24# ### ### ### ######### ######### ######### 25## API 26 27snit::type ::doctools::idx { 28 29 # Concepts: 30 # - An index consists of a (possibly empty) set of keys, 31 # - Each key in the set is identified by its name. 32 # - Each key has a (possibly empty) set of references. 33 # - Each reference is identified by its target, specified as 34 # either url or symbolic filename, depending on the type of 35 # reference (url, or manpage). 36 # - A reference can be in the sets of more than one key. 37 # - A reference outside of the sets of all keys is not possible 38 # however. 39 # - A reference carries not only its identifying target, but also 40 # a descriptive label (*). This label is however not unique per 41 # reference, but only per a pair of key and reference in that 42 # key. 43 # - The type of a reference (url, or manpage) is however bound to 44 # the reference itself. 45 # - (*) For keys the identifying feature is identical to its 46 # label. 47 48 # Note: url and manpage references share a namespace for their 49 # identifiers. This should be no problem with manpage identifiers 50 # being symbolic filenames and as such they should never look like 51 # urls. 52 53 # ### ### ### ######### ######### ######### 54 ## Options 55 56 ## None 57 58 # ### ### ### ######### ######### ######### 59 ## Methods 60 61 # Default constructor. 62 # Default destructor. 63 64 # ### ### ### ######### ######### ######### 65 66 method invalidate {} { 67 array unset myidx * 68 return 69 } 70 71 # ### ### ### ######### ######### ######### 72 73 method title {{text {}}} { 74 if {[llength [info level 0]] == 6} { 75 set mytitle $text 76 } 77 return $mytitle 78 } 79 80 method label {{text {}}} { 81 if {[llength [info level 0]] == 6} { 82 set mylabel $text 83 } 84 return $mylabel 85 } 86 87 method exporter {{object {}}} { 88 # TODO :: unlink/link change notification callbacks on the 89 # config/include components so that we can invalidate our 90 # cache when the settings change. 91 92 if {[llength [info level 0]] == 6} { 93 set myexporter $object 94 } 95 return $myexporter 96 } 97 98 method importer {{object {}}} { 99 if {[llength [info level 0]] == 6} { 100 set myimporter $object 101 } 102 return $myimporter 103 } 104 105 # ### ### ### ######### ######### ######### 106 ## Direct manipulation of the index contents. 107 108 method {key add} {key} { 109 # Ignore addition of an already known key 110 if {[info exists mykey($key)]} return 111 set mykey($key) {} 112 array unset myidx * 113 return 114 } 115 116 method {key remove} {key} { 117 # Ignore removal of a key already gone 118 if {![info exists mykey($key)]} return 119 set references $mykey($key) 120 unset mykey($key) 121 foreach name $references { 122 # Remove key from the list of users for all references it 123 # contains. 124 set pos [lsearch -exact $myrefuse($name) $key] 125 set myrefuse($name) [lreplace $myrefuse($name) $pos $pos] 126 if {[llength $myrefuse($name)]} continue 127 # Last use of this reference is gone, delete it. 128 unset myrefuse($name) 129 unset myref($name) 130 } 131 array unset myidx * 132 return 133 } 134 135 method keys {} { 136 return [array names mykey] 137 } 138 139 method {key references} {key} { 140 if {![info exists mykey($key)]} { 141 return -code error "Unknown key '$key'" 142 } 143 return $mykey($key) 144 } 145 146 method {reference add} {reftype key name label} { 147 if {![info exists mykey($key)]} { 148 return -code error "Unknown key '$key'" 149 } 150 if {[info exists myref($name)] && ([lindex $myref($name) 0] ne $reftype)} { 151 return -code error "Cannot add $reftype reference '$name', is a [lindex $myref($name) 0] reference already" 152 } 153 if {($reftype ne "url") && ($reftype ne "manpage")} { 154 return -code error "Bad reference type '$reftype'" 155 } 156 set myref($name) [list $reftype $label] 157 if {![info exists myrefuse($name)]} { 158 set myrefuse($name) {} 159 } 160 if {![info exists mylink([list $name $key])]} { 161 # reference was not used by the key yet. 162 lappend mykey($key) $name 163 lappend myrefuse($name) $key 164 set mylink([list $name $key]) . 165 } 166 array unset myidx * 167 return 168 } 169 170 method {reference remove} {name} { 171 # Ignore removal of already unknown reference 172 if {![info exists myrefuse($name)]} return 173 foreach key $myrefuse($name) { 174 unset mylink([list $name $key]) 175 set pos [lsearch -exact $mykey($key) $name] 176 set mykey($key) [lreplace $mykey($key) $pos $pos] 177 } 178 unset myref($name) 179 unset myrefuse($name) 180 array unset myidx * 181 return 182 } 183 184 method {reference label} {name} { 185 if {![info exists myref($name)]} { 186 return -code error "Unknown reference '$name'" 187 } 188 return [lindex $myref($name) 1] 189 } 190 191 method {reference type} {name} { 192 if {![info exists myref($name)]} { 193 return -code error "Unknown reference '$name'" 194 } 195 return [lindex $myref($name) 0] 196 } 197 198 method {reference keys} {name} { 199 if {![info exists myrefuse($name)]} { 200 return -code error "Unknown reference '$name'" 201 } 202 return $myrefuse($name) 203 } 204 205 method references {} { 206 return [array names myrefuse] 207 } 208 209 # ### ### ### ######### ######### ######### 210 ## Public methods. Bulk loading and merging. 211 212 method {deserialize =} {data {format {}}} { 213 # Default format is the regular index serialization 214 if {$format eq {}} { 215 set format serial 216 } 217 218 if {$format ne "serial"} { 219 set data [$self Import $format $data] 220 # doctools::idx::structure verify-as-canonical $data 221 # ImportSerial verifies. 222 } 223 224 $self ImportSerial $data 225 return 226 } 227 228 method {deserialize +=} {data {format {}}} { 229 # Default format is the regular index serialization 230 if {$format eq {}} { 231 set format serial 232 } 233 234 if {$format ne "serial"} { 235 set data [$self Import $format $data] 236 # doctools::idx::structure verify-as-canonical $data 237 # merge or ImportSerial verify the structure. 238 } 239 240 set data [doctools::idx::structure merge [$self serialize] $data] 241 # doctools::idx::structure verify-as-canonical $data 242 # ImportSerial verifies. 243 244 $self ImportSerial $data 245 return 246 } 247 248 # ### ### ### ######### ######### ######### 249 250 method serialize {{format {}}} { 251 # Default format is the regular index serialization 252 if {$format eq {}} { 253 set format serial 254 } 255 256 # First check the cache for a remebered representation of the 257 # index for the chosen format, and return it, if such is 258 # known. 259 260 if {[info exists myidx($format)]} { 261 return $myidx($format) 262 } 263 264 # If there is no cached representation we have to generate it 265 # from it from our internal representation. 266 267 if {$format eq "serial"} { 268 return [$self GenerateSerial] 269 } else { 270 return [$self Generate $format] 271 } 272 273 return -code error "Internal error, reached unreachable location" 274 } 275 276 # ### ### ### ######### ######### ######### 277 ## Internal methods 278 279 method GenerateSerial {} { 280 # We can generate the list serialization easily from the 281 # internal representation. 282 283 # Scan and reorder ... 284 set keywords {} 285 foreach kw [lsort -dict [array names mykey]] { 286 # Sort the references in a keyword by their _labels_. 287 set tmp {} 288 foreach rid $mykey($kw) { lappend tmp [list $rid [lindex $myref($rid) 1]] } 289 set refs {} 290 foreach item [lsort -dict -index 1 $tmp] { 291 lappend refs [lindex $item 0] 292 } 293 lappend keywords $kw $refs 294 } 295 296 set references {} 297 foreach rid [lsort -dict [array names myrefuse]] { 298 lappend references $rid $myref($rid) 299 } 300 301 # Construct result 302 set serial [list doctools::idx \ 303 [list \ 304 label $mylabel \ 305 keywords $keywords \ 306 references $references \ 307 title $mytitle]] 308 309 # This is just present to assert that the code above creates 310 # correct serializations. 311 doctools::idx::structure verify-as-canonical $serial 312 313 set myidx(serial) $serial 314 return $serial 315 } 316 317 method Generate {format} { 318 if {$myexporter eq {}} { 319 return -code error "Unable to export from \"$format\", no exporter configured" 320 } 321 set res [$myexporter export object $self $format] 322 set myidx($format) $res 323 return $res 324 } 325 326 method ImportSerial {serial} { 327 doctools::idx::structure verify $serial iscanonical 328 329 array unset myidx * 330 array unset mykey * 331 array unset myrefuse * 332 array unset myref * 333 array unset mylink * 334 335 # Unpack the serialization. 336 array set idx $serial 337 array set idx $idx(doctools::idx) 338 unset idx(doctools::idx) 339 340 # We are setting the relevant variables directly instead of 341 # going through the accessor methods. 342 # I. Label and title 343 # II. Keys and references 344 # III. Back index references -> keys. 345 346 set mytitle $idx(title) 347 set mylabel $idx(label) 348 349 array set mykey $idx(keywords) 350 array set myref $idx(references) 351 352 foreach k [array names mykey] { 353 foreach r $mykey($k) { 354 lappend myrefuse($r) $k 355 set mylink([list $r $k]) . 356 } 357 } 358 359 # Extend cache (only if canonical, as we return only canonical 360 # data). 361 if {$iscanonical} { 362 set myidx(serial) $serial 363 } 364 return 365 } 366 367 method Import {format data} { 368 if {$myimporter eq {}} { 369 return -code error "Unable to import from \"$format\", no importer configured" 370 } 371 372 return [$myimporter import text $data $format] 373 } 374 375 # ### ### ### ######### ######### ######### 376 ## State 377 378 # References to export/import managers extending the 379 # (de)serialization abilities of the index. 380 variable myexporter {} 381 variable myimporter {} 382 383 # Internal representation of the index. 384 385 variable mytitle {} ; # 386 variable mylabel {} ; # 387 variable mykey -array {} ; # key -> list of references 388 variable myref -array {} ; # reference -> (type, label) 389 variable myrefuse -array {} ; # reference -> list of keys using the reference 390 variable mylink -array {} ; # reference x key -> exists if the reference is used by key. 391 392 # Array serving as cache holding alternative representations of 393 # the index generated via 'serialize', i.e. data export. 394 395 variable myidx -array {} 396 397 ## 398 # ### ### ### ######### ######### ######### 399} 400 401# ### ### ### ######### ######### ######### 402## Ready 403 404package provide doctools::idx 2 405return 406