1# doctools.tcl -- 2# 3# Implementation of doctools 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: doctools.tcl,v 1.42 2010/07/06 18:49:15 andreas_kupries Exp $ 11 12package require Tcl 8.2 13package require textutil::expander 14 15# @mdgen OWNER: api.tcl 16# @mdgen OWNER: checker.tcl 17# @mdgen OWNER: mpformats/*.tcl 18# @mdgen OWNER: mpformats/*.msg 19# @mdgen OWNER: mpformats/fmt.* 20# @mdgen OWNER: mpformats/man.macros 21 22namespace eval ::doctools { 23 # Data storage in the doctools module 24 # ------------------------------- 25 # 26 # One namespace per object, containing 27 # 1) A list of additional search paths for format definition files. 28 # This list extends the list of standard paths known to the module. 29 # The paths in the list are searched before the standard paths. 30 # 2) Configuration information 31 # a) string: The format to use when converting the input. 32 # b) boolean: A flag telling us whether to warn when visual markup 33 # is used in the input, or not. 34 # c) File information associated with the input, if any. 35 # d) Module information associated with the input, if any. 36 # e) Copyright information, if any 37 # 4) Name of the interpreter used to perform the syntax check of the 38 # input (= allowed order of formatting commands). 39 # 5) Name of the interpreter containing the code coming from the format 40 # definition file. 41 # 6) Name of the expander object used to interpret the input to convert. 42 43 # commands is the list of subcommands recognized by the doctools objects 44 variable commands [list \ 45 "cget" \ 46 "configure" \ 47 "destroy" \ 48 "format" \ 49 "map" \ 50 "search" \ 51 "warnings" \ 52 "parameters" \ 53 "setparam" \ 54 ] 55 56 # Only export the toplevel commands 57 namespace export new search help 58 59 # Global data 60 61 # 1) List of standard paths to look at when searching for a format 62 # definition. Extensible. 63 # 2) Location of this file in the filesystem 64 65 variable paths [list] 66 variable here [file dirname [info script]] 67} 68 69# ::doctools::search -- 70# 71# Extend the list of paths used when searching for format definition files. 72# 73# Arguments: 74# path Path to add to the list. The path has to exist, has to be a 75# directory, and has to be readable. 76# 77# Results: 78# None. 79# 80# Sideeffects: 81# The specified path is added to the front of the list of search 82# paths. This means that the new path is search before the 83# standard paths set at module initialization time. 84 85proc ::doctools::search {path} { 86 variable paths 87 88 if {![file exists $path]} {return -code error "doctools::search: path does not exist"} 89 if {![file isdirectory $path]} {return -code error "doctools::search: path is not a directory"} 90 if {![file readable $path]} {return -code error "doctools::search: path cannot be read"} 91 92 set paths [linsert $paths 0 $path] 93 return 94} 95 96# ::doctools::help -- 97# 98# Return a string containing short help 99# regarding the existing formatting commands. 100# 101# Arguments: 102# None. 103# 104# Results: 105# A string. 106 107proc ::doctools::help {} { 108 return "formatting commands\n\ 109 * manpage_begin - begin of manpage\n\ 110 * moddesc - module description\n\ 111 * titledesc - manpage title\n\ 112 * copyright - copyright assignment\n\ 113 * manpage_end - end of manpage\n\ 114 * require - package requirement\n\ 115 * description - begin of manpage body\n\ 116 * section - begin new section of body\n\ 117 * subsection - begin new sub-section of body\n\ 118 * para - begin new paragraph\n\ 119 * list_begin - begin a list\n\ 120 * list_end - end of a list\n\ 121 * lst_item - begin item of definition list\n\ 122 * call - command definition, adds to synopsis\n\ 123 * usage - see above, without adding to synopsis\n\ 124 * bullet - begin item in bulleted list\n\ 125 * enum - begin item in enumerated list\n\ 126 * arg_def - begin item in argument list\n\ 127 * cmd_def - begin item in command list\n\ 128 * opt_def - begin item in option list\n\ 129 * tkoption_def - begin item in tkoption list\n\ 130 * example - example block\n\ 131 * example_begin - begin example\n\ 132 * example_end - end of example\n\ 133 * category - category declaration\n\ 134 * see_also - cross reference declaration\n\ 135 * keywords - keyword declaration\n\ 136 * nl - paragraph break in list items\n\ 137 * arg - semantic markup - argument\n\ 138 * cmd - semantic markup - command\n\ 139 * opt - semantic markup - optional data\n\ 140 * comment - semantic markup - comment\n\ 141 * sectref - semantic markup - section reference\n\ 142 * syscmd - semantic markup - system command\n\ 143 * method - semantic markup - object method\n\ 144 * namespace - semantic markup - namespace name\n\ 145 * option - semantic markup - option\n\ 146 * widget - semantic markup - widget\n\ 147 * fun - semantic markup - function\n\ 148 * type - semantic markup - data type\n\ 149 * package - semantic markup - package\n\ 150 * class - semantic markup - class\n\ 151 * var - semantic markup - variable\n\ 152 * file - semantic markup - file \n\ 153 * uri - semantic markup - uri (optional label)\n\ 154 * term - semantic markup - unspecific terminology\n\ 155 * const - semantic markup - constant value\n\ 156 * emph - emphasis\n\ 157 * strong - emphasis, deprecated, usage is discouraged\n\ 158 " 159} 160 161# ::doctools::new -- 162# 163# Create a new doctools object with a given name. May configure the object. 164# 165# Arguments: 166# name Name of the doctools object. 167# args Options configuring the new object. 168# 169# Results: 170# name Name of the doctools created 171 172proc ::doctools::new {name args} { 173 174 if { [llength [info commands ::$name]] } { 175 return -code error "command \"$name\" already exists, unable to create doctools object" 176 } 177 if {[llength $args] % 2 == 1} { 178 return -code error "wrong # args: doctools::new name ?opt val...??" 179 } 180 181 # The arguments seem to be ok, setup the namespace for the object 182 183 namespace eval ::doctools::doctools$name { 184 variable paths [list] 185 variable format "" 186 variable formatfile "" 187 variable deprecated 0 188 variable file "" 189 variable module "" 190 variable copyright "" 191 variable format_ip "" 192 variable chk_ip "" 193 variable expander "[namespace current]::ex" 194 variable ex_ok 0 195 variable msg [list] 196 variable param [list] 197 variable map ; array set map {} 198 } 199 200 # Create the command to manipulate the object 201 # $name -> ::doctools::DoctoolsProc $name 202 interp alias {} ::$name {} ::doctools::DoctoolsProc $name 203 204 # If the name was followed by arguments use them to configure the 205 # object before returning its handle to the caller. 206 207 if {[llength $args] > 1} { 208 # Use linsert trick to make the command a pure list. 209 eval [linsert $args 0 _configure $name] 210 } 211 return $name 212} 213 214########################## 215# Private functions follow 216 217# ::doctools::DoctoolsProc -- 218# 219# Command that processes all doctools object commands. 220# Dispatches any object command to the appropriate internal 221# command implementing its functionality. 222# 223# Arguments: 224# name Name of the doctools object to manipulate. 225# cmd Subcommand to invoke. 226# args Arguments for subcommand. 227# 228# Results: 229# Varies based on command to perform 230 231proc ::doctools::DoctoolsProc {name {cmd ""} args} { 232 # Do minimal args checks here 233 if { [llength [info level 0]] == 2 } { 234 error "wrong # args: should be \"$name option ?arg arg ...?\"" 235 } 236 237 # Split the args into command and args components 238 239 if { [llength [info commands ::doctools::_$cmd]] == 0 } { 240 variable commands 241 set optlist [join $commands ", "] 242 set optlist [linsert $optlist "end-1" "or"] 243 return -code error "bad option \"$cmd\": must be $optlist" 244 } 245 return [eval [list ::doctools::_$cmd $name] $args] 246} 247 248########################## 249# Method implementations follow (these are also private commands) 250 251# ::doctools::_cget -- 252# 253# Retrieve the current value of a particular option 254# 255# Arguments: 256# name Name of the doctools object to query 257# option Name of the option whose value we are asking for. 258# 259# Results: 260# The value of the option 261 262proc ::doctools::_cget {name option} { 263 _configure $name $option 264} 265 266# ::doctools::_configure -- 267# 268# Configure a doctools object, or query its configuration. 269# 270# Arguments: 271# name Name of the doctools object to configure 272# args Options and their values. 273# 274# Results: 275# None if configuring the object. 276# A list of all options and their values if called without arguments. 277# The value of one particular option if called with a single argument. 278 279proc ::doctools::_configure {name args} { 280 upvar #0 ::doctools::doctools${name}::format_ip format_ip 281 upvar #0 ::doctools::doctools${name}::chk_ip chk_ip 282 upvar #0 ::doctools::doctools${name}::expander expander 283 upvar #0 ::doctools::doctools${name}::passes passes 284 285 if {[llength $args] == 0} { 286 # Retrieve the current configuration. 287 288 upvar #0 ::doctools::doctools${name}::file file 289 upvar #0 ::doctools::doctools${name}::module module 290 upvar #0 ::doctools::doctools${name}::format format 291 upvar #0 ::doctools::doctools${name}::copyright copyright 292 upvar #0 ::doctools::doctools${name}::deprecated deprecated 293 294 set res [list] 295 lappend res -file $file 296 lappend res -module $module 297 lappend res -format $format 298 lappend res -copyright $copyright 299 lappend res -deprecated $deprecated 300 return $res 301 302 } elseif {[llength $args] == 1} { 303 # Query the value of one particular option. 304 305 switch -exact -- [lindex $args 0] { 306 -file { 307 upvar #0 ::doctools::doctools${name}::file file 308 return $file 309 } 310 -module { 311 upvar #0 ::doctools::doctools${name}::module module 312 return $module 313 } 314 -copyright { 315 upvar #0 ::doctools::doctools${name}::copyright copyright 316 return $copyright 317 } 318 -format { 319 upvar #0 ::doctools::doctools${name}::format format 320 return $format 321 } 322 -deprecated { 323 upvar #0 ::doctools::doctools${name}::deprecated deprecated 324 return $deprecated 325 } 326 default { 327 return -code error \ 328 "doctools::_configure: Unknown option \"[lindex $args 0]\", expected\ 329 -copyright, -file, -module, -format, or -deprecated" 330 } 331 } 332 } else { 333 # Reconfigure the object. 334 335 if {[llength $args] % 2 == 1} { 336 return -code error "wrong # args: doctools::_configure name ?opt val...??" 337 } 338 339 foreach {option value} $args { 340 switch -exact -- $option { 341 -file { 342 upvar #0 ::doctools::doctools${name}::file file 343 upvar #0 ::doctools::doctools${name}::mainfile mfile 344 set file $value 345 set mfile $value 346 } 347 -module { 348 upvar #0 ::doctools::doctools${name}::module module 349 set module $value 350 } 351 -copyright { 352 upvar #0 ::doctools::doctools${name}::copyright copyright 353 set copyright $value 354 } 355 -format { 356 if {[catch { 357 set fmtfile [LookupFormat $name $value] 358 SetupFormatter $name $fmtfile 359 upvar #0 ::doctools::doctools${name}::format format 360 set format $value 361 } msg]} { 362 return -code error "doctools::_configure: -format: $msg" 363 } 364 } 365 -deprecated { 366 if {![string is boolean $value]} { 367 return -code error \ 368 "doctools::_configure: -deprecated expected a boolean, got \"$value\"" 369 } 370 upvar #0 ::doctools::doctools${name}::deprecated deprecated 371 set deprecated $value 372 } 373 default { 374 return -code error \ 375 "doctools::_configure: Unknown option \"$option\", expected\ 376 -copyright, -file, -module, -format, or -deprecated" 377 } 378 } 379 } 380 } 381 return "" 382} 383 384# ::doctools::_destroy -- 385# 386# Destroy a doctools object, including its associated command and data storage. 387# 388# Arguments: 389# name Name of the doctools object to destroy. 390# 391# Results: 392# None. 393 394proc ::doctools::_destroy {name} { 395 # Check the object for sub objects which have to destroyed before 396 # the namespace is torn down. 397 namespace eval ::doctools::doctools$name { 398 if {$format_ip != ""} {interp delete $format_ip} 399 if {$chk_ip != ""} {interp delete $chk_ip} 400 401 # Expander objects have no delete/destroy method. This would 402 # be a leak if not for the fact that an expander object is a 403 # namespace, and we have arranged to make it a sub namespace of 404 # the doctools object. Therefore tearing down our object namespace 405 # also cleans up the expander object. 406 # if {$expander != ""} {$expander destroy} 407 408 } 409 namespace delete ::doctools::doctools$name 410 interp alias {} ::$name {} 411 return 412} 413 414# ::doctools::_map -- 415# 416# Add a mapping from symbolic to actual filename to the object. 417# 418# Arguments: 419# name Name of the doctools object to use 420# sfname Symbolic filename to map 421# afname Actual filename 422# 423# Results: 424# None. 425 426proc ::doctools::_map {name sfname afname} { 427 upvar #0 ::doctools::doctools${name}::map map 428 set map($sfname) $afname 429 return 430} 431 432# ::doctools::_img -- 433# 434 435# Add a mapping from symbolic to the actual image filenames to 436# the object. Two actual paths! The path the image is found at 437# in the input, and the path for where image is to be placed in 438# the output. 439# 440# Arguments: 441# name Name of the doctools object to use 442# sfname Symbolic filename to map 443# afnameo Actual filename, origin 444# afnamed Actual filename, destination 445# 446# Results: 447# None. 448 449proc ::doctools::_img {name sfname afnameo afnamed} { 450 upvar #0 ::doctools::doctools${name}::imap imap 451 set imap($sfname) [list $afnameo $afnamed] 452 return 453} 454 455# ::doctools::_format -- 456# 457# Convert some text in doctools format 458# according to the configuration in the object. 459# 460# Arguments: 461# name Name of the doctools object to use 462# text Text to convert. 463# 464# Results: 465# The conversion result. 466 467proc ::doctools::_format {name text} { 468 upvar #0 ::doctools::doctools${name}::format format 469 if {$format == ""} { 470 return -code error "$name: No format was specified" 471 } 472 473 upvar #0 ::doctools::doctools${name}::format_ip format_ip 474 upvar #0 ::doctools::doctools${name}::chk_ip chk_ip 475 upvar #0 ::doctools::doctools${name}::ex_ok ex_ok 476 upvar #0 ::doctools::doctools${name}::expander expander 477 upvar #0 ::doctools::doctools${name}::passes passes 478 upvar #0 ::doctools::doctools${name}::msg warnings 479 480 if {!$ex_ok} {SetupExpander $name} 481 if {$chk_ip == ""} {SetupChecker $name} 482 # assert (format_ip != "") 483 484 set warnings [list] 485 if {[catch {$format_ip eval fmt_initialize}]} { 486 return -code error "Could not initialize engine" 487 } 488 set result "" 489 490 for { 491 set p $passes ; set n 1 492 } { 493 $p > 0 494 } { 495 incr p -1 ; incr n 496 } { 497 if {[catch {$format_ip eval [list fmt_setup $n]}]} { 498 catch {$format_ip eval fmt_shutdown} 499 return -code error "Could not initialize pass $n of engine" 500 } 501 $chk_ip eval ck_initialize $n 502 503 if {[catch {set result [$expander expand $text]} msg]} { 504 catch {$format_ip eval fmt_shutdown} 505 # Filter for checker errors and reduce them to the essential message. 506 507 if {![regexp {^Error in} $msg]} {return -code error $msg} 508 #set msg [join [lrange [split $msg \n] 2 end]] 509 510 if {![regexp {^--> \(FmtError\) } $msg]} {return -code error "Doctools $msg"} 511 set msg [lindex [split $msg \n] 0] 512 regsub {^--> \(FmtError\) } $msg {} msg 513 514 return -code error $msg 515 } 516 517 $chk_ip eval ck_complete 518 } 519 520 if {[catch {set result [$format_ip eval [list fmt_postprocess $result]]}]} { 521 return -code error "Unable to post process final result" 522 } 523 if {[catch {$format_ip eval fmt_shutdown}]} { 524 return -code error "Could not shut engine down" 525 } 526 return $result 527 528} 529 530# ::doctools::_search -- 531# 532# Add a search path to the object. 533# 534# Arguments: 535# name Name of the doctools object to extend 536# path Search path to add. 537# 538# Results: 539# None. 540 541proc ::doctools::_search {name path} { 542 if {![file exists $path]} {return -code error "$name search: path does not exist"} 543 if {![file isdirectory $path]} {return -code error "$name search: path is not a directory"} 544 if {![file readable $path]} {return -code error "$name search: path cannot be read"} 545 546 upvar #0 ::doctools::doctools${name}::paths paths 547 set paths [linsert $paths 0 $path] 548 return 549} 550 551# ::doctools::_warnings -- 552# 553# Return the warning accumulated during the last invocation of 'format'. 554# 555# Arguments: 556# name Name of the doctools object to query 557# 558# Results: 559# A list of warnings. 560 561proc ::doctools::_warnings {name} { 562 upvar #0 ::doctools::doctools${name}::msg msg 563 return $msg 564} 565 566# ::doctools::_parameters -- 567# 568# Returns a list containing the parameters provided 569# by the selected formatting engine. 570# 571# Arguments: 572# name Name of the doctools object to query 573# 574# Results: 575# A list of parameter names 576 577proc ::doctools::_parameters {name} { 578 upvar #0 ::doctools::doctools${name}::param param 579 return $param 580} 581 582# ::doctools::_setparam -- 583# 584# Set a named engine parameter to a value. 585# 586# Arguments: 587# name Name of the doctools object to query 588# param Name of the parameter to set. 589# value Value to set the parameter to. 590# 591# Results: 592# None. 593 594proc ::doctools::_setparam {name param value} { 595 upvar #0 ::doctools::doctools${name}::format_ip format_ip 596 597 if {$format_ip == {}} { 598 return -code error \ 599 "Unable to set parameters without a valid format" 600 } 601 602 $format_ip eval [list fmt_varset $param $value] 603 return 604} 605 606########################## 607# Support commands 608 609# ::doctools::LookupFormat -- 610# 611# Search a format definition file based upon its name 612# 613# Arguments: 614# name Name of the doctools object to use 615# format Name of the format to look for. 616# 617# Results: 618# The file containing the format definition 619 620proc ::doctools::LookupFormat {name format} { 621 # Order of searching 622 # 1) Is the name of the format an existing file ? 623 # If yes, take this file. 624 # 2) Look for the file in the directories given to the object itself.. 625 # 3) Look for the file in the standard directories of this package. 626 627 if {[file exists $format]} { 628 return $format 629 } 630 631 upvar #0 ::doctools::doctools${name}::paths opaths 632 foreach path $opaths { 633 set f [file join $path fmt.$format] 634 if {[file exists $f]} { 635 return $f 636 } 637 } 638 639 variable paths 640 foreach path $paths { 641 set f [file join $path fmt.$format] 642 if {[file exists $f]} { 643 return $f 644 } 645 } 646 647 return -code error "Unknown format \"$format\"" 648} 649 650# ::doctools::SetupFormatter -- 651# 652# Create and initializes an interpreter containing a 653# formatting engine 654# 655# Arguments: 656# name Name of the doctools object to manipulate 657# format Name of file containing the code of the engine 658# 659# Results: 660# None. 661 662proc ::doctools::SetupFormatter {name format} { 663 664 # Create and initialize the interpreter first. 665 # Use a transient variable. Interrogate the 666 # engine and check its response. Bail out in 667 # case of errors. Only if we pass the checks 668 # we tear down the old engine and make the new 669 # one official. 670 671 variable here 672 set mpip [interp create -safe] ; # interpreter for the formatting engine 673 $mpip eval [list set auto_path $::auto_path] 674 #set mpip [interp create] ; # interpreter for the formatting engine 675 676 $mpip invokehidden source [file join $here api.tcl] 677 #$mpip eval [list source [file join $here api.tcl]] 678 interp alias $mpip dt_source {} ::doctools::Source $mpip [file dirname $format] 679 interp alias $mpip dt_read {} ::doctools::Read $mpip [file dirname $format] 680 interp alias $mpip dt_package {} ::doctools::Package $mpip 681 interp alias $mpip file {} ::doctools::FileOp $mpip 682 interp alias $mpip puts_stderr {} ::puts stderr 683 if {[info exists ::env(DOCTOOLS_NROFF_INCLUDE)]} { 684 interp alias $mpip get_nr_include {} ::doctools::get_nr_include 685 } 686 $mpip invokehidden source $format 687 #$mpip eval [list source $format] 688 689 # Check the engine for useability in doctools. 690 691 foreach api { 692 fmt_numpasses 693 fmt_initialize 694 fmt_setup 695 fmt_postprocess 696 fmt_shutdown 697 fmt_listvariables 698 fmt_varset 699 } { 700 if {[$mpip eval [list info commands $api]] == {}} { 701 interp delete $mpip 702 error "$format error: API incomplete, cannot use this engine" 703 } 704 } 705 if {[catch { 706 set passes [$mpip eval fmt_numpasses] 707 }]} { 708 interp delete $mpip 709 error "$format error: Unable to query for number of passes" 710 } 711 if {![string is integer $passes] || ($passes < 1)} { 712 interp delete $mpip 713 error "$format error: illegal number of passes \"$passes\"" 714 } 715 if {[catch { 716 set parameters [$mpip eval fmt_listvariables] 717 }]} { 718 interp delete $mpip 719 error "$format error: Unable to query for list of parameters" 720 } 721 722 # Passed the tests. Tear down existing engine, 723 # and checker. The latter is destroyed because 724 # of its aliases into the formatter, which are 725 # now invalid. It will be recreated during the 726 # next call of 'format'. 727 728 upvar #0 ::doctools::doctools${name}::formatfile formatfile 729 upvar #0 ::doctools::doctools${name}::format_ip format_ip 730 upvar #0 ::doctools::doctools${name}::chk_ip chk_ip 731 upvar #0 ::doctools::doctools${name}::expander expander 732 upvar #0 ::doctools::doctools${name}::passes xpasses 733 upvar #0 ::doctools::doctools${name}::param xparam 734 735 if {$chk_ip != {}} {interp delete $chk_ip} 736 if {$format_ip != {}} {interp delete $format_ip} 737 738 set chk_ip "" 739 set format_ip "" 740 741 # Now link engine API into it. 742 743 interp alias $mpip dt_file {} ::doctools::GetFile $name 744 interp alias $mpip dt_mainfile {} ::doctools::GetMainFile $name 745 interp alias $mpip dt_fileid {} ::doctools::GetFileId $name 746 interp alias $mpip dt_module {} ::doctools::GetModule $name 747 interp alias $mpip dt_copyright {} ::doctools::GetCopyright $name 748 interp alias $mpip dt_format {} ::doctools::GetFormat $name 749 interp alias $mpip dt_user {} ::doctools::GetUser $name 750 interp alias $mpip dt_lnesting {} ::doctools::ListLevel $name 751 interp alias $mpip dt_fmap {} ::doctools::MapFile $name 752 interp alias $mpip dt_imgsrc {} ::doctools::ImgSrc $name 753 interp alias $mpip dt_imgdst {} ::doctools::ImgDst $name 754 interp alias $mpip dt_imgdata {} ::doctools::ImgData $name 755 interp alias $mpip file {} ::doctools::FileCmd 756 757 foreach cmd {cappend cget cis cname cpop cpush ctopandclear cset lb rb} { 758 interp alias $mpip ex_$cmd {} $expander $cmd 759 } 760 761 set format_ip $mpip 762 set formatfile $format 763 set xpasses $passes 764 set xparam $parameters 765 return 766} 767 768# ::doctools::SetupChecker -- 769# 770# Create and initializes an interpreter for checking the usage of 771# doctools formatting commands 772# 773# Arguments: 774# name Name of the doctools object to manipulate 775# 776# Results: 777# None. 778 779proc ::doctools::SetupChecker {name} { 780 # Create an interpreter for checking the usage of doctools formatting commands 781 # and initialize it: Link it to the interpreter doing the formatting, the 782 # expander object and the configuration information. All of which 783 # is accessible through the token/handle (name of state/object array). 784 785 variable here 786 787 upvar #0 ::doctools::doctools${name}::chk_ip chk_ip 788 if {$chk_ip != ""} {return} 789 790 upvar #0 ::doctools::doctools${name}::expander expander 791 upvar #0 ::doctools::doctools${name}::format_ip format_ip 792 793 set chk_ip [interp create] ; # interpreter hosting the formal format checker 794 795 # Make configuration available through command, then load the code base. 796 797 foreach {cmd ckcmd} { 798 dt_search SearchPaths 799 dt_deprecated Deprecated 800 dt_error FmtError 801 dt_warning FmtWarning 802 dt_where Where 803 dt_file GetFile 804 } { 805 interp alias $chk_ip $cmd {} ::doctools::$ckcmd $name 806 } 807 $chk_ip eval [list source [file join $here checker.tcl]] 808 809 # Simple expander commands are directly routed back into it, no 810 # checking required. 811 812 foreach cmd {cappend cget cis cname cpop cpush ctopandclear cset lb rb} { 813 interp alias $chk_ip $cmd {} $expander $cmd 814 } 815 816 # Link the formatter commands into the checker. We use the prefix 817 # 'fmt_' to distinguish them from the checking commands. 818 819 foreach cmd { 820 manpage_begin moddesc titledesc copyright manpage_end require 821 description section para list_begin list_end lst_item call 822 bullet enum example example_begin example_end see_also 823 keywords nl arg cmd opt comment sectref syscmd method option 824 widget fun type package class var file uri usage term const 825 arg_def cmd_def opt_def tkoption_def emph strong plain_text 826 namespace subsection category image 827 } { 828 interp alias $chk_ip fmt_$cmd $format_ip fmt_$cmd 829 } 830 return 831} 832 833# ::doctools::SetupExpander -- 834# 835# Create and initializes the expander for input 836# 837# Arguments: 838# name Name of the doctools object to manipulate 839# 840# Results: 841# None. 842 843proc ::doctools::SetupExpander {name} { 844 upvar #0 ::doctools::doctools${name}::ex_ok ex_ok 845 if {$ex_ok} {return} 846 847 upvar #0 ::doctools::doctools${name}::expander expander 848 ::textutil::expander $expander 849 $expander evalcmd [list ::doctools::Eval $name] 850 $expander textcmd plain_text 851 set ex_ok 1 852 return 853} 854 855# ::doctools::SearchPaths -- 856# 857# API for checker. Returns list of search paths for format 858# definitions. Used to look for message catalogs as well. 859# 860# Arguments: 861# name Name of the doctools object to query. 862# 863# Results: 864# None. 865 866proc ::doctools::SearchPaths {name} { 867 upvar #0 ::doctools::doctools${name}::paths opaths 868 variable paths 869 870 set p $opaths 871 foreach s $paths {lappend p $s} 872 return $p 873} 874 875# ::doctools::Deprecated -- 876# 877# API for checker. Returns flag determining 878# whether visual markup is warned against, or not. 879# 880# Arguments: 881# name Name of the doctools object to query. 882# 883# Results: 884# None. 885 886proc ::doctools::Deprecated {name} { 887 upvar #0 ::doctools::doctools${name}::deprecated deprecated 888 return $deprecated 889} 890 891# ::doctools::FmtError -- 892# 893# API for checker. Called when an error occurred. 894# 895# Arguments: 896# name Name of the doctools object to query. 897# text Error message 898# 899# Results: 900# None. 901 902proc ::doctools::FmtError {name text} { 903 return -code error "(FmtError) $text" 904} 905 906# ::doctools::FmtWarning -- 907# 908# API for checker. Called when a warning was generated 909# 910# Arguments: 911# name Name of the doctools object 912# text Warning message 913# 914# Results: 915# None. 916 917proc ::doctools::FmtWarning {name text} { 918 upvar #0 ::doctools::doctools${name}::msg msg 919 lappend msg $text 920 return 921} 922 923# ::doctools::Where -- 924# 925# API for checker. Called when the current location is needed 926# 927# Arguments: 928# name Name of the doctools object 929# 930# Results: 931# List containing offset, line, column 932 933proc ::doctools::Where {name} { 934 upvar #0 ::doctools::doctools${name}::expander expander 935 return [$expander where] 936} 937 938# ::doctools::Eval -- 939# 940# API for expander. Routes the macro invocations 941# into the checker interpreter 942# 943# Arguments: 944# name Name of the doctools object to query. 945# 946# Results: 947# None. 948 949proc ::doctools::Eval {name macro} { 950 upvar #0 ::doctools::doctools${name}::chk_ip chk_ip 951 952 #puts stderr "\t\t$name [lindex [split $macro] 0]" 953 954 # Handle the [include] command directly 955 if {[string match include* $macro]} { 956 set macro [$chk_ip eval [list subst $macro]] 957 foreach {cmd filename} $macro break 958 return [ExpandInclude $name $filename] 959 } 960 961 # Rewrite the [namespace] command before passing it on. 962 # "namespace" is a special command. The interpreter the validator 963 # resides in uses the package "msgcat", which in turn uses the 964 # builtin namespace. So the builtin cannot be simply 965 # overwritten. We use a different name. 966 967 if {[string match namespace* $macro]} { 968 set macro _$macro 969 } 970 return [$chk_ip eval $macro] 971} 972 973# ::doctools::ExpandInclude -- 974# 975# Handle inclusion of files. 976# 977# Arguments: 978# name Name of the doctools object to query. 979# path Name of file to include and expand. 980# 981# Results: 982# None. 983 984proc ::doctools::ExpandInclude {name path} { 985 upvar #0 ::doctools::doctools${name}::file file 986 987 set ipath [file normalize [file join [file dirname $file] $path]] 988 989 if {![file exists $ipath]} { 990 set ipath $path 991 if {![file exists $ipath]} { 992 return -code error "Unable to find include file \"$path\"" 993 } 994 } 995 996 set chan [open $ipath r] 997 set text [read $chan] 998 close $chan 999 1000 upvar #0 ::doctools::doctools${name}::expander expander 1001 1002 set saved $file 1003 set file $ipath 1004 set res [$expander expand $text] 1005 set file $saved 1006 1007 return $res 1008} 1009 1010# ::doctools::GetUser -- 1011# 1012# API for formatter. Returns name of current user 1013# 1014# Arguments: 1015# name Name of the doctools object to query. 1016# 1017# Results: 1018# String, name of current user. 1019 1020proc ::doctools::GetUser {name} { 1021 global tcl_platform 1022 return $tcl_platform(user) 1023} 1024 1025# ::doctools::GetFile -- 1026# 1027# API for formatter. Returns file information 1028# 1029# Arguments: 1030# name Name of the doctools object to query. 1031# 1032# Results: 1033# File information 1034 1035proc ::doctools::GetFile {name} { 1036 1037 #puts stderr "GetFile $name" 1038 1039 upvar #0 ::doctools::doctools${name}::file file 1040 1041 #puts stderr "ok $file" 1042 return $file 1043} 1044 1045proc ::doctools::GetMainFile {name} { 1046 1047 #puts stderr "GetMainFile $name" 1048 1049 upvar #0 ::doctools::doctools${name}::mainfile mfile 1050 1051 #puts stderr "ok $mfile" 1052 return $mfile 1053} 1054 1055# ::doctools::GetFileId -- 1056# 1057# API for formatter. Returns file information (truncated to stem of filename) 1058# 1059# Arguments: 1060# name Name of the doctools object to query. 1061# 1062# Results: 1063# File information 1064 1065proc ::doctools::GetFileId {name} { 1066 return [file rootname [file tail [GetFile $name]]] 1067} 1068 1069# ::doctools::FileCmd -- 1070# 1071# API for formatter. Restricted implementation of file. 1072# 1073# Arguments: 1074# name Name of the doctools object to query. 1075# 1076# Results: 1077# Module information 1078 1079proc ::doctools::FileCmd {cmd args} { 1080 switch -exact -- $cmd { 1081 split {return [eval file split $args]} 1082 join {return [eval file join $args]} 1083 } 1084 return -code error "Illegal subcommand: $cmd $args" 1085} 1086 1087# ::doctools::GetModule -- 1088# 1089# API for formatter. Returns module information 1090# 1091# Arguments: 1092# name Name of the doctools object to query. 1093# 1094# Results: 1095# Module information 1096 1097proc ::doctools::GetModule {name} { 1098 upvar #0 ::doctools::doctools${name}::module module 1099 return $module 1100} 1101 1102# ::doctools::GetCopyright -- 1103# 1104# API for formatter. Returns copyright information 1105# 1106# Arguments: 1107# name Name of the doctools object to query. 1108# 1109# Results: 1110# Copyright information 1111 1112proc ::doctools::GetCopyright {name} { 1113 upvar #0 ::doctools::doctools${name}::copyright copyright 1114 return $copyright 1115} 1116 1117# ::doctools::GetFormat -- 1118# 1119# API for formatter. Returns format information 1120# 1121# Arguments: 1122# name Name of the doctools object to query. 1123# 1124# Results: 1125# Format information 1126 1127proc ::doctools::GetFormat {name} { 1128 upvar #0 ::doctools::doctools${name}::format format 1129 return $format 1130} 1131 1132# ::doctools::ListLevel -- 1133# 1134# API for formatter. Returns number of open lists 1135# 1136# Arguments: 1137# name Name of the doctools object to query. 1138# 1139# Results: 1140# Boolean flag. 1141 1142proc ::doctools::ListLevel {name} { 1143 upvar #0 ::doctools::doctools${name}::chk_ip chk_ip 1144 return [$chk_ip eval LNest] 1145} 1146 1147# ::doctools::MapFile -- 1148# 1149# API for formatter. Maps symbolic to actual filename in a doctools 1150# item. If no mapping is found it is assumed that the symbolic name 1151# is also the actual name. 1152# 1153# Arguments: 1154# name Name of the doctools object to query. 1155# fname Symbolic name of the file. 1156# 1157# Results: 1158# Actual name of the file. 1159 1160proc ::doctools::MapFile {name fname} { 1161 upvar #0 ::doctools::doctools${name}::map map 1162 1163 #parray map 1164 1165 if {[info exists map($fname)]} { 1166 return $map($fname) 1167 } 1168 return $fname 1169} 1170 1171# ::doctools::Img{Src,Dst} -- 1172# 1173# API for formatter. Maps symbolic to actual image in a doctools 1174# item. Returns nothing if no mapping is found. 1175# 1176# Arguments: 1177# name Name of the doctools object to query. 1178# iname Symbolic name of the image file. 1179# extensions List of acceptable file extensions. 1180# 1181# Results: 1182# Actual name of the file. 1183 1184proc ::doctools::ImgData {name iname extensions} { 1185 1186 # The system searches for the image relative to the current input 1187 # file, and the current main file 1188 1189 upvar #0 ::doctools::doctools${name}::imap imap 1190 1191 #parray imap 1192 1193 foreach e $extensions { 1194 if {[info exists imap($iname.$e)]} { 1195 foreach {origin dest} $imap($iname.$e) break 1196 1197 set f [open $origin r] 1198 set img [read $f] 1199 close $f 1200 1201 return $img 1202 } 1203 } 1204 return {} 1205} 1206 1207proc ::doctools::ImgSrc {name iname extensions} { 1208 1209 # The system searches for the image relative to the current input 1210 # file, and the current main file 1211 1212 upvar #0 ::doctools::doctools${name}::imap imap 1213 1214 #parray imap 1215 1216 foreach e $extensions { 1217 if {[info exists imap($iname.$e)]} { 1218 foreach {origin dest} $imap($iname.$e) break 1219 return $origin 1220 } 1221 } 1222 return {} 1223} 1224 1225proc ::doctools::ImgDst {name iname extensions} { 1226 # The system searches for the image relative to the current input 1227 # file, and the current main file 1228 1229 upvar #0 ::doctools::doctools${name}::imap imap 1230 1231 #parray imap 1232 1233 foreach e $extensions { 1234 if {[info exists imap($iname.$e)]} { 1235 foreach {origin dest} $imap($iname.$e) break 1236 file mkdir [file dirname $dest] 1237 file copy -force $origin $dest 1238 return $dest 1239 } 1240 } 1241 return {} 1242} 1243 1244# ::doctools::Source -- 1245# 1246# API for formatter. Used by engine to ask for 1247# additional script files support it. 1248# 1249# Arguments: 1250# name Name of the doctools object to change. 1251# 1252# Results: 1253# Boolean flag. 1254 1255proc ::doctools::Source {ip path file} { 1256 #puts stderr "$ip (source $path $file)" 1257 1258 $ip invokehidden source [file join $path [file tail $file]] 1259 #$ip eval [list source [file join $path [file tail $file]]] 1260 return 1261} 1262 1263proc ::doctools::Read {ip path file} { 1264 #puts stderr "$ip (read $path $file)" 1265 1266 return [read [set f [open [file join $path [file tail $file]]]]][close $f] 1267} 1268 1269proc ::doctools::Locate {p} { 1270 # @mdgen NODEP: doctools::__undefined__ 1271 catch {package require doctools::__undefined__} 1272 1273 #puts stderr "auto_path = [join $::auto_path \n]" 1274 1275 # Check if requested package is in the list of loadable packages. 1276 # Then get the highest possible version, and then the index script 1277 1278 if {[lsearch -exact [package names] $p] < 0} { 1279 return -code error "Unknown package $p" 1280 } 1281 1282 set v [lindex [lsort -increasing [package versions $p]] end] 1283 1284 #puts stderr "Package $p = $v" 1285 1286 return [package ifneeded $p $v] 1287} 1288 1289proc ::doctools::FileOp {ip args} { 1290 #puts stderr "$ip (file $args)" 1291 # -- FUTURE -- disallow unsafe operations -- 1292 1293 return [eval [linsert $args 0 file]] 1294} 1295 1296proc ::doctools::Package {ip pkg} { 1297 #puts stderr "$ip package require $pkg" 1298 1299 set indexScript [Locate $pkg] 1300 1301 $ip expose source 1302 $ip expose load 1303 $ip eval $indexScript 1304 $ip hide source 1305 $ip hide load 1306 #$ip eval [list source [file join $path [file tail $file]]] 1307 return 1308} 1309 1310if {[info exists ::env(DOCTOOLS_NROFF_INCLUDE)]} { 1311 proc ::doctools::get_nr_include {file} { 1312 set f [open [file join $::env(DOCTOOLS_NROFF_INCLUDE) $file]] 1313 set d [read $f]; close $f 1314 return "$d" 1315 } 1316} 1317 1318#------------------------------------ 1319# Module initialization 1320 1321namespace eval ::doctools { 1322 # Reverse order of searching. First to search is specified last. 1323 1324 # FOO/doctools.tcl 1325 # => FOO/mpformats 1326 1327 #catch {search [file join $here lib doctools mpformats]} 1328 #catch {search [file join [file dirname $here] lib doctools mpformats]} 1329 catch {search [file join $here mpformats]} 1330} 1331 1332package provide doctools 1.4.10 1333