doctoc.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::toc {
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::toc::search (type path) {
00081 variable paths
00082
00083 if {![file exists $path]} {return -code error "doctools::toc::search: path does not exist"}
00084 if {![file isdirectory $path]} {return -code error "doctools::toc::search: path is not a directory"}
00085 if {![file readable $path]} {return -code error "doctools::toc::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::toc::help () {
00103 return "formatting commands\n\
00104 * toc_begin - begin of table of contents\n\
00105 * toc_end - end of toc\n\
00106 * division_start - begin of toc division\n\
00107 * division_end - end of toc division\n\
00108 * item - toc element\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::toc::new (type name , type args) {
00127 if { [llength [info commands ::$name]] } {
00128 return -code error "command \"$name\" already exists, unable to create doctoc 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::toc::doctoc$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::toc::DocTocProc $name
00152 interp alias {} ::$name {} ::doctools::toc::DocTocProc $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::toc::DocTocProc (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::toc::_$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::toc::_$cmd $name] $args]
00196 }
00197
00198
00199
00200
00201
00202
00203
00204
00205
00206
00207
00208
00209
00210
00211
00212 ret ::doctools::toc::_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::toc::_configure (type name , type args) {
00230 if {[llength $args] == 0} {
00231 # Retrieve the current configuration.
00232
00233 upvar ::doctools::toc::doctoc${name}::file file
00234 upvar ::doctools::toc::doctoc${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::toc::doctoc${name}::file file
00247 return $file
00248 }
00249 -format {
00250 upvar ::doctools::toc::doctoc${name}::format format
00251 return $format
00252 }
00253 default {
00254 return -code error \
00255 "doctools::toc::_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::toc::_configure name ?opt val...??"
00264 }
00265
00266 foreach {option value} $args {
00267 switch -exact -- $option {
00268 -file {
00269 upvar ::doctools::toc::doctoc${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::toc::doctoc${name}::format format
00277 set format $value
00278 } msg]} {
00279 return -code error "doctools::toc::_configure: -format: $msg"
00280 }
00281 }
00282 default {
00283 return -code error \
00284 "doctools::toc::_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::toc::_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::toc::doctoc$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 doctoc 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::toc::doctoc$name
00319 interp alias {} ::$name {}
00320 return
00321 }
00322
00323
00324
00325
00326
00327
00328
00329
00330
00331
00332
00333
00334
00335 ret ::doctools::toc::_map (type name , type sfname , type afname) {
00336 upvar ::doctools::toc::doctoc${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::toc::_format (type name , type text) {
00354 upvar ::doctools::toc::doctoc${name}::format format
00355 if {$format == ""} {
00356 return -code error "$name: No format was specified"
00357 }
00358
00359 upvar ::doctools::toc::doctoc${name}::format_ip format_ip
00360 upvar ::doctools::toc::doctoc${name}::chk_ip chk_ip
00361 upvar ::doctools::toc::doctoc${name}::ex_ok ex_ok
00362 upvar ::doctools::toc::doctoc${name}::expander expander
00363 upvar ::doctools::toc::doctoc${name}::passes passes
00364 upvar ::doctools::toc::doctoc${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 toc_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 toc_setup $n]}]} {
00384 catch {$format_ip eval toc_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 toc_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 "Doctoc $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 toc_postprocess $result]]}]} {
00407 return -code error "Unable to post process final result"
00408 }
00409 if {[catch {$format_ip eval toc_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::toc::_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::toc::doctoc${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::toc::_warnings (type name) {
00448 upvar ::doctools::toc::doctoc${name}::msg msg
00449 return $msg
00450 }
00451
00452
00453
00454
00455
00456
00457
00458
00459
00460
00461
00462
00463 ret ::doctools::toc::_parameters (type name) {
00464 upvar ::doctools::toc::doctoc${name}::param param
00465 return $param
00466 }
00467
00468
00469
00470
00471
00472
00473
00474
00475
00476
00477
00478
00479
00480 ret ::doctools::toc::_setparam (type name , type param , type value) {
00481 upvar ::doctools::toc::doctoc${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 toc_varset $param $value]
00489 return
00490 }
00491
00492
00493
00494
00495
00496
00497
00498
00499
00500
00501
00502
00503
00504
00505
00506 ret ::doctools::toc::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::toc::doctoc${name}::paths opaths
00518 foreach path $opaths {
00519 set f [file join $path toc.$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 toc.$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::toc::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_toc.tcl]
00562 #$mpip eval [list source [file join $here api_toc.tcl]]
00563 interp alias $mpip dt_source {} ::doctools::toc::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 toc_numpasses
00574 toc_initialize
00575 toc_setup
00576 toc_postprocess
00577 toc_shutdown
00578 toc_listvariables
00579 toc_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 toc_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 toc_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::toc::doctoc${name}::formatfile formatfile
00610 upvar ::doctools::toc::doctoc${name}::format_ip format_ip
00611 upvar ::doctools::toc::doctoc${name}::chk_ip chk_ip
00612 upvar ::doctools::toc::doctoc${name}::expander expander
00613 upvar ::doctools::toc::doctoc${name}::passes xpasses
00614 upvar ::doctools::toc::doctoc${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::toc::GetFormat $name
00625 interp alias $mpip dt_user {} ::doctools::toc::GetUser $name
00626 interp alias $mpip dt_fmap {} ::doctools::toc::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::toc::SetupChecker (type name) {
00651 # Create an interpreter for checking the usage of doctoc 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::toc::doctoc${name}::chk_ip chk_ip
00659 if {$chk_ip != ""} {return}
00660
00661 upvar ::doctools::toc::doctoc${name}::expander expander
00662 upvar ::doctools::toc::doctoc${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::toc::$ckcmd $name
00674 }
00675 $chk_ip eval [list source [file join $here checker_toc.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 toc_begin toc_end division_start division_end item
00689 comment plain_text
00690 } {
00691 interp alias $chk_ip fmt_$cmd $format_ip fmt_$cmd
00692 }
00693 return
00694 }
00695
00696
00697
00698
00699
00700
00701
00702
00703
00704
00705
00706 ret ::doctools::toc::SetupExpander (type name) {
00707 upvar ::doctools::toc::doctoc${name}::ex_ok ex_ok
00708 if {$ex_ok} {return}
00709
00710 upvar ::doctools::toc::doctoc${name}::expander expander
00711 ::textutil::expander $expander
00712 $expander evalcmd [list ::doctools::toc::Eval $name]
00713 $expander textcmd plain_text
00714 set ex_ok 1
00715 return
00716 }
00717
00718
00719
00720
00721
00722
00723
00724
00725
00726
00727
00728
00729 ret ::doctools::toc::SearchPaths (type name) {
00730 upvar ::doctools::toc::doctoc${name}::paths opaths
00731 variable paths
00732
00733 set p $opaths
00734 foreach s $paths {lappend p $s}
00735 return $p
00736 }
00737
00738
00739
00740
00741
00742
00743
00744
00745
00746
00747
00748
00749 ret ::doctools::toc::FmtError (type name , type text) {
00750 return -code error "(FmtError) $text"
00751 }
00752
00753
00754
00755
00756
00757
00758
00759
00760
00761
00762
00763
00764 ret ::doctools::toc::FmtWarning (type name , type text) {
00765 upvar ::doctools::toc::doctoc${name}::msg msg
00766 lappend msg $text
00767 return
00768 }
00769
00770
00771
00772
00773
00774
00775
00776
00777
00778
00779
00780
00781 ret ::doctools::toc::Eval (type name , type macro) {
00782 upvar ::doctools::toc::doctoc${name}::chk_ip chk_ip
00783
00784 # Handle the [include] command directly
00785 if {[string match include* $macro]} {
00786 foreach {cmd filename} $macro break
00787 return [ExpandInclude $name $filename]
00788 }
00789
00790 return [$chk_ip eval $macro]
00791 }
00792
00793
00794
00795
00796
00797
00798
00799
00800
00801
00802
00803
00804 ret ::doctools::toc::ExpandInclude (type name , type path) {
00805 # Look for the file relative to the directory of the
00806 # main file we are converting. If that fails try to
00807 # use the current working directory. Throw an error
00808 # if the file couldn't be found.
00809
00810 upvar ::doctools::toc::doctoc${name}::file file
00811
00812 set ipath [file join [file dirname $file] $path]
00813 if {![file exists $ipath]} {
00814 set ipath $path
00815 if {![file exists $ipath]} {
00816 return -code error "Unable to fine include file \"$path\""
00817 }
00818 }
00819
00820 set chan [open $ipath r]
00821 set text [read $chan]
00822 close $chan
00823
00824 upvar ::doctools::toc::doctoc${name}::expander expander
00825
00826 return [$expander expand $text]
00827 }
00828
00829
00830
00831
00832
00833
00834
00835
00836
00837
00838
00839 ret ::doctools::toc::GetUser (type name) {
00840 global tcl_platform
00841 return $tcl_platform(user)
00842 }
00843
00844
00845
00846
00847
00848
00849
00850
00851
00852
00853
00854 ret ::doctools::toc::GetFormat (type name) {
00855 upvar ::doctools::toc::doctoc${name}::format format
00856 return $format
00857 }
00858
00859
00860
00861
00862
00863
00864
00865
00866
00867
00868
00869
00870
00871
00872 ret ::doctools::toc::MapFile (type name , type fname) {
00873 upvar ::doctools::toc::doctoc${name}::map map
00874 if {[info exists map($fname)]} {
00875 return $map($fname)
00876 }
00877 return $fname
00878 }
00879
00880
00881
00882
00883
00884
00885
00886
00887
00888
00889
00890
00891 ret ::doctools::toc::Source (type ip , type path , type file) {
00892 $ip invokehidden source [file join $path [file tail $file]]
00893 #$ip eval [list source [file join $path [file tail $file]]]
00894 return
00895 }
00896
00897
00898
00899
00900 namespace ::doctools::toc {
00901
00902
00903
00904
00905
00906
00907
00908 catch {search [file join $here mpformats]}
00909 }
00910
00911 package provide doctools::toc 0.3
00912