1#! /bin/sh 2# -*- tcl -*- \ 3exec tclsh "$0" ${1+"$@"} 4 5# @@ Meta Begin 6# Application tcldocstrip 1.0.1 7# Meta platform tcl 8# Meta summary TeX's docstrip written in Tcl 9# Meta description This application is an implementation 10# Meta description of TeX's docstrip application in Tcl. 11# Meta description It provides commands to convert a docstrip 12# Meta description weave according to a set of guards, to 13# Meta description assemble an output based on several sets 14# Meta description guards and input files, i.e. of a document 15# Meta description spread over several inputs and/or guards, 16# Meta description and to extract and list all unique guard 17# Meta description expressions found in a document. 18# Meta category Processing docstrip documents 19# Meta subject docstrip TeX LaTeX 20# Meta require docstrip 21# Meta author Andreas Kupries 22# Meta license BSD 23# @@ Meta End 24 25package provide tcldocstrip 1.0.1 26 27# TODO __________________________ 28# Add handling of pre- and postambles. 29 30# tcldocstrip - Docstrip written in Tcl 31# =========== = ======================= 32# 33# Use cases 34# --------- 35# 36# (-) Providing access to the functionality of the tcllib/docstrip 37# package from within shell and other scripts which are not Tcl. 38# 39# (1) Conversion of a single input file according to the listed 40# guards into the stripped output. 41# 42# This handles the most simple case of a set of guards 43# specifying a single document found in a single input file. 44# 45# (2) Stitching, or the assembly of an output from several sets of 46# guards, in a specific order, and possibly from different 47# files. This is the second common case. One document spread 48# over several inputs, and/or spread over different guard sets. 49# 50# (3) Extraction and listing of all the unique guard expressions and 51# guards used within a document to help a person which did not 52# author the document in question in familiarizing itself with 53# it. 54# 55# Command syntax 56# -------------- 57# 58# Ad 1) tcldocstrip output|"-" ?options? input ?guards? 59# 60# Converts the input file according to the specified guards and 61# options. The result is written to the named output. Usage of 62# the string "-" as output signals that the result should be 63# written to stdout. The guards are document-specific and have 64# to be known to the caller. The options are the same as 65# accepted by docstrip::extract. 66# 67# -metaprefix string 68# -onerror mode {ignore,puts,throw} 69# -trimlines bool 70# 71# Additional options understood are 72# 73# -premamble text 74# -postamble text 75# -nopremamble 76# -nopostamble 77# 78# These are processed by the application itself. The -no*amble 79# options deactivate pre- and postambles altogether, whereas the 80# -*amble specify the _user_ part of pre- and postambles. This 81# part can be empty, in that case only the standard parts are 82# shown. This is the default. 83# 84# Ad 2) tcldocstrip ?options? output|"-" (?options? input|"." guards)... 85# 86# Extracts data from the various input files, according to the 87# specified options and guards, and writes the result to the 88# given output, in the order of their specification on the 89# command line. Options specified before the output are global 90# settings, whereas the options specified before each input are 91# valid only just for this input file. Unspecified values are 92# taken from the global settings. As in (1) "-" as output causes 93# the application to write to stdout. Using "." for an input 94# file signals that the last input file should be used 95# again. This enables the assembly of the output from one input 96# file using multiple and different sets of guards. 97# 98# Ad 3) tcldocstrip -guards input 99# 100# Determines the guards, and unique guard expressions used 101# within the input document. The found strings are written to 102# stdout, one string per line. 103# 104 105lappend auto_path [file join [file dirname [file dirname [info script]]] modules] 106package require docstrip 107 108# ### ### ### ######### ######### ######### 109## Internal data and status 110 111namespace eval ::tcldocstrip { 112 113 # List of global options and their arguments found in the command 114 # line. No checking was done on them, they are simply passed to 115 # the extraction command. 116 117 variable options {} 118 119 # List of input specifications. Each element is a list specifying 120 # the extraction options, input file, and guard set, in this 121 # order. 122 123 variable stitch {} 124 125 # Name of the file to write to. "-" signals that output has to be 126 # written to stdout. 127 128 variable output {} 129 130 # Mode of operation: Conversion, or guard retrieval 131 132 variable mode Extract 133 134 # The input file for guard retrieval mode. 135 136 variable input {} 137 138 # Standard preamble to preambles 139 140 variable preamble {} 141 append preamble \n 142 append preamble "This is file `@output@'," \n 143 append preamble "generated with the tcldocstrip utility." \n 144 append preamble \n 145 append preamble "The original source files were:" \n 146 append preamble \n 147 append preamble "@input@ (with options: `@guards@')" \n 148 append preamble \n 149 150 # Standard postamble to postambles 151 152 variable postamble {} 153 append postamble \n 154 append postamble \n 155 append postamble "End of file `@output@'." 156 157 # Default values for the options which are relevant to the 158 # application itself and thus have to be defined always. 159 # They are processed as global options, as part of argv. 160 161 variable defaults {-metaprefix {%} -preamble {} -postamble {}} 162} 163 164# ### ### ### ######### ######### ######### 165## External data and status 166# 167## This tool does not depend on external data and/or status. 168 169# ### ### ### ######### ######### ######### 170## Option processing. 171## Validate command line. 172## Full command line syntax. 173## 174# tcldocstrip ?-option value...? input ?guard...? 175## 176 177proc ::tcldocstrip::processCmdline {} { 178 global argv 179 180 variable defaults 181 variable preamble 182 variable postamble 183 variable options 184 variable stitch 185 variable output 186 variable input 187 variable mode 188 189 # Process the options, perform basic validation. 190 191 set optbuf {} 192 set stitchbuf {} 193 set get output 194 195 if {![llength $argv]} { 196 set argv $defaults 197 } else { 198 set argv [eval [linsert $argv 0 linsert $defaults end]] 199 } 200 201 while {[llength $argv]} { 202 set opt [lindex $argv 0] 203 if {($opt eq "-") || ![string match "-*" $opt]} { 204 # Non option state machine. Output first. Then input and 205 # guards alternating. 206 207 set argv [lrange $argv 1 end] 208 switch -exact -- $get { 209 output { 210 set output $opt 211 set get input 212 } 213 input { 214 lappend stitchbuf $optbuf $opt 215 set optbuf {} 216 set get guards 217 } 218 guards { 219 lappend stitchbuf $opt 220 set get input 221 lappend stitch $stitchbuf 222 set stitchbuf {} 223 } 224 } 225 continue 226 } 227 228 switch -exact -- $opt { 229 -guards { 230 if { 231 ($get ne "output") || 232 ([llength $argv] != 2) 233 } Usage 234 235 set mode Guards 236 set input [lindex $argv 1] 237 break 238 } 239 -nopreamble - 240 -nopostamble { 241 set o -[string range $opt 3 end] 242 if {$get eq "output"} { 243 lappend options $o "" 244 } else { 245 lappend optbuf $o "" 246 } 247 } 248 -preamble { 249 set val $preamble[lindex $argv 1] 250 if {$get eq "output"} { 251 lappend options $opt $val 252 } else { 253 lappend optbuf $opt $val 254 } 255 set argv [lrange $argv 2 end] 256 } 257 -postamble { 258 set val [lindex $argv 1]$postamble 259 if {$get eq "output"} { 260 lappend options $opt $val 261 } else { 262 lappend optbuf $opt $val 263 } 264 set argv [lrange $argv 2 end] 265 } 266 default { 267 set val [lindex $argv 1] 268 if {$get eq "output"} { 269 lappend options $opt $val 270 } else { 271 lappend optbuf $opt $val 272 } 273 274 set argv [lrange $argv 2 end] 275 } 276 } 277 } 278 279 if {$get eq "guards"} { 280 # Complete last input spec, may have no guards. 281 lappend stitchbuf {} 282 lappend stitch $stitchbuf 283 set stitchbuf {} 284 } 285 286 # Additional validation. 287 288 if {$mode eq "Guards"} { 289 CheckInput $input {Input path} 290 return 291 } 292 293 if {![llength $stitch]} { 294 Usage 295 } 296 297 set first 1 298 foreach in $stitch { 299 foreach {o i g} $in break 300 if {$first || ($i ne ".")} { 301 # First input file must not be ".". 302 CheckInput $i {Input path} 303 } 304 set first 0 305 } 306 307 CheckTheOutput 308 return 309} 310 311# ### ### ### ######### ######### ######### 312## Option processing. 313## Helpers: Generation of error messages. 314## I. General usage/help message. 315## II. Specific messages. 316# 317# Both write their messages to stderr and then 318# exit the application with status 1. 319## 320 321proc ::tcldocstrip::Usage {} { 322 global argv0 323 puts stderr "$argv0: ?options? output (?options? input guards)..." 324 puts stderr "$argv0: -guards input" 325 exit 1 326} 327 328proc ::tcldocstrip::ArgError {text} { 329 global argv0 330 puts stderr "$argv0: $text" 331 exit 1 332} 333 334proc in {list item} { 335 expr {([lsearch -exact $list $item] >= 0)} 336} 337 338# ### ### ### ######### ######### ######### 339## Check existence and permissions of an input/output file or 340## directory. 341 342proc ::tcldocstrip::CheckInput {f label} { 343 if {![file exists $f]} { 344 ArgError "Unable to find $label \"$f\"" 345 } elseif {![file readable $f]} { 346 ArgError "$label \"$f\" not readable (permission denied)" 347 } elseif {![file isfile $f]} { 348 ArgError "$label \"$f\" is not a file" 349 } 350 return 351} 352 353proc ::tcldocstrip::CheckTheOutput {} { 354 variable output 355 356 if {$output eq ""} { 357 ArgError "No output path specified" 358 } elseif {$output eq "-"} { 359 # Stdout. This is ok. 360 return 361 } 362 363 set base [file dirname $output] 364 if {[string equal $base ""]} {set base [pwd]} 365 366 if {![file exists $output]} { 367 if {![file exists $base]} { 368 ArgError "Output base path \"$base\" not found" 369 } 370 if {![file writable $base]} { 371 ArgError "Output base path \"$base\" not writable (permission denied)" 372 } 373 } elseif {![file writable $output]} { 374 ArgError "Output path \"$output\" not writable (permission denied)" 375 } elseif {![file isfile $output]} { 376 ArgError "Output path \"$output\" is not a file" 377 } 378 return 379} 380 381# ### ### ### ######### ######### ######### 382## Helper commands. File reading and writing. 383 384proc ::tcldocstrip::Get {f} { 385 variable data 386 if {[info exists data($f)]} {return $data($f)} 387 return [set data($f) [read [set in [open $f r]]][close $in]] 388} 389 390proc ::tcldocstrip::Write {f data} { 391 puts -nonewline [set out [open $f w]] $data 392 close $out 393 return 394} 395 396proc ::tcldocstrip::WriteStdout {data} { 397 puts -nonewline stdout $data 398 return 399} 400 401# ### ### ### ######### ######### ######### 402## Helper commands. Guard extraction. 403 404proc ::tcldocstrip::Guards {text} { 405 array set g {} 406 set verbatim 0 407 set verbtag {} 408 foreach line [split $text \n] { 409 if {$verbatim} { 410 # End of verbatim mode 411 if {$line eq $verbtag} {set verbatim 0} 412 continue 413 } 414 switch -glob -- $line { 415 %<<* { 416 # Start of verbatim mode. 417 set verbatim 1 418 set verbtag %[string range $line 3 end] 419 continue 420 } 421 %<* { 422 if {![regexp -- {^%<([*/+-]?)([^>]*)>(.*)$} \ 423 $line --> modifier expression line]} { 424 # Malformed guard. FUTURE Handle via -onerror. For now: ignore. 425 continue 426 } 427 # Remember the guard. Hashtable ensures that 428 # duplicates are removed automatically. 429 set g($expression) . 430 } 431 default {continue} 432 } 433 } 434 return [array names g] 435} 436 437 438# ### ### ### ######### ######### ######### 439## Configuation phase, validate command line. 440 441::tcldocstrip::processCmdline 442 443# ### ### ### ######### ######### ######### 444## Commands implementing the main functionality. 445 446proc ::tcldocstrip::Do.Extract {} { 447 variable stitch 448 variable output 449 variable options 450 451 set text "" 452 453 foreach in $stitch { 454 foreach {opt input guards} $in break 455 456 # Merge defaults, global and local options, then filch the 457 # options handled in the application. 458 459 unset -nocomplain o 460 array set o $options 461 array set o $opt 462 463 set pre "" 464 if {[info exists o(-preamble)]} { 465 set pre $o(-preamble) 466 unset o(-preamble) 467 } 468 set post "" 469 if {[info exists o(-postamble)]} { 470 set post $o(-postamble) 471 unset o(-postamble) 472 } 473 474 set opt [array get o] 475 set c $o(-metaprefix) 476 477 set pmap [list \ 478 @output@ $output \ 479 @input@ $input \ 480 @guards@ $guards \ 481 ] 482 483 if {$pre ne ""} { 484 append text $c $c " " [join [split [string map $pmap $pre] \n] "\n$c$c "] 485 } 486 487 append text [eval [linsert $opt 0 docstrip::extract [Get $input] $guards]] 488 489 if {$post ne ""} { 490 append text $c $c " " [join [split [string map $pmap $post] \n] "\n$c$c "] 491 } 492 } 493 494 if {$output eq "-"} { 495 WriteStdout $text 496 } else { 497 Write $output $text 498 } 499 return 500} 501 502proc ::tcldocstrip::Do.Guards {} { 503 variable input 504 505 WriteStdout [join [lsort [Guards [Get $input]]] \n] 506 return 507} 508 509# ### ### ### ######### ######### ######### 510## Invoking the functionality. 511 512if {[catch { 513 set mode $::tcldocstrip::mode 514 ::tcldocstrip::Do.$mode 515} msg]} { 516 ## puts $::errorInfo 517 ::tcldocstrip::ArgError $msg 518} 519 520# ### ### ### ######### ######### ######### 521exit 522 523# Generic internal command for error handling. Factored out of the 524# implementation of extract into its own command. 525 526proc HandleError {text attr lineno} { 527 variable O 528 529 switch -- [string tolower $O(-onerror)] "puts" { 530 puts stderr "docstrip: $text on line $lineno." 531 } "ignore" {} default { 532 return \ 533 -code error \ 534 -errorinfo "" \ 535 -errorcode [linsert $attr end $lineno] \ 536 $text 537 } 538} 539