docidx.tcl
Go to the documentation of this file.00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012 package require Tcl 8.2
00013 package require textutil::expander
00014
00015
00016
00017
00018
00019
00020
00021 namespace ::doctools {}
00022 namespace ::doctools::idx {
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039 variable commands [list \
00040 "cget" \
00041 "configure" \
00042 "destroy" \
00043 "format" \
00044 "map" \
00045 "search" \
00046 "warnings" \
00047 "parameters" \
00048 "param = " \
00049 ]
00050
00051
00052 namespace export new search help
00053
00054
00055
00056
00057
00058
00059
00060 variable paths [list]
00061 variable here [file dirname [info script]]
00062 }
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080 ret ::doctools::idx::search (type path) {
00081 variable paths
00082
00083 if {![file exists $path]} {return -code error "doctools::idx::search: path does not exist"}
00084 if {![file isdirectory $path]} {return -code error "doctools::idx::search: path is not a directory"}
00085 if {![file readable $path]} {return -code error "doctools::idx::search: path cannot be read"}
00086
00087 set paths [linsert $paths 0 $path]
00088 return
00089 }
00090
00091
00092
00093
00094
00095
00096
00097
00098
00099
00100
00101
00102 ret ::doctools::idx::help () {
00103 return "formatting commands\n\
00104 * index_begin - begin of index\n\
00105 * index_end - end of index\n\
00106 * key - begin of references for key\n\
00107 * manpage - index reference to manpage\n\
00108 * url - index reference to url\n\
00109 * vset - set/get variable values\n\
00110 * include - insert external file\n\
00111 * lb, rb - left/right brackets\n\
00112 "
00113 }
00114
00115
00116
00117
00118
00119
00120
00121
00122
00123
00124
00125
00126 ret ::doctools::idx::new (type name , type args) {
00127 if { [llength [info commands ::$name]] } {
00128 return -code error "command \"$name\" already exists, unable to create docidx object"
00129 }
00130 if {[llength $args] % 2 == 1} {
00131 return -code error "wrong # args: doctools::new name ?opt val...??"
00132 }
00133
00134 # The arguments seem to be ok, setup the namespace for the object
00135
00136 namespace eval ::doctools::idx::docidx$name {
00137 variable paths [list]
00138 variable file ""
00139 variable format ""
00140 variable formatfile ""
00141 variable format_ip ""
00142 variable chk_ip ""
00143 variable expander "[namespace current]::ex"
00144 variable ex_ok 0
00145 variable msg [list]
00146 variable map ; array set map {}
00147 variable param [list]
00148 }
00149
00150 # Create the command to manipulate the object
00151 # $name -> ::doctools::idx::DocIdxProc $name
00152 interp alias {} ::$name {} ::doctools::idx::DocIdxProc $name
00153
00154 # If the name was followed by arguments use them to configure the
00155 # object before returning its handle to the caller.
00156
00157 if {[llength $args] > 1} {
00158 # Use linsert trick to make the command a pure list.
00159 eval [linsert $args 0 _configure $name]
00160 }
00161 return $name
00162 }
00163
00164
00165
00166
00167
00168
00169
00170
00171
00172
00173
00174
00175
00176
00177
00178
00179
00180
00181 ret ::doctools::idx::DocIdxProc (type name , optional cmd ="" , type args) {
00182 # Do minimal args checks here
00183 if { [llength [info level 0]] == 2 } {
00184 error "wrong # args: should be \"$name option ?arg arg ...?\""
00185 }
00186
00187 # Split the args into command and args components
00188
00189 if { [llength [info commands ::doctools::idx::_$cmd]] == 0 } {
00190 variable commands
00191 set optlist [join $commands ", "]
00192 set optlist [linsert $optlist "end-1" "or"]
00193 return -code error "bad option \"$cmd\": must be $optlist"
00194 }
00195 return [eval [list ::doctools::idx::_$cmd $name] $args]
00196 }
00197
00198
00199
00200
00201
00202
00203
00204
00205
00206
00207
00208
00209
00210
00211
00212 ret ::doctools::idx::_cget (type name , type option) {
00213 _configure $name $option
00214 }
00215
00216
00217
00218
00219
00220
00221
00222
00223
00224
00225
00226
00227
00228
00229 ret ::doctools::idx::_configure (type name , type args) {
00230 if {[llength $args] == 0} {
00231 # Retrieve the current configuration.
00232
00233 upvar ::doctools::idx::docidx${name}::file file
00234 upvar ::doctools::idx::docidx${name}::format format
00235
00236 set res [list]
00237 lappend res -file $file
00238 lappend res -format $format
00239 return $res
00240
00241 } elseif {[llength $args] == 1} {
00242 # Query the value of one particular option.
00243
00244 switch -exact -- [lindex $args 0] {
00245 -file {
00246 upvar ::doctools::idx::docidx${name}::file file
00247 return $file
00248 }
00249 -format {
00250 upvar ::doctools::idx::docidx${name}::format format
00251 return $format
00252 }
00253 default {
00254 return -code error \
00255 "doctools::idx::_configure: Unknown option \"[lindex $args 0]\", expected\
00256 -file, or -format"
00257 }
00258 }
00259 } else {
00260 # Reconfigure the object.
00261
00262 if {[llength $args] % 2 == 1} {
00263 return -code error "wrong # args: doctools::idx::_configure name ?opt val...??"
00264 }
00265
00266 foreach {option value} $args {
00267 switch -exact -- $option {
00268 -file {
00269 upvar ::doctools::idx::docidx${name}::file file
00270 set file $value
00271 }
00272 -format {
00273 if {[catch {
00274 set fmtfile [LookupFormat $name $value]
00275 SetupFormatter $name $fmtfile
00276 upvar ::doctools::idx::docidx${name}::format format
00277 set format $value
00278 } msg]} {
00279 return -code error "doctools::idx::_configure: -format: $msg"
00280 }
00281 }
00282 default {
00283 return -code error \
00284 "doctools::idx::_configure: Unknown option \"$option\", expected\
00285 -file, or -format"
00286 }
00287 }
00288 }
00289 }
00290 return ""
00291 }
00292
00293
00294
00295
00296
00297
00298
00299
00300
00301
00302
00303 ret ::doctools::idx::_destroy (type name) {
00304 # Check the object for sub objects which have to destroyed before
00305 # the namespace is torn down.
00306 namespace eval ::doctools::idx::docidx$name {
00307 if {$format_ip != ""} {interp delete $format_ip}
00308 if {$chk_ip != ""} {interp delete $chk_ip}
00309
00310 # Expander objects have no delete/destroy method. This would
00311 # be a leak if not for the fact that an expander object is a
00312 # namespace, and we have arranged to make it a sub namespace of
00313 # the docidx object. Therefore tearing down our object namespace
00314 # also cleans up the expander object.
00315 # if {$expander != ""} {$expander destroy}
00316
00317 }
00318 namespace delete ::doctools::idx::docidx$name
00319 interp alias {} ::$name {}
00320 return
00321 }
00322
00323
00324
00325
00326
00327
00328
00329
00330
00331
00332
00333
00334
00335 ret ::doctools::idx::_map (type name , type sfname , type afname) {
00336 upvar ::doctools::idx::docidx${name}::map map
00337 set map($sfname) $afname
00338 return
00339 }
00340
00341
00342
00343
00344
00345
00346
00347
00348
00349
00350
00351
00352
00353 ret ::doctools::idx::_format (type name , type text) {
00354 upvar ::doctools::idx::docidx${name}::format format
00355 if {$format == ""} {
00356 return -code error "$name: No format was specified"
00357 }
00358
00359 upvar ::doctools::idx::docidx${name}::format_ip format_ip
00360 upvar ::doctools::idx::docidx${name}::chk_ip chk_ip
00361 upvar ::doctools::idx::docidx${name}::ex_ok ex_ok
00362 upvar ::doctools::idx::docidx${name}::expander expander
00363 upvar ::doctools::idx::docidx${name}::passes passes
00364 upvar ::doctools::idx::docidx${name}::msg warnings
00365
00366 if {!$ex_ok} {SetupExpander $name}
00367 if {$chk_ip == ""} {SetupChecker $name}
00368 # assert (format_ip != "")
00369
00370 set warnings [list]
00371 if {[catch {$format_ip eval idx_initialize}]} {
00372 return -code error "Could not initialize engine"
00373 }
00374 set result ""
00375
00376 for {
00377 set p $passes ; set n 1
00378 } {
00379 $p > 0
00380 } {
00381 incr p -1 ; incr n
00382 } {
00383 if {[catch {$format_ip eval [list idx_setup $n]}]} {
00384 catch {$format_ip eval idx_shutdown}
00385 return -code error "Could not initialize pass $n of engine"
00386 }
00387 $chk_ip eval ck_initialize
00388
00389 if {[catch {set result [$expander expand $text]} msg]} {
00390 catch {$format_ip eval idx_shutdown}
00391 # Filter for checker errors and reduce them to the essential message.
00392
00393 if {![regexp {^Error in} $msg]} {return -code error $msg}
00394 #set msg [join [lrange [split $msg \n] 2 end]]
00395
00396 if {![regexp {^--> \(FmtError\) } $msg]} {return -code error "Docidx $msg"}
00397 set msg [lindex [split $msg \n] 0]
00398 regsub {^--> \(FmtError\) } $msg {} msg
00399
00400 return -code error $msg
00401 }
00402
00403 $chk_ip eval ck_complete
00404 }
00405
00406 if {[catch {set result [$format_ip eval [list idx_postprocess $result]]}]} {
00407 return -code error "Unable to post process final result"
00408 }
00409 if {[catch {$format_ip eval idx_shutdown}]} {
00410 return -code error "Could not shut engine down"
00411 }
00412 return $result
00413
00414 }
00415
00416
00417
00418
00419
00420
00421
00422
00423
00424
00425
00426
00427 ret ::doctools::idx::_search (type name , type path) {
00428 if {![file exists $path]} {return -code error "$name search: path does not exist"}
00429 if {![file isdirectory $path]} {return -code error "$name search: path is not a directory"}
00430 if {![file readable $path]} {return -code error "$name search: path cannot be read"}
00431
00432 upvar ::doctools::idx::docidx${name}::paths paths
00433 set paths [linsert $paths 0 $path]
00434 return
00435 }
00436
00437
00438
00439
00440
00441
00442
00443
00444
00445
00446
00447 ret ::doctools::idx::_warnings (type name) {
00448 upvar ::doctools::idx::docidx${name}::msg msg
00449 return $msg
00450 }
00451
00452
00453
00454
00455
00456
00457
00458
00459
00460
00461
00462
00463 ret ::doctools::idx::_parameters (type name) {
00464 upvar ::doctools::idx::docidx${name}::param param
00465 return $param
00466 }
00467
00468
00469
00470
00471
00472
00473
00474
00475
00476
00477
00478
00479
00480 ret ::doctools::idx::_setparam (type name , type param , type value) {
00481 upvar ::doctools::idx::docidx${name}::format_ip format_ip
00482
00483 if {$format_ip == {}} {
00484 return -code error \
00485 "Unable to set parameters without a valid format"
00486 }
00487
00488 $format_ip eval [list idx_varset $param $value]
00489 return
00490 }
00491
00492
00493
00494
00495
00496
00497
00498
00499
00500
00501
00502
00503
00504
00505
00506 ret ::doctools::idx::LookupFormat (type name , type format) {
00507 # Order of searching
00508 # 1) Is the name of the format an existing file ?
00509 # If yes, take this file.
00510 # 2) Look for the file in the directories given to the object itself..
00511 # 3) Look for the file in the standard directories of this package.
00512
00513 if {[file exists $format]} {
00514 return $format
00515 }
00516
00517 upvar ::doctools::idx::docidx${name}::paths opaths
00518 foreach path $opaths {
00519 set f [file join $path idx.$format]
00520 if {[file exists $f]} {
00521 return $f
00522 }
00523 }
00524
00525 variable paths
00526 foreach path $paths {
00527 set f [file join $path idx.$format]
00528 if {[file exists $f]} {
00529 return $f
00530 }
00531 }
00532
00533 return -code error "Unknown format \"$format\""
00534 }
00535
00536
00537
00538
00539
00540
00541
00542
00543
00544
00545
00546
00547
00548 ret ::doctools::idx::SetupFormatter (type name , type format) {
00549
00550 # Create and initialize the interpreter first.
00551 # Use a transient variable. Interrogate the
00552 # engine and check its response. Bail out in
00553 # case of errors. Only if we pass the checks
00554 # we tear down the old engine and make the new
00555 # one official.
00556
00557 variable here
00558 set mpip [interp create -safe] ; # interpreter for the formatting engine
00559 #set mpip [interp create] ; # interpreter for the formatting engine
00560
00561 $mpip invokehidden source [file join $here api_idx.tcl]
00562 #$mpip eval [list source [file join $here api_idx.tcl]]
00563 interp alias $mpip dt_source {} ::doctools::idx::Source $mpip [file dirname $format]
00564 interp alias $mpip dt_package {} ::doctools::Package $mpip
00565 interp alias $mpip file {} ::doctools::FileOp $mpip
00566 interp alias $mpip puts_stderr {} ::puts stderr
00567 $mpip invokehidden source $format
00568 #$mpip eval [list source $format]
00569
00570 # Check the engine for useability in doctools.
00571
00572 foreach api {
00573 idx_numpasses
00574 idx_initialize
00575 idx_setup
00576 idx_postprocess
00577 idx_shutdown
00578 idx_listvariables
00579 idx_varset
00580 } {
00581 if {[$mpip eval [list info commands $api]] == {}} {
00582 interp delete $mpip
00583 error "$format error: API incomplete, cannot use this engine"
00584 }
00585 }
00586 if {[catch {
00587 set passes [$mpip eval idx_numpasses]
00588 }]} {
00589 interp delete $mpip
00590 error "$format error: Unable to query for number of passes"
00591 }
00592 if {![string is integer $passes] || ($passes < 1)} {
00593 interp delete $mpip
00594 error "$format error: illegal number of passes \"$passes\""
00595 }
00596 if {[catch {
00597 set parameters [$mpip eval idx_listvariables]
00598 }]} {
00599 interp delete $mpip
00600 error "$format error: Unable to query for list of parameters"
00601 }
00602
00603 # Passed the tests. Tear down existing engine,
00604 # and checker. The latter is destroyed because
00605 # of its aliases into the formatter, which are
00606 # now invalid. It will be recreated during the
00607 # next call of 'format'.
00608
00609 upvar ::doctools::idx::docidx${name}::formatfile formatfile
00610 upvar ::doctools::idx::docidx${name}::format_ip format_ip
00611 upvar ::doctools::idx::docidx${name}::chk_ip chk_ip
00612 upvar ::doctools::idx::docidx${name}::expander expander
00613 upvar ::doctools::idx::docidx${name}::passes xpasses
00614 upvar ::doctools::idx::docidx${name}::param xparam
00615
00616 if {$chk_ip != {}} {interp delete $chk_ip}
00617 if {$format_ip != {}} {interp delete $format_ip}
00618
00619 set chk_ip ""
00620 set format_ip ""
00621
00622 # Now link engine API into it.
00623
00624 interp alias $mpip dt_format {} ::doctools::idx::GetFormat $name
00625 interp alias $mpip dt_user {} ::doctools::idx::GetUser $name
00626 interp alias $mpip dt_fmap {} ::doctools::idx::MapFile $name
00627
00628 foreach cmd {cappend cget cis cname cpop cpush cset lb rb} {
00629 interp alias $mpip ex_$cmd {} $expander $cmd
00630 }
00631
00632 set format_ip $mpip
00633 set formatfile $format
00634 set xpasses $passes
00635 set xparam $parameters
00636 return
00637 }
00638
00639
00640
00641
00642
00643
00644
00645
00646
00647
00648
00649
00650 ret ::doctools::idx::SetupChecker (type name) {
00651 # Create an interpreter for checking the usage of docidx formatting commands
00652 # and initialize it: Link it to the interpreter doing the formatting, the
00653 # expander object and the configuration information. All of which
00654 # is accessible through the token/handle (name of state/object array).
00655
00656 variable here
00657
00658 upvar ::doctools::idx::docidx${name}::chk_ip chk_ip
00659 if {$chk_ip != ""} {return}
00660
00661 upvar ::doctools::idx::docidx${name}::expander expander
00662 upvar ::doctools::idx::docidx${name}::format_ip format_ip
00663
00664 set chk_ip [interp create] ; # interpreter hosting the formal format checker
00665
00666 # Make configuration available through command, then load the code base.
00667
00668 foreach {cmd ckcmd} {
00669 dt_search SearchPaths
00670 dt_error FmtError
00671 dt_warning FmtWarning
00672 } {
00673 interp alias $chk_ip $cmd {} ::doctools::idx::$ckcmd $name
00674 }
00675 $chk_ip eval [list source [file join $here checker_idx.tcl]]
00676
00677 # Simple expander commands are directly routed back into it, no
00678 # checking required.
00679
00680 foreach cmd {cappend cget cis cname cpop cpush cset lb rb} {
00681 interp alias $chk_ip $cmd {} $expander $cmd
00682 }
00683
00684 # Link the formatter commands into the checker. We use the prefix
00685 # 'fmt_' to distinguish them from the checking commands.
00686
00687 foreach cmd {
00688 index_begin index_end key manpage url comment plain_text
00689 } {
00690 interp alias $chk_ip fmt_$cmd $format_ip fmt_$cmd
00691 }
00692 return
00693 }
00694
00695
00696
00697
00698
00699
00700
00701
00702
00703
00704
00705 ret ::doctools::idx::SetupExpander (type name) {
00706 upvar ::doctools::idx::docidx${name}::ex_ok ex_ok
00707 if {$ex_ok} {return}
00708
00709 upvar ::doctools::idx::docidx${name}::expander expander
00710 ::textutil::expander $expander
00711 $expander evalcmd [list ::doctools::idx::Eval $name]
00712 $expander textcmd plain_text
00713 set ex_ok 1
00714 return
00715 }
00716
00717
00718
00719
00720
00721
00722
00723
00724
00725
00726
00727
00728 ret ::doctools::idx::SearchPaths (type name) {
00729 upvar ::doctools::idx::docidx${name}::paths opaths
00730 variable paths
00731
00732 set p $opaths
00733 foreach s $paths {lappend p $s}
00734 return $p
00735 }
00736
00737
00738
00739
00740
00741
00742
00743
00744
00745
00746
00747
00748 ret ::doctools::idx::FmtError (type name , type text) {
00749 return -code error "(FmtError) $text"
00750 }
00751
00752
00753
00754
00755
00756
00757
00758
00759
00760
00761
00762
00763 ret ::doctools::idx::FmtWarning (type name , type text) {
00764 upvar ::doctools::idx::docidx${name}::msg msg
00765 lappend msg $text
00766 return
00767 }
00768
00769
00770
00771
00772
00773
00774
00775
00776
00777
00778
00779
00780 ret ::doctools::idx::Eval (type name , type macro) {
00781 upvar ::doctools::idx::docidx${name}::chk_ip chk_ip
00782
00783 # Handle the [include] command directly
00784 if {[string match include* $macro]} {
00785 foreach {cmd filename} $macro break
00786 return [ExpandInclude $name $filename]
00787 }
00788
00789 return [$chk_ip eval $macro]
00790 }
00791
00792
00793
00794
00795
00796
00797
00798
00799
00800
00801
00802
00803 ret ::doctools::idx::ExpandInclude (type name , type path) {
00804 upvar ::doctools::idx::docidx${name}::file file
00805
00806 set ipath [file join [file dirname $file] $path]
00807 if {![file exists $ipath]} {
00808 set ipath $path
00809 if {![file exists $ipath]} {
00810 return -code error "Unable to fine include file \"$path\""
00811 }
00812 }
00813
00814 set chan [open $ipath r]
00815 set text [read $chan]
00816 close $chan
00817
00818 upvar ::doctools::idx::docidx${name}::expander expander
00819
00820 return [$expander expand $text]
00821 }
00822
00823
00824
00825
00826
00827
00828
00829
00830
00831
00832
00833 ret ::doctools::idx::GetUser (type name) {
00834 global tcl_platform
00835 return $tcl_platform(user)
00836 }
00837
00838
00839
00840
00841
00842
00843
00844
00845
00846
00847
00848 ret ::doctools::idx::GetFormat (type name) {
00849 upvar ::doctools::idx::docidx${name}::format format
00850 return $format
00851 }
00852
00853
00854
00855
00856
00857
00858
00859
00860
00861
00862
00863
00864
00865
00866 ret ::doctools::idx::MapFile (type name , type fname) {
00867 upvar ::doctools::idx::docidx${name}::map map
00868 if {[info exists map($fname)]} {
00869 return $map($fname)
00870 }
00871 return $fname
00872 }
00873
00874
00875
00876
00877
00878
00879
00880
00881
00882
00883
00884
00885 ret ::doctools::idx::Source (type ip , type path , type file) {
00886 $ip invokehidden source [file join $path [file tail $file]]
00887 #$ip eval [list source [file join $path [file tail $file]]]
00888 return
00889 }
00890
00891
00892
00893
00894 namespace ::doctools::idx {
00895
00896
00897
00898
00899
00900
00901
00902 catch {search [file join $here mpformats]}
00903 }
00904
00905 package provide doctools::idx 0.3
00906