1# doctoc.tcl -- 2# 3# Implementation of doctoc 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: doctoc.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_toc.tcl 16# @mdgen OWNER: checker_toc.tcl 17# @mdgen OWNER: mpformats/*.tcl 18# @mdgen OWNER: mpformats/*.msg 19# @mdgen OWNER: mpformats/toc.* 20# @mdgen OWNER: mpformats/man.macros 21 22namespace eval ::doctools {} 23namespace eval ::doctools::toc { 24 # Data storage in the doctools::toc 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 doctoc 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::toc::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::toc::search {path} { 82 variable paths 83 84 if {![file exists $path]} {return -code error "doctools::toc::search: path does not exist"} 85 if {![file isdirectory $path]} {return -code error "doctools::toc::search: path is not a directory"} 86 if {![file readable $path]} {return -code error "doctools::toc::search: path cannot be read"} 87 88 set paths [linsert $paths 0 $path] 89 return 90} 91 92# ::doctools::toc::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::toc::help {} { 104 return "formatting commands\n\ 105 * toc_begin - begin of table of contents\n\ 106 * toc_end - end of toc\n\ 107 * division_start - begin of toc division\n\ 108 * division_end - end of toc division\n\ 109 * item - toc element\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::toc::new -- 117# 118# Create a new doctoc object with a given name. May configure the object. 119# 120# Arguments: 121# name Name of the doctoc object. 122# args Options configuring the new object. 123# 124# Results: 125# name Name of the doctools created 126 127proc ::doctools::toc::new {name args} { 128 if { [llength [info commands ::$name]] } { 129 return -code error "command \"$name\" already exists, unable to create doctoc 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::toc::doctoc$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::toc::DocTocProc $name 153 interp alias {} ::$name {} ::doctools::toc::DocTocProc $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::toc::DocTocProc -- 169# 170# Command that processes all doctoc object commands. 171# Dispatches any object command to the appropriate internal 172# command implementing its functionality. 173# 174# Arguments: 175# name Name of the doctoc 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::toc::DocTocProc {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::toc::_$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::toc::_$cmd $name] $args] 197} 198 199########################## 200# Method implementations follow (these are also private commands) 201 202# ::doctools::toc::_cget -- 203# 204# Retrieve the current value of a particular option 205# 206# Arguments: 207# name Name of the doctoc 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::toc::_cget {name option} { 214 _configure $name $option 215} 216 217# ::doctools::toc::_configure -- 218# 219# Configure a doctoc object, or query its configuration. 220# 221# Arguments: 222# name Name of the doctoc 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::toc::_configure {name args} { 231 if {[llength $args] == 0} { 232 # Retrieve the current configuration. 233 234 upvar #0 ::doctools::toc::doctoc${name}::file file 235 upvar #0 ::doctools::toc::doctoc${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::toc::doctoc${name}::file file 248 return $file 249 } 250 -format { 251 upvar #0 ::doctools::toc::doctoc${name}::format format 252 return $format 253 } 254 default { 255 return -code error \ 256 "doctools::toc::_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::toc::_configure name ?opt val...??" 265 } 266 267 foreach {option value} $args { 268 switch -exact -- $option { 269 -file { 270 upvar #0 ::doctools::toc::doctoc${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::toc::doctoc${name}::format format 278 set format $value 279 } msg]} { 280 return -code error "doctools::toc::_configure: -format: $msg" 281 } 282 } 283 default { 284 return -code error \ 285 "doctools::toc::_configure: Unknown option \"$option\", expected\ 286 -file, or -format" 287 } 288 } 289 } 290 } 291 return "" 292} 293 294# ::doctools::toc::_destroy -- 295# 296# Destroy a doctoc object, including its associated command and data storage. 297# 298# Arguments: 299# name Name of the doctoc object to destroy. 300# 301# Results: 302# None. 303 304proc ::doctools::toc::_destroy {name} { 305 # Check the object for sub objects which have to destroyed before 306 # the namespace is torn down. 307 namespace eval ::doctools::toc::doctoc$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 doctoc 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::toc::doctoc$name 320 interp alias {} ::$name {} 321 return 322} 323 324# ::doctools::toc::_map -- 325# 326# Add a mapping from symbolic to actual filename to the object. 327# 328# Arguments: 329# name Name of the doctoc object to use 330# sfname Symbolic filename to map 331# afname Actual filename 332# 333# Results: 334# None. 335 336proc ::doctools::toc::_map {name sfname afname} { 337 upvar #0 ::doctools::toc::doctoc${name}::map map 338 set map($sfname) $afname 339 return 340} 341 342# ::doctools::toc::_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 doctoc object to use 349# text Text to convert. 350# 351# Results: 352# The conversion result. 353 354proc ::doctools::toc::_format {name text} { 355 upvar #0 ::doctools::toc::doctoc${name}::format format 356 if {$format == ""} { 357 return -code error "$name: No format was specified" 358 } 359 360 upvar #0 ::doctools::toc::doctoc${name}::format_ip format_ip 361 upvar #0 ::doctools::toc::doctoc${name}::chk_ip chk_ip 362 upvar #0 ::doctools::toc::doctoc${name}::ex_ok ex_ok 363 upvar #0 ::doctools::toc::doctoc${name}::expander expander 364 upvar #0 ::doctools::toc::doctoc${name}::passes passes 365 upvar #0 ::doctools::toc::doctoc${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 toc_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 toc_setup $n]}]} { 385 catch {$format_ip eval toc_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 toc_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 "Doctoc $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 toc_postprocess $result]]}]} { 408 return -code error "Unable to post process final result" 409 } 410 if {[catch {$format_ip eval toc_shutdown}]} { 411 return -code error "Could not shut engine down" 412 } 413 return $result 414 415} 416 417# ::doctools::toc::_search -- 418# 419# Add a search path to the object. 420# 421# Arguments: 422# name Name of the doctoc object to extend 423# path Search path to add. 424# 425# Results: 426# None. 427 428proc ::doctools::toc::_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::toc::doctoc${name}::paths paths 434 set paths [linsert $paths 0 $path] 435 return 436} 437 438# ::doctools::toc::_warnings -- 439# 440# Return the warning accumulated during the last invocation of 'format'. 441# 442# Arguments: 443# name Name of the doctoc object to query 444# 445# Results: 446# A list of warnings. 447 448proc ::doctools::toc::_warnings {name} { 449 upvar #0 ::doctools::toc::doctoc${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::toc::_parameters {name} { 465 upvar #0 ::doctools::toc::doctoc${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::toc::_setparam {name param value} { 482 upvar #0 ::doctools::toc::doctoc${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 toc_varset $param $value] 490 return 491} 492 493########################## 494# Support commands 495 496# ::doctools::toc::LookupFormat -- 497# 498# Search a format definition file based upon its name 499# 500# Arguments: 501# name Name of the doctoc 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::toc::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::toc::doctoc${name}::paths opaths 519 foreach path $opaths { 520 set f [file join $path toc.$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 toc.$format] 529 if {[file exists $f]} { 530 return $f 531 } 532 } 533 534 return -code error "Unknown format \"$format\"" 535} 536 537# ::doctools::toc::SetupFormatter -- 538# 539# Create and initializes an interpreter containing a 540# formatting engine 541# 542# Arguments: 543# name Name of the doctoc object to manipulate 544# format Name of file containing the code of the engine 545# 546# Results: 547# None. 548 549proc ::doctools::toc::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_toc.tcl] 563 #$mpip eval [list source [file join $here api_toc.tcl]] 564 interp alias $mpip dt_source {} ::doctools::toc::Source $mpip [file dirname $format] 565 interp alias $mpip dt_read {} ::doctools::toc::Read $mpip [file dirname $format] 566 interp alias $mpip dt_package {} ::doctools::toc::Package $mpip 567 interp alias $mpip file {} ::doctools::toc::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 toc_numpasses 576 toc_initialize 577 toc_setup 578 toc_postprocess 579 toc_shutdown 580 toc_listvariables 581 toc_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 toc_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 toc_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::toc::doctoc${name}::formatfile formatfile 612 upvar #0 ::doctools::toc::doctoc${name}::format_ip format_ip 613 upvar #0 ::doctools::toc::doctoc${name}::chk_ip chk_ip 614 upvar #0 ::doctools::toc::doctoc${name}::expander expander 615 upvar #0 ::doctools::toc::doctoc${name}::passes xpasses 616 upvar #0 ::doctools::toc::doctoc${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::toc::GetFormat $name 627 interp alias $mpip dt_user {} ::doctools::toc::GetUser $name 628 interp alias $mpip dt_fmap {} ::doctools::toc::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::toc::SetupChecker -- 642# 643# Create and initializes an interpreter for checking the usage of 644# doctoc formatting commands 645# 646# Arguments: 647# name Name of the doctoc object to manipulate 648# 649# Results: 650# None. 651 652proc ::doctools::toc::SetupChecker {name} { 653 # Create an interpreter for checking the usage of doctoc 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::toc::doctoc${name}::chk_ip chk_ip 661 if {$chk_ip != ""} {return} 662 663 upvar #0 ::doctools::toc::doctoc${name}::expander expander 664 upvar #0 ::doctools::toc::doctoc${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::toc::$ckcmd $name 676 } 677 $chk_ip eval [list source [file join $here checker_toc.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 toc_begin toc_end division_start division_end item 691 comment plain_text 692 } { 693 interp alias $chk_ip fmt_$cmd $format_ip fmt_$cmd 694 } 695 return 696} 697 698# ::doctools::toc::SetupExpander -- 699# 700# Create and initializes the expander for input 701# 702# Arguments: 703# name Name of the doctoc object to manipulate 704# 705# Results: 706# None. 707 708proc ::doctools::toc::SetupExpander {name} { 709 upvar #0 ::doctools::toc::doctoc${name}::ex_ok ex_ok 710 if {$ex_ok} {return} 711 712 upvar #0 ::doctools::toc::doctoc${name}::expander expander 713 ::textutil::expander $expander 714 $expander evalcmd [list ::doctools::toc::Eval $name] 715 $expander textcmd plain_text 716 set ex_ok 1 717 return 718} 719 720# ::doctools::toc::SearchPaths -- 721# 722# API for checker. Returns list of search paths for format 723# definitions. Used to look for message catalogs as well. 724# 725# Arguments: 726# name Name of the doctoc object to query. 727# 728# Results: 729# None. 730 731proc ::doctools::toc::SearchPaths {name} { 732 upvar #0 ::doctools::toc::doctoc${name}::paths opaths 733 variable paths 734 735 set p $opaths 736 foreach s $paths {lappend p $s} 737 return $p 738} 739 740# ::doctools::toc::FmtError -- 741# 742# API for checker. Called when an error occurred. 743# 744# Arguments: 745# name Name of the doctoc object to query. 746# text Error message 747# 748# Results: 749# None. 750 751proc ::doctools::toc::FmtError {name text} { 752 return -code error "(FmtError) $text" 753} 754 755# ::doctools::toc::FmtWarning -- 756# 757# API for checker. Called when a warning was generated 758# 759# Arguments: 760# name Name of the doctoc object 761# text Warning message 762# 763# Results: 764# None. 765 766proc ::doctools::toc::FmtWarning {name text} { 767 upvar #0 ::doctools::toc::doctoc${name}::msg msg 768 lappend msg $text 769 return 770} 771 772# ::doctools::toc::Eval -- 773# 774# API for expander. Routes the macro invocations 775# into the checker interpreter 776# 777# Arguments: 778# name Name of the doctoc object to query. 779# 780# Results: 781# None. 782 783proc ::doctools::toc::Eval {name macro} { 784 upvar #0 ::doctools::toc::doctoc${name}::chk_ip chk_ip 785 786 # Handle the [include] command directly 787 if {[string match include* $macro]} { 788 set macro [$chk_ip eval [list subst $macro]] 789 foreach {cmd filename} $macro break 790 return [ExpandInclude $name $filename] 791 } 792 793 return [$chk_ip eval $macro] 794} 795 796# ::doctools::toc::ExpandInclude -- 797# 798# Handle inclusion of files. 799# 800# Arguments: 801# name Name of the doctoc object to query. 802# path Name of file to include and expand. 803# 804# Results: 805# None. 806 807proc ::doctools::toc::ExpandInclude {name path} { 808 # Look for the file relative to the directory of the 809 # main file we are converting. If that fails try to 810 # use the current working directory. Throw an error 811 # if the file couldn't be found. 812 813 upvar #0 ::doctools::toc::doctoc${name}::file file 814 815 set ipath [file normalize [file join [file dirname $file] $path]] 816 if {![file exists $ipath]} { 817 set ipath $path 818 if {![file exists $ipath]} { 819 return -code error "Unable to fine include file \"$path\"" 820 } 821 } 822 823 set chan [open $ipath r] 824 set text [read $chan] 825 close $chan 826 827 upvar #0 ::doctools::toc::doctoc${name}::expander expander 828 829 set saved $file 830 set file $ipath 831 set res [$expander expand $text] 832 set file $saved 833 834 return $res 835} 836 837# ::doctools::toc::GetUser -- 838# 839# API for formatter. Returns name of current user 840# 841# Arguments: 842# name Name of the doctoc object to query. 843# 844# Results: 845# String, name of current user. 846 847proc ::doctools::toc::GetUser {name} { 848 global tcl_platform 849 return $tcl_platform(user) 850} 851 852# ::doctools::toc::GetFormat -- 853# 854# API for formatter. Returns format information 855# 856# Arguments: 857# name Name of the doctoc object to query. 858# 859# Results: 860# Format information 861 862proc ::doctools::toc::GetFormat {name} { 863 upvar #0 ::doctools::toc::doctoc${name}::format format 864 return $format 865} 866 867# ::doctools::toc::MapFile -- 868# 869# API for formatter. Maps symbolic to actual filename in a toc 870# item. If no mapping is found it is assumed that the symbolic 871# name is also the actual name. 872# 873# Arguments: 874# name Name of the doctoc object to query. 875# fname Symbolic name of the file. 876# 877# Results: 878# Actual name of the file. 879 880proc ::doctools::toc::MapFile {name fname} { 881 upvar #0 ::doctools::toc::doctoc${name}::map map 882 if {[info exists map($fname)]} { 883 return $map($fname) 884 } 885 return $fname 886} 887 888# ::doctools::toc::Source -- 889# 890# API for formatter. Used by engine to ask for 891# additional script files support it. 892# 893# Arguments: 894# name Name of the doctoc object to change. 895# 896# Results: 897# Boolean flag. 898 899proc ::doctools::toc::Source {ip path file} { 900 $ip invokehidden source [file join $path [file tail $file]] 901 #$ip eval [list source [file join $path [file tail $file]]] 902 return 903} 904 905proc ::doctools::toc::Read {ip path file} { 906 #puts stderr "$ip (read $path $file)" 907 908 return [read [set f [open [file join $path [file tail $file]]]]][close $f] 909} 910 911proc ::doctools::toc::FileOp {ip args} { 912 #puts stderr "$ip (file $args)" 913 # -- FUTURE -- disallow unsafe operations -- 914 915 return [eval [linsert $args 0 file]] 916} 917 918proc ::doctools::toc::Package {ip pkg} { 919 #puts stderr "$ip package require $pkg" 920 921 set indexScript [Locate $pkg] 922 923 $ip expose source 924 $ip expose load 925 $ip eval $indexScript 926 $ip hide source 927 $ip hide load 928 #$ip eval [list source [file join $path [file tail $file]]] 929 return 930} 931 932proc ::doctools::toc::Locate {p} { 933 # @mdgen NODEP: doctools::__undefined__ 934 catch {package require doctools::__undefined__} 935 936 #puts stderr "auto_path = [join $::auto_path \n]" 937 938 # Check if requested package is in the list of loadable packages. 939 # Then get the highest possible version, and then the index script 940 941 if {[lsearch -exact [package names] $p] < 0} { 942 return -code error "Unknown package $p" 943 } 944 945 set v [lindex [lsort -increasing [package versions $p]] end] 946 947 #puts stderr "Package $p = $v" 948 949 return [package ifneeded $p $v] 950} 951 952#------------------------------------ 953# Module initialization 954 955namespace eval ::doctools::toc { 956 # Reverse order of searching. First to search is specified last. 957 958 # FOO/doctoc.tcl 959 # => FOO/mpformats 960 961 #catch {search [file join $here lib doctools mpformats]} 962 #catch {search [file join [file dirname $here] lib doctools mpformats]} 963 catch {search [file join $here mpformats]} 964} 965 966package provide doctools::toc 1.1.3 967