1# docidx.tcl --
2#
3#	Implementation of docidx objects for Tcl.
4#
5# Copyright (c) 2003-2010 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: docidx.tcl,v 1.22 2010/06/08 19:13:53 andreas_kupries Exp $
11
12package require Tcl 8.2
13package require textutil::expander
14
15# @mdgen OWNER: api_idx.tcl
16# @mdgen OWNER: checker_idx.tcl
17# @mdgen OWNER: mpformats/*.tcl
18# @mdgen OWNER: mpformats/*.msg
19# @mdgen OWNER: mpformats/idx.*
20# @mdgen OWNER: mpformats/man.macros
21
22namespace eval ::doctools {}
23namespace eval ::doctools::idx {
24    # Data storage in the doctools::idx module
25    # -------------------------------
26    #
27    # One namespace per object, containing
28    #  1) A list of additional search paths for format definition files.
29    #     This list extends the list of standard paths known to the module.
30    #     The paths in the list are searched before the standard paths.
31    #  2) Configuration information
32    #     a) string:  The format to use when converting the input.
33    #  4) Name of the interpreter used to perform the syntax check of the
34    #     input (= allowed order of formatting commands).
35    #  5) Name of the interpreter containing the code coming from the format
36    #     definition file.
37    #  6) Name of the expander object used to interpret the input to convert.
38
39    # commands is the list of subcommands recognized by the docidx objects
40    variable commands [list		\
41	    "cget"			\
42	    "configure"			\
43	    "destroy"			\
44	    "format"			\
45	    "map"			\
46	    "search"			\
47	    "warnings"                  \
48	    "parameters"                \
49	    "setparam"                  \
50	    ]
51
52    # Only export the toplevel commands
53    namespace export new search help
54
55    # Global data
56
57    #  1) List of standard paths to look at when searching for a format
58    #     definition. Extensible.
59    #  2) Location of this file in the filesystem
60
61    variable paths [list]
62    variable here [file dirname [info script]]
63}
64
65# ::doctools::idx::search --
66#
67#	Extend the list of paths used when searching for format definition files.
68#
69# Arguments:
70#	path	Path to add to the list. The path has to exist, has to be a
71#               directory, and has to be readable.
72#
73# Results:
74#	None.
75#
76# Sideeffects:
77#	The specified path is added to the front of the list of search
78#	paths. This means that the new path is search before the
79#	standard paths set at module initialization time.
80
81proc ::doctools::idx::search {path} {
82    variable paths
83
84    if {![file exists      $path]} {return -code error "doctools::idx::search: path does not exist"}
85    if {![file isdirectory $path]} {return -code error "doctools::idx::search: path is not a directory"}
86    if {![file readable    $path]} {return -code error "doctools::idx::search: path cannot be read"}
87
88    set paths [linsert $paths 0 $path]
89    return
90}
91
92# ::doctools::idx::help --
93#
94#	Return a string containing short help
95#	regarding the existing formatting commands.
96#
97# Arguments:
98#	None.
99#
100# Results:
101#	A string.
102
103proc ::doctools::idx::help {} {
104    return "formatting commands\n\
105	    * index_begin      - begin of index\n\
106	    * index_end        - end of index\n\
107	    * key              - begin of references for key\n\
108	    * manpage          - index reference to manpage\n\
109	    * url              - index reference to url\n\
110	    * vset             - set/get variable values\n\
111	    * include          - insert external file\n\
112	    * lb, rb           - left/right brackets\n\
113	    "
114}
115
116# ::doctools::idx::new --
117#
118#	Create a new docidx object with a given name. May configure the object.
119#
120# Arguments:
121#	name	Name of the docidx object.
122#	args	Options configuring the new object.
123#
124# Results:
125#	name	Name of the doctools created
126
127proc ::doctools::idx::new {name args} {
128        if { [llength [info commands ::$name]] } {
129	return -code error "command \"$name\" already exists, unable to create docidx object"
130    }
131    if {[llength $args] % 2 == 1} {
132	return -code error "wrong # args: doctools::new name ?opt val...??"
133    }
134
135    # The arguments seem to be ok, setup the namespace for the object
136
137    namespace eval ::doctools::idx::docidx$name {
138	variable paths      [list]
139	variable file       ""
140	variable format     ""
141	variable formatfile ""
142	variable format_ip  ""
143	variable chk_ip     ""
144	variable expander   "[namespace current]::ex"
145	variable ex_ok      0
146	variable msg        [list]
147	variable map ;      array set map {}
148	variable param      [list]
149    }
150
151    # Create the command to manipulate the object
152    #                 $name -> ::doctools::idx::DocIdxProc $name
153    interp alias {} ::$name {} ::doctools::idx::DocIdxProc $name
154
155    # If the name was followed by arguments use them to configure the
156    # object before returning its handle to the caller.
157
158    if {[llength $args] > 1} {
159	# Use linsert trick to make the command a pure list.
160	eval [linsert $args 0 _configure $name]
161    }
162    return $name
163}
164
165##########################
166# Private functions follow
167
168# ::doctools::idx::DocIdxProc --
169#
170#	Command that processes all docidx object commands.
171#	Dispatches any object command to the appropriate internal
172#	command implementing its functionality.
173#
174# Arguments:
175#	name	Name of the docidx object to manipulate.
176#	cmd	Subcommand to invoke.
177#	args	Arguments for subcommand.
178#
179# Results:
180#	Varies based on command to perform
181
182proc ::doctools::idx::DocIdxProc {name {cmd ""} args} {
183    # Do minimal args checks here
184    if { [llength [info level 0]] == 2 } {
185	error "wrong # args: should be \"$name option ?arg arg ...?\""
186    }
187
188    # Split the args into command and args components
189
190    if { [llength [info commands ::doctools::idx::_$cmd]] == 0 } {
191	variable commands
192	set optlist [join $commands ", "]
193	set optlist [linsert $optlist "end-1" "or"]
194	return -code error "bad option \"$cmd\": must be $optlist"
195    }
196    return [eval [list ::doctools::idx::_$cmd $name] $args]
197}
198
199##########################
200# Method implementations follow (these are also private commands)
201
202# ::doctools::idx::_cget --
203#
204#	Retrieve the current value of a particular option
205#
206# Arguments:
207#	name	Name of the docidx object to query
208#	option	Name of the option whose value we are asking for.
209#
210# Results:
211#	The value of the option
212
213proc ::doctools::idx::_cget {name option} {
214    _configure $name $option
215}
216
217# ::doctools::idx::_configure --
218#
219#	Configure a docidx object, or query its configuration.
220#
221# Arguments:
222#	name	Name of the docidx object to configure
223#	args	Options and their values.
224#
225# Results:
226#	None if configuring the object.
227#	A list of all options and their values if called without arguments.
228#	The value of one particular option if called with a single argument.
229
230proc ::doctools::idx::_configure {name args} {
231    if {[llength $args] == 0} {
232	# Retrieve the current configuration.
233
234	upvar #0 ::doctools::idx::docidx${name}::file    file
235	upvar #0 ::doctools::idx::docidx${name}::format  format
236
237	set     res [list]
238	lappend res -file       $file
239	lappend res -format     $format
240	return $res
241
242    } elseif {[llength $args] == 1} {
243	# Query the value of one particular option.
244
245	switch -exact -- [lindex $args 0] {
246	    -file {
247		upvar #0 ::doctools::idx::docidx${name}::file file
248		return $file
249	    }
250	    -format {
251		upvar #0 ::doctools::idx::docidx${name}::format format
252		return $format
253	    }
254	    default {
255		return -code error \
256			"doctools::idx::_configure: Unknown option \"[lindex $args 0]\", expected\
257			-file, or -format"
258	    }
259	}
260    } else {
261	# Reconfigure the object.
262
263	if {[llength $args] % 2 == 1} {
264	    return -code error "wrong # args: doctools::idx::_configure name ?opt val...??"
265	}
266
267	foreach {option value} $args {
268	    switch -exact -- $option {
269		-file {
270		    upvar #0 ::doctools::idx::docidx${name}::file file
271		    set file $value
272		}
273		-format {
274		    if {[catch {
275			set fmtfile [LookupFormat $name $value]
276			SetupFormatter $name $fmtfile
277			upvar #0 ::doctools::idx::docidx${name}::format format
278			set format $value
279		    } msg]} {
280			return -code error "doctools::idx::_configure: -format: $msg"
281		    }
282		}
283		default {
284		    return -code error \
285			    "doctools::idx::_configure: Unknown option \"$option\", expected\
286			    -file, or -format"
287		}
288	    }
289	}
290    }
291    return ""
292}
293
294# ::doctools::idx::_destroy --
295#
296#	Destroy a docidx object, including its associated command and data storage.
297#
298# Arguments:
299#	name	Name of the docidx object to destroy.
300#
301# Results:
302#	None.
303
304proc ::doctools::idx::_destroy {name} {
305    # Check the object for sub objects which have to destroyed before
306    # the namespace is torn down.
307    namespace eval ::doctools::idx::docidx$name {
308	if {$format_ip != ""} {interp delete $format_ip}
309	if {$chk_ip    != ""} {interp delete $chk_ip}
310
311	# Expander objects have no delete/destroy method. This would
312	# be a leak if not for the fact that an expander object is a
313	# namespace, and we have arranged to make it a sub namespace of
314	# the docidx object. Therefore tearing down our object namespace
315	# also cleans up the expander object.
316	# if {$expander != ""} {$expander destroy}
317
318    }
319    namespace delete ::doctools::idx::docidx$name
320    interp alias {} ::$name {}
321    return
322}
323
324# ::doctools::idx::_map --
325#
326#	Add a mapping from symbolic to actual filename to the object.
327#
328# Arguments:
329#	name	Name of the docidx object to use
330#	sfname	Symbolic filename to map
331#	afname	Actual filename
332#
333# Results:
334#	None.
335
336proc ::doctools::idx::_map {name sfname afname} {
337    upvar #0 ::doctools::idx::docidx${name}::map map
338    set map($sfname) $afname
339    return
340}
341
342# ::doctools::idx::_format --
343#
344#	Convert some text in doctools format
345#	according to the configuration in the object.
346#
347# Arguments:
348#	name	Name of the docidx object to use
349#	text	Text to convert.
350#
351# Results:
352#	The conversion result.
353
354proc ::doctools::idx::_format {name text} {
355    upvar #0 ::doctools::idx::docidx${name}::format format
356    if {$format == ""} {
357	return -code error "$name: No format was specified"
358    }
359
360    upvar #0 ::doctools::idx::docidx${name}::format_ip format_ip
361    upvar #0 ::doctools::idx::docidx${name}::chk_ip    chk_ip
362    upvar #0 ::doctools::idx::docidx${name}::ex_ok     ex_ok
363    upvar #0 ::doctools::idx::docidx${name}::expander  expander
364    upvar #0 ::doctools::idx::docidx${name}::passes    passes
365    upvar #0 ::doctools::idx::docidx${name}::msg       warnings
366
367    if {!$ex_ok}       {SetupExpander  $name}
368    if {$chk_ip == ""} {SetupChecker   $name}
369    # assert (format_ip != "")
370
371    set warnings [list]
372    if {[catch {$format_ip eval idx_initialize}]} {
373	return -code error "Could not initialize engine"
374    }
375    set result ""
376
377    for {
378	set p $passes ; set n 1
379    } {
380	$p > 0
381    } {
382	incr p -1 ; incr n
383    } {
384	if {[catch {$format_ip eval [list idx_setup $n]}]} {
385	    catch {$format_ip eval idx_shutdown}
386	    return -code error "Could not initialize pass $n of engine"
387	}
388	$chk_ip eval ck_initialize
389
390	if {[catch {set result [$expander expand $text]} msg]} {
391	    catch {$format_ip eval idx_shutdown}
392	    # Filter for checker errors and reduce them to the essential message.
393
394	    if {![regexp {^Error in} $msg]}          {return -code error $msg}
395	    #set msg [join [lrange [split $msg \n] 2 end]]
396
397	    if {![regexp {^--> \(FmtError\) } $msg]} {return -code error "Docidx $msg"}
398	    set msg [lindex [split $msg \n] 0]
399	    regsub {^--> \(FmtError\) } $msg {} msg
400
401	    return -code error $msg
402	}
403
404	$chk_ip eval ck_complete
405    }
406
407    if {[catch {set result [$format_ip eval [list idx_postprocess $result]]}]} {
408	return -code error "Unable to post process final result"
409    }
410    if {[catch {$format_ip eval idx_shutdown}]} {
411	return -code error "Could not shut engine down"
412    }
413    return $result
414
415}
416
417# ::doctools::idx::_search --
418#
419#	Add a search path to the object.
420#
421# Arguments:
422#	name	Name of the docidx object to extend
423#	path	Search path to add.
424#
425# Results:
426#	None.
427
428proc ::doctools::idx::_search {name path} {
429    if {![file exists      $path]} {return -code error "$name search: path does not exist"}
430    if {![file isdirectory $path]} {return -code error "$name search: path is not a directory"}
431    if {![file readable    $path]} {return -code error "$name search: path cannot be read"}
432
433    upvar #0 ::doctools::idx::docidx${name}::paths paths
434    set paths [linsert $paths 0 $path]
435    return
436}
437
438# ::doctools::idx::_warnings --
439#
440#	Return the warning accumulated during the last invocation of 'format'.
441#
442# Arguments:
443#	name	Name of the docidx object to query
444#
445# Results:
446#	A list of warnings.
447
448proc ::doctools::idx::_warnings {name} {
449    upvar #0 ::doctools::idx::docidx${name}::msg msg
450    return $msg
451}
452
453# ::doctools::_parameters --
454#
455#	Returns a list containing the parameters provided
456#	by the selected formatting engine.
457#
458# Arguments:
459#	name	Name of the doctools object to query
460#
461# Results:
462#	A list of parameter names
463
464proc ::doctools::idx::_parameters {name} {
465    upvar #0 ::doctools::idx::docidx${name}::param param
466    return $param
467}
468
469# ::doctools::_setparam --
470#
471#	Set a named engine parameter to a value.
472#
473# Arguments:
474#	name	Name of the doctools object to query
475#	param	Name of the parameter to set.
476#	value	Value to set the parameter to.
477#
478# Results:
479#	None.
480
481proc ::doctools::idx::_setparam {name param value} {
482    upvar #0 ::doctools::idx::docidx${name}::format_ip format_ip
483
484    if {$format_ip == {}} {
485	return -code error \
486		"Unable to set parameters without a valid format"
487    }
488
489    $format_ip eval [list idx_varset $param $value]
490    return
491}
492
493##########################
494# Support commands
495
496# ::doctools::idx::LookupFormat --
497#
498#	Search a format definition file based upon its name
499#
500# Arguments:
501#	name	Name of the docidx object to use
502#	format	Name of the format to look for.
503#
504# Results:
505#	The file containing the format definition
506
507proc ::doctools::idx::LookupFormat {name format} {
508    # Order of searching
509    # 1) Is the name of the format an existing file ?
510    #    If yes, take this file.
511    # 2) Look for the file in the directories given to the object itself..
512    # 3) Look for the file in the standard directories of this package.
513
514    if {[file exists $format]} {
515	return $format
516    }
517
518    upvar #0 ::doctools::idx::docidx${name}::paths opaths
519    foreach path $opaths {
520	set f [file join $path idx.$format]
521	if {[file exists $f]} {
522	    return $f
523	}
524    }
525
526    variable paths
527    foreach path $paths {
528	set f [file join $path idx.$format]
529	if {[file exists $f]} {
530	    return $f
531	}
532    }
533
534    return -code error "Unknown format \"$format\""
535}
536
537# ::doctools::idx::SetupFormatter --
538#
539#	Create and initializes an interpreter containing a
540#	formatting engine
541#
542# Arguments:
543#	name	Name of the docidx object to manipulate
544#	format	Name of file containing the code of the engine
545#
546# Results:
547#	None.
548
549proc ::doctools::idx::SetupFormatter {name format} {
550
551    # Create and initialize the interpreter first.
552    # Use a transient variable. Interrogate the
553    # engine and check its response. Bail out in
554    # case of errors. Only if we pass the checks
555    # we tear down the old engine and make the new
556    # one official.
557
558    variable here
559    set mpip [interp create -safe] ; # interpreter for the formatting engine
560    #set mpip [interp create] ; # interpreter for the formatting engine
561
562    $mpip invokehidden source [file join $here api_idx.tcl]
563    #$mpip eval [list source [file join $here api_idx.tcl]]
564    interp alias $mpip dt_source   {} ::doctools::idx::Source  $mpip [file dirname $format]
565    interp alias $mpip dt_read     {} ::doctools::idx::Read    $mpip [file dirname $format]
566    interp alias $mpip dt_package  {} ::doctools::idx::Package $mpip
567    interp alias $mpip file        {} ::doctools::idx::FileOp  $mpip
568    interp alias $mpip puts_stderr {} ::puts stderr
569    $mpip invokehidden source $format
570    #$mpip eval [list source $format]
571
572    # Check the engine for useability in doctools.
573
574    foreach api {
575	idx_numpasses
576	idx_initialize
577	idx_setup
578	idx_postprocess
579	idx_shutdown
580	idx_listvariables
581	idx_varset
582    } {
583	if {[$mpip eval [list info commands $api]] == {}} {
584	    interp delete $mpip
585	    error "$format error: API incomplete, cannot use this engine"
586	}
587    }
588    if {[catch {
589	set passes [$mpip eval idx_numpasses]
590    }]} {
591	interp delete $mpip
592	error "$format error: Unable to query for number of passes"
593    }
594    if {![string is integer $passes] || ($passes < 1)} {
595	interp delete $mpip
596	error "$format error: illegal number of passes \"$passes\""
597    }
598    if {[catch {
599	set parameters [$mpip eval idx_listvariables]
600    }]} {
601	interp delete $mpip
602	error "$format error: Unable to query for list of parameters"
603    }
604
605    # Passed the tests. Tear down existing engine,
606    # and checker. The latter is destroyed because
607    # of its aliases into the formatter, which are
608    # now invalid. It will be recreated during the
609    # next call of 'format'.
610
611    upvar #0 ::doctools::idx::docidx${name}::formatfile formatfile
612    upvar #0 ::doctools::idx::docidx${name}::format_ip  format_ip
613    upvar #0 ::doctools::idx::docidx${name}::chk_ip     chk_ip
614    upvar #0 ::doctools::idx::docidx${name}::expander   expander
615    upvar #0 ::doctools::idx::docidx${name}::passes     xpasses
616    upvar #0 ::doctools::idx::docidx${name}::param      xparam
617
618    if {$chk_ip != {}}    {interp delete $chk_ip}
619    if {$format_ip != {}} {interp delete $format_ip}
620
621    set chk_ip    ""
622    set format_ip ""
623
624    # Now link engine API into it.
625
626    interp alias $mpip dt_format    {} ::doctools::idx::GetFormat    $name
627    interp alias $mpip dt_user      {} ::doctools::idx::GetUser      $name
628    interp alias $mpip dt_fmap      {} ::doctools::idx::MapFile      $name
629
630    foreach cmd {cappend cget cis cname cpop cpush cset lb rb} {
631	interp alias $mpip ex_$cmd {} $expander $cmd
632    }
633
634    set format_ip  $mpip
635    set formatfile $format
636    set xpasses    $passes
637    set xparam     $parameters
638    return
639}
640
641# ::doctools::idx::SetupChecker --
642#
643#	Create and initializes an interpreter for checking the usage of
644#	docidx formatting commands
645#
646# Arguments:
647#	name	Name of the docidx object to manipulate
648#
649# Results:
650#	None.
651
652proc ::doctools::idx::SetupChecker {name} {
653    # Create an interpreter for checking the usage of docidx formatting commands
654    # and initialize it: Link it to the interpreter doing the formatting, the
655    # expander object and the configuration information. All of which
656    # is accessible through the token/handle (name of state/object array).
657
658    variable here
659
660    upvar #0 ::doctools::idx::docidx${name}::chk_ip    chk_ip
661    if {$chk_ip != ""} {return}
662
663    upvar #0 ::doctools::idx::docidx${name}::expander  expander
664    upvar #0 ::doctools::idx::docidx${name}::format_ip format_ip
665
666    set chk_ip [interp create] ; # interpreter hosting the formal format checker
667
668    # Make configuration available through command, then load the code base.
669
670    foreach {cmd ckcmd} {
671	dt_search     SearchPaths
672	dt_error      FmtError
673	dt_warning    FmtWarning
674    } {
675	interp alias $chk_ip $cmd {} ::doctools::idx::$ckcmd $name
676    }
677    $chk_ip eval [list source [file join $here checker_idx.tcl]]
678
679    # Simple expander commands are directly routed back into it, no
680    # checking required.
681
682    foreach cmd {cappend cget cis cname cpop cpush cset lb rb} {
683	interp alias $chk_ip $cmd {} $expander $cmd
684    }
685
686    # Link the formatter commands into the checker. We use the prefix
687    # 'fmt_' to distinguish them from the checking commands.
688
689    foreach cmd {
690	index_begin index_end key manpage url comment plain_text
691    } {
692	interp alias $chk_ip fmt_$cmd $format_ip fmt_$cmd
693    }
694    return
695}
696
697# ::doctools::idx::SetupExpander --
698#
699#	Create and initializes the expander for input
700#
701# Arguments:
702#	name	Name of the docidx object to manipulate
703#
704# Results:
705#	None.
706
707proc ::doctools::idx::SetupExpander {name} {
708    upvar #0 ::doctools::idx::docidx${name}::ex_ok    ex_ok
709    if {$ex_ok} {return}
710
711    upvar #0 ::doctools::idx::docidx${name}::expander expander
712    ::textutil::expander $expander
713    $expander evalcmd [list ::doctools::idx::Eval $name]
714    $expander textcmd plain_text
715    set ex_ok 1
716    return
717}
718
719# ::doctools::idx::SearchPaths --
720#
721#	API for checker. Returns list of search paths for format
722#	definitions. Used to look for message catalogs as well.
723#
724# Arguments:
725#	name	Name of the docidx object to query.
726#
727# Results:
728#	None.
729
730proc ::doctools::idx::SearchPaths {name} {
731    upvar #0 ::doctools::idx::docidx${name}::paths opaths
732    variable paths
733
734    set p $opaths
735    foreach s $paths {lappend p $s}
736    return $p
737}
738
739# ::doctools::idx::FmtError --
740#
741#	API for checker. Called when an error occurred.
742#
743# Arguments:
744#	name	Name of the docidx object to query.
745#	text	Error message
746#
747# Results:
748#	None.
749
750proc ::doctools::idx::FmtError {name text} {
751    return -code error "(FmtError) $text"
752}
753
754# ::doctools::idx::FmtWarning --
755#
756#	API for checker. Called when a warning was generated
757#
758# Arguments:
759#	name	Name of the docidx object
760#	text	Warning message
761#
762# Results:
763#	None.
764
765proc ::doctools::idx::FmtWarning {name text} {
766    upvar #0 ::doctools::idx::docidx${name}::msg msg
767    lappend msg $text
768    return
769}
770
771# ::doctools::idx::Eval --
772#
773#	API for expander. Routes the macro invocations
774#	into the checker interpreter
775#
776# Arguments:
777#	name	Name of the docidx object to query.
778#
779# Results:
780#	None.
781
782proc ::doctools::idx::Eval {name macro} {
783    upvar #0 ::doctools::idx::docidx${name}::chk_ip chk_ip
784
785    # Handle the [include] command directly
786    if {[string match include* $macro]} {
787	set macro [$chk_ip eval [list subst $macro]]
788	foreach {cmd filename} $macro break
789	return [ExpandInclude $name $filename]
790    }
791
792    return [$chk_ip eval $macro]
793}
794
795# ::doctools::idx::ExpandInclude --
796#
797#	Handle inclusion of files.
798#
799# Arguments:
800#	name	Name of the docidx object to query.
801#	path	Name of file to include and expand.
802#
803# Results:
804#	None.
805
806proc ::doctools::idx::ExpandInclude {name path} {
807    upvar #0 ::doctools::idx::docidx${name}::file file
808
809    set ipath [file normalize [file join [file dirname $file] $path]]
810    if {![file exists $ipath]} {
811	set ipath $path
812	if {![file exists $ipath]} {
813	    return -code error "Unable to fine include file \"$path\""
814	}
815    }
816
817    set    chan [open $ipath r]
818    set    text [read $chan]
819    close $chan
820
821    upvar #0 ::doctools::idx::docidx${name}::expander  expander
822
823    set saved $file
824    set file $ipath
825    set res [$expander expand $text]
826    set file $saved
827
828    return $res
829}
830
831# ::doctools::idx::GetUser --
832#
833#	API for formatter. Returns name of current user
834#
835# Arguments:
836#	name	Name of the docidx object to query.
837#
838# Results:
839#	String, name of current user.
840
841proc ::doctools::idx::GetUser {name} {
842    global  tcl_platform
843    return $tcl_platform(user)
844}
845
846# ::doctools::idx::GetFormat --
847#
848#	API for formatter. Returns format information
849#
850# Arguments:
851#	name	Name of the docidx object to query.
852#
853# Results:
854#	Format information
855
856proc ::doctools::idx::GetFormat {name} {
857    upvar #0 ::doctools::idx::docidx${name}::format format
858    return $format
859}
860
861# ::doctools::idx::MapFile --
862#
863#	API for formatter. Maps symbolic to actual filename in an
864#	index element. If no mapping is found it is assumed that
865#	the symbolic name is also the actual name.
866#
867# Arguments:
868#	name	Name of the docidx object to query.
869#	fname	Symbolic name of the file.
870#
871# Results:
872#	Actual name of the file.
873
874proc ::doctools::idx::MapFile {name fname} {
875    upvar #0 ::doctools::idx::docidx${name}::map map
876    if {[info exists map($fname)]} {
877	return $map($fname)
878    }
879    return $fname
880}
881
882# ::doctools::idx::Source --
883#
884#	API for formatter. Used by engine to ask for
885#	additional script files support it.
886#
887# Arguments:
888#	name	Name of the docidx object to change.
889#
890# Results:
891#	Boolean flag.
892
893proc ::doctools::idx::Source {ip path file} {
894    $ip invokehidden source [file join $path [file tail $file]]
895    #$ip eval [list source [file join $path [file tail $file]]]
896    return
897}
898
899proc ::doctools::idx::Read {ip path file} {
900    #puts stderr "$ip (read $path $file)"
901
902    return [read [set f [open [file join $path [file tail $file]]]]][close $f]
903}
904
905proc ::doctools::idx::FileOp {ip args} {
906    #puts stderr "$ip (file $args)"
907    # -- FUTURE -- disallow unsafe operations --
908
909    return [eval [linsert $args 0 file]]
910}
911
912proc ::doctools::idx::Package {ip pkg} {
913    #puts stderr "$ip package require $pkg"
914
915    set indexScript [Locate $pkg]
916
917    $ip expose source
918    $ip expose load
919    $ip eval		$indexScript
920    $ip hide   source
921    $ip hide   load
922    #$ip eval [list source [file join $path [file tail $file]]]
923    return
924}
925
926proc ::doctools::idx::Locate {p} {
927    # @mdgen NODEP: doctools::__undefined__
928    catch {package require doctools::__undefined__}
929
930    #puts stderr "auto_path = [join $::auto_path \n]"
931
932    # Check if requested package is in the list of loadable packages.
933    # Then get the highest possible version, and then the index script
934
935    if {[lsearch -exact [package names] $p] < 0} {
936	return -code error "Unknown package $p"
937    }
938
939    set v  [lindex [lsort -increasing [package versions $p]] end]
940
941    #puts stderr "Package $p = $v"
942
943    return [package ifneeded $p $v]
944}
945
946#------------------------------------
947# Module initialization
948
949namespace eval ::doctools::idx {
950    # Reverse order of searching. First to search is specified last.
951
952    # FOO/docidx.tcl
953    # => FOO/mpformats
954
955    #catch {search [file join $here                lib doctools mpformats]}
956    #catch {search [file join [file dirname $here] lib doctools mpformats]}
957    catch {search [file join $here                             mpformats]}
958}
959
960package provide doctools::idx 1.0.4
961