/usr/share/tcltk/tcllib1.14/docstrip/docstrip.tcl is in tcllib 1.14-dfsg-1.
This file is owned by root:root, with mode 0o644.
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 | ##
## This is the file `docstrip.tcl',
## generated with the SAK utility
## (sak docstrip/regen).
##
## The original source files were:
##
## tcldocstrip.dtx (with options: `pkg')
##
## In other words:
## **************************************
## * This Source is not the True Source *
## **************************************
## the true source is the file from which this one was generated.
##
package require Tcl 8.4
package provide docstrip 1.2
namespace eval docstrip {
namespace export extract sourcefrom
}
proc docstrip::extract {text terminals args} {
array set O {
-annotate 0
-metaprefix %%
-onerror throw
-trimlines 1
}
array set O $args
foreach t $terminals {set T($t) ""}
set stripped ""
set block_stack [list]
set offlevel 0
set verbatim 0
set lineno 0
foreach line [split $text \n] {
incr lineno
if {$O(-trimlines)} then {
set line [string trimright $line " "]
}
if {$verbatim} then {
if {$line eq $endverbline} then {
set verbatim 0
continue
} elseif {$offlevel} then {
continue
}
append stripped $line \n
if {$O(-annotate)>=1} then {append stripped {V "" ""} \n}
} else {
switch -glob -- $line %%* {
if {!$offlevel} then {
append stripped $O(-metaprefix)\
[string range $line 2 end] \n
if {$O(-annotate)>=1} then {
append stripped [list M %% $O(-metaprefix)] \n
}
}
} %<<* {
set endverbline "%[string range $line 3 end]"
set verbatim 1
continue
} %<* {
if {![
regexp -- {^%<([*/+-]?)([^>]*)>(.*)$} $line ""\
modifier expression line
]} then {
extract,error BADGUARD\
"Malformed guard \"\n$line\n\""
"Malformed guard on line $lineno"
continue
}
regsub -all -- {\\|\{|\}|\$|\[|\]| |;} $expression\
{\\&} E
regsub -all -- {,} $E {|} E
regsub -all -- {[^()|&!]+} $E {[info exists T(&)]} E
if {[catch {expr $E} val]} then {
extract,error EXPRERR\
"Error in expression <$expression> ignored"\
"docstrip: $val"
set val -1
}
switch -exact -- $modifier * {
lappend block_stack $expression
if {$offlevel || !$val} then {incr offlevel}
continue
} / {
if {![llength $block_stack]} then {
extract,error SPURIOUS\
"Spurious end block </$expression> ignored"\
"Spurious end block </$expression>"
} else {
if {[string compare $expression\
[lindex $block_stack end]]} then {
extract,error MISMATCH\
"Found </$expression> instead of\
</[lindex $block_stack end]>"
}
if {$offlevel} then {incr offlevel -1}
set block_stack [lreplace $block_stack end end]
}
continue
} - {
if {$offlevel || $val} then {continue}
append stripped $line \n
if {$O(-annotate)>=1} then {
append stripped [list - %<-${expression}> ""] \n
}
} default {
if {$offlevel || !$val} then {continue}
append stripped $line \n
if {$O(-annotate)>=1} then {
append stripped\
[list + %<${modifier}${expression}> ""] \n
}
}
} %* {continue}\
{\\endinput} {
break
} default {
if {$offlevel} then {continue}
append stripped $line \n
if {$O(-annotate)>=1} then {append stripped {. "" ""} \n}
}
}
if {$O(-annotate)>=2} then {append stripped $lineno \n}
if {$O(-annotate)>=3} then {append stripped $block_stack \n}
}
return $stripped
}
proc docstrip::extract,error {situation message {errmessage ""}} {
upvar 1 O(-onerror) onerror lineno lineno
switch -- [string tolower $onerror] "puts" {
puts stderr "docstrip: $message on line $lineno."
} "ignore" {} default {
if {$errmessage ne ""} then {
error $errmessage "" [list DOCSTRIP $situation $lineno]
} else {
error $message "" [list DOCSTRIP $situation $lineno]
}
}
}
proc docstrip::sourcefrom {name terminals args} {
set F [open $name r]
if {[llength $args]} then {
eval [linsert $args 0 fconfigure $F]
}
set text [read $F]
close $F
set oldscr [info script]
info script $name
set code [catch {
uplevel 1 [extract $text $terminals -metaprefix #]
} res]
info script $oldscr
if {$code == 1} then {
error $res $::errorInfo $::errorCode
} else {
return $res
}
}
##
##
## End of file `docstrip.tcl'.
|