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