This file is indexed.

/usr/bin/tcldocstrip is in tcllib 1.14-dfsg-1.

This file is owned by root:root, with mode 0o755.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
#! /bin/sh
# -*- tcl -*- \
exec tclsh "$0" ${1+"$@"}

# @@ Meta Begin
# Application tcldocstrip 1.0.1
# Meta platform     tcl
# Meta summary      TeX's docstrip written in Tcl
# Meta description  This application is an implementation
# Meta description  of TeX's docstrip application in Tcl.
# Meta description  It provides commands to convert a docstrip
# Meta description  weave according to a set of guards, to
# Meta description  assemble an output based on several sets
# Meta description  guards and input files, i.e. of a document
# Meta description  spread over several inputs and/or guards,
# Meta description  and to extract and list all unique guard
# Meta description  expressions found in a document.
# Meta category     Processing docstrip documents
# Meta subject      docstrip TeX LaTeX
# Meta require      docstrip
# Meta author       Andreas Kupries
# Meta license      BSD
# @@ Meta End

package provide tcldocstrip 1.0.1

# TODO __________________________
# Add handling of pre- and postambles.

# tcldocstrip - Docstrip written in Tcl
# =========== = =======================
#
# Use cases
# ---------
#
# (-)	Providing access to the functionality of the tcllib/docstrip
#	package from within shell and other scripts which are not Tcl.
#
# (1)	Conversion of a single input file according to the listed
#	guards into the stripped output.
#
#	This handles the most simple case of a set of guards
#	specifying a single document found in a single input file.
#
# (2)	Stitching, or the assembly of an output from several sets of
#	guards, in a specific order, and possibly from different
#	files. This is the second common case. One document spread
#	over several inputs, and/or spread over different guard sets.
#
# (3)	Extraction and listing of all the unique guard expressions and
#	guards used within a document to help a person which did not
#	author the document in question in familiarizing itself with
#	it.
# 
# Command syntax
# --------------
# 
# Ad 1)	tcldocstrip output|"-" ?options? input ?guards?
#
#	Converts the input file according to the specified guards and
#	options. The result is written to the named output. Usage of
#	the string "-" as output signals that the result should be
#	written to stdout. The guards are document-specific and have
#	to be known to the caller. The options are the same as
#	accepted by docstrip::extract.
#
#	-metaprefix string
#	-onerror    mode   {ignore,puts,throw}
#	-trimlines  bool
#
#	Additional options understood are
#
#	-premamble text
#	-postamble text
#	-nopremamble
#	-nopostamble
#
#	These are processed by the application itself. The -no*amble
#	options deactivate pre- and postambles altogether, whereas the
#	-*amble specify the _user_ part of pre- and postambles. This
#	part can be empty, in that case only the standard parts are
#	shown. This is the default.
#
# Ad 2)	tcldocstrip ?options? output|"-" (?options? input|"." guards)...
#
#	Extracts data from the various input files, according to the
#	specified options and guards, and writes the result to the
#	given output, in the order of their specification on the
#	command line. Options specified before the output are global
#	settings, whereas the options specified before each input are
#	valid only just for this input file. Unspecified values are
#	taken from the global settings. As in (1) "-" as output causes
#	the application to write to stdout. Using "." for an input
#	file signals that the last input file should be used
#	again. This enables the assembly of the output from one input
#	file using multiple and different sets of guards.
#
# Ad 3) tcldocstrip -guards input
#
#	Determines the guards, and unique guard expressions used
#	within the input document. The found strings are written to
#	stdout, one string per line.
#

lappend auto_path [file join [file dirname [file dirname [info script]]] modules]
package require docstrip

# ### ### ### ######### ######### #########
## Internal data and status

namespace eval ::tcldocstrip {

    # List of global options and their arguments found in the command
    # line. No checking was done on them, they are simply passed to
    # the extraction command.

    variable options {}

    # List of input specifications. Each element is a list specifying
    # the extraction options, input file, and guard set, in this
    # order.

    variable stitch {}

    # Name of the file to write to. "-" signals that output has to be
    # written to stdout.

    variable output {}

    # Mode of operation: Conversion, or guard retrieval

    variable mode Extract

    # The input file for guard retrieval mode.

    variable input {}

    # Standard preamble to preambles

    variable preamble {}
    append   preamble                                           \n
    append   preamble "This is file `@output@',"                \n
    append   preamble "generated with the tcldocstrip utility." \n
    append   preamble                                           \n
    append   preamble "The original source files were:"         \n
    append   preamble                                           \n
    append   preamble "@input@  (with options: `@guards@')"     \n
    append   preamble                                           \n

    # Standard postamble to postambles

    variable postamble {}
    append   postamble                           \n
    append   postamble                           \n
    append   postamble "End of file `@output@'."

    # Default values for the options which are relevant to the
    # application itself and thus have to be defined always.
    # They are processed as global options, as part of argv.

    variable defaults {-metaprefix {%} -preamble {} -postamble {}}
}

# ### ### ### ######### ######### #########
## External data and status
#
## This tool does not depend on external data and/or status.

# ### ### ### ######### ######### #########
## Option processing.
## Validate command line.
## Full command line syntax.
##
# tcldocstrip ?-option value...? input ?guard...?
##

proc ::tcldocstrip::processCmdline {} {
    global argv

    variable defaults
    variable preamble
    variable postamble
    variable options
    variable stitch
    variable output
    variable input
    variable mode

    # Process the options, perform basic validation.

    set optbuf    {}
    set stitchbuf {}
    set get output

    if {![llength $argv]} {
	set argv $defaults
    } else {
	set argv [eval [linsert $argv 0 linsert $defaults end]]
    }

    while {[llength $argv]} {
	set opt [lindex $argv 0]
	if {($opt eq "-") || ![string match "-*" $opt]} {
	    # Non option state machine. Output first. Then input and
	    # guards alternating.

	    set argv [lrange $argv 1 end]
	    switch -exact -- $get {
		output {
		    set output $opt
		    set get input
		}
		input {
		    lappend stitchbuf $optbuf $opt
		    set optbuf {}
		    set get guards
		}
		guards {
		    lappend stitchbuf $opt
		    set get input
		    lappend stitch $stitchbuf
		    set stitchbuf {}
		}
	    }
	    continue
	}

	switch -exact -- $opt {
	    -guards {
		if {
		    ($get ne "output") ||
		    ([llength $argv] != 2)
		} Usage

		set mode Guards
		set input [lindex $argv 1]
		break
	    }
	    -nopreamble -
	    -nopostamble {
		set o -[string range $opt 3 end]
		if {$get eq "output"} {
		    lappend options $o ""
		} else {
		    lappend optbuf  $o ""
		}
	    }
	    -preamble {
		set val $preamble[lindex $argv 1]
		if {$get eq "output"} {
		    lappend options $opt $val
		} else {
		    lappend optbuf  $opt $val
		}
		set argv [lrange $argv 2 end]
	    }
	    -postamble {
		set val [lindex $argv 1]$postamble
		if {$get eq "output"} {
		    lappend options $opt $val
		} else {
		    lappend optbuf  $opt $val
		}
		set argv [lrange $argv 2 end]
	    }
	    default {
		set val [lindex $argv 1]
		if {$get eq "output"} {
		    lappend options $opt $val
		} else {
		    lappend optbuf $opt $val
		}

		set argv [lrange $argv 2 end]
	    }
	}
    }

    if {$get eq "guards"} {
	# Complete last input spec, may have no guards.
	lappend stitchbuf {}
	lappend stitch $stitchbuf
	set stitchbuf {}
    }

    # Additional validation.

    if {$mode eq "Guards"} {
	CheckInput $input {Input path}
	return
    }

    if {![llength $stitch]} {
	Usage
    }

    set first 1
    foreach in $stitch {
	foreach {o i g} $in break
	if {$first || ($i ne ".")} {
	    # First input file must not be ".".
	    CheckInput $i {Input path}
	}
	set first 0
    }

    CheckTheOutput
    return
}

# ### ### ### ######### ######### #########
## Option processing.
## Helpers: Generation of error messages.
## I.  General usage/help message.
## II. Specific messages.
#
# Both write their messages to stderr and then
# exit the application with status 1.
##

proc ::tcldocstrip::Usage {} {
    global argv0
    puts stderr "$argv0: ?options? output (?options? input guards)..."
    puts stderr "$argv0: -guards input"
    exit 1
}

proc ::tcldocstrip::ArgError {text} {
    global argv0
    puts stderr "$argv0: $text"
    exit 1
}

proc in {list item} {
    expr {([lsearch -exact $list $item] >= 0)}
}

# ### ### ### ######### ######### #########
## Check existence and permissions of an input/output file or
## directory.

proc ::tcldocstrip::CheckInput {f label} {
    if {![file exists $f]} {
	ArgError "Unable to find $label \"$f\""
    } elseif {![file readable $f]} {
	ArgError "$label \"$f\" not readable (permission denied)"
    } elseif {![file isfile $f]} {
	ArgError "$label \"$f\" is not a file"
    }
    return
}

proc ::tcldocstrip::CheckTheOutput {} {
    variable output

    if {$output eq ""} {
	ArgError "No output path specified"
    } elseif {$output eq "-"} {
	# Stdout. This is ok.
	return
    }

    set base [file dirname $output]
    if {[string equal $base ""]} {set base [pwd]}

    if {![file exists $output]} {
	if {![file exists $base]} {
	    ArgError "Output base path \"$base\" not found"
	}
	if {![file writable $base]} {
	    ArgError "Output base path \"$base\" not writable (permission denied)"
	}
    } elseif {![file writable $output]} {
	ArgError "Output path \"$output\" not writable (permission denied)"
    } elseif {![file isfile $output]} {
	ArgError "Output path \"$output\" is not a file"
    }
    return
}

# ### ### ### ######### ######### #########
## Helper commands. File reading and writing.

proc ::tcldocstrip::Get {f} {
    variable data
    if {[info exists data($f)]} {return $data($f)}
    return [set data($f) [read [set in [open $f r]]][close $in]]
}

proc ::tcldocstrip::Write {f data} {
    puts -nonewline [set out [open $f w]] $data
    close $out
    return
}

proc ::tcldocstrip::WriteStdout {data} {
    puts -nonewline stdout $data
    return
}

# ### ### ### ######### ######### #########
## Helper commands. Guard extraction.

proc ::tcldocstrip::Guards {text} {
    array set g {}
    set verbatim 0
    set verbtag  {}
    foreach line [split $text \n] {
	if {$verbatim} {
	    # End of verbatim mode
	    if {$line eq $verbtag} {set verbatim 0}
	    continue
	}
	switch -glob -- $line {
	    %<<* {
		# Start of verbatim mode.
		set verbatim 1
		set verbtag %[string range $line 3 end]
		continue
	    }
	    %<* {
		if {![regexp -- {^%<([*/+-]?)([^>]*)>(.*)$} \
			  $line --> modifier expression line]} {
		    # Malformed guard. FUTURE Handle via -onerror. For now: ignore.
		    continue
		}
		# Remember the guard. Hashtable ensures that
		# duplicates are removed automatically.
		set g($expression) .
	    }
	    default {continue}
	}
    }
    return [array names g]
}


# ### ### ### ######### ######### #########
## Configuation phase, validate command line.

::tcldocstrip::processCmdline

# ### ### ### ######### ######### #########
## Commands implementing the main functionality.

proc ::tcldocstrip::Do.Extract {} {
    variable stitch
    variable output
    variable options

    set text ""

    foreach in $stitch {
	foreach {opt input guards} $in break

	# Merge defaults, global and local options, then filch the
	# options handled in the application.

	unset -nocomplain o
	array set o $options
	array set o $opt
	
	set pre ""
	if {[info exists o(-preamble)]} {
	    set pre $o(-preamble)
	    unset o(-preamble)
	}
	set post ""
	if {[info exists o(-postamble)]} {
	    set post $o(-postamble)
	    unset o(-postamble)
	}

	set opt [array get o]
	set c $o(-metaprefix)

	set pmap [list \
		      @output@ $output \
		      @input@  $input  \
		      @guards@ $guards \
		     ]

	if {$pre ne ""} {
	    append text $c $c " " [join [split [string map $pmap $pre]  \n] "\n$c$c "]
	}

	append text [eval [linsert $opt 0 docstrip::extract [Get $input] $guards]]

	if {$post ne ""} {
	    append text $c $c " " [join [split [string map $pmap $post] \n] "\n$c$c "]
	}   
    }

    if {$output eq "-"} {
	WriteStdout $text
    } else {
	Write $output $text
    }
    return
}

proc ::tcldocstrip::Do.Guards {} {
    variable input

    WriteStdout [join [lsort [Guards [Get $input]]] \n]
    return
}

# ### ### ### ######### ######### #########
## Invoking the functionality.

if {[catch {
    set mode $::tcldocstrip::mode
    ::tcldocstrip::Do.$mode
} msg]} {
    ## puts $::errorInfo
    ::tcldocstrip::ArgError $msg
}

# ### ### ### ######### ######### #########
exit

# Generic internal command for error handling. Factored out of the
# implementation of extract into its own command.

proc HandleError {text attr lineno} {
    variable O

    switch -- [string tolower $O(-onerror)] "puts" {
	puts stderr "docstrip: $text on line $lineno."
    } "ignore" {} default {
	return \
	    -code      error \
	    -errorinfo "" \
	    -errorcode [linsert $attr end $lineno] \
	    $text
    }
}