diff --git a/src/bootsupport/modules/mime-1.7.0.tm b/src/bootsupport/modules/mime-1.7.0.tm new file mode 100644 index 0000000..fa46076 --- /dev/null +++ b/src/bootsupport/modules/mime-1.7.0.tm @@ -0,0 +1,3942 @@ +# mime.tcl - MIME body parts +# +# (c) 1999-2000 Marshall T. Rose +# (c) 2000 Brent Welch +# (c) 2000 Sandeep Tamhankar +# (c) 2000 Dan Kuchler +# (c) 2000-2001 Eric Melski +# (c) 2001 Jeff Hobbs +# (c) 2001-2008 Andreas Kupries +# (c) 2002-2003 David Welton +# (c) 2003-2008 Pat Thoyts +# (c) 2005 Benjamin Riefenstahl +# (c) 2013-2021 Poor Yorick +# +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# Influenced by Borenstein's/Rose's safe-tcl (circa 1993) and Darren New's +# unpublished package of 1999. +# + +# new string features and inline scan are used, requiring 8.3. +package require Tcl 8.5 + +package provide mime 1.7.0 +package require tcl::chan::memchan + + +if {[catch {package require Trf 2.0}]} { + + # Fall-back to tcl-based procedures of base64 and quoted-printable + # encoders + ## + # Warning! + ## + # These are a fragile emulations of the more general calling + # sequence that appears to work with this code here. + ## + # The `__ignored__` arguments are expected to be `--` options on + # the caller's side. (See the uses in `copymessageaux`, + # `buildmessageaux`, `parsepart`, and `getbody`). + + package require base64 2.0 + set ::major [lindex [split [package require md5] .] 0] + + # Create these commands in the mime namespace so that they + # won't collide with things at the global namespace level + + namespace eval ::mime { + proc base64 {-mode what __ignored__ chunk} { + return [base64::$what $chunk] + } + proc quoted-printable {-mode what __ignored__ chunk} { + return [mime::qp_$what $chunk] + } + + if {$::major < 2} { + # md5 v1, result is hex string ready for use. + proc md5 {__ignored__ string} { + return [md5::md5 $string] + } + } else { + # md5 v2, need option to get hex string + proc md5 {__ignored__ string} { + return [md5::md5 -hex $string] + } + } + } + + unset ::major +} + +# +# state variables: +# +# canonicalP: input is in its canonical form +# content: type/subtype +# params: dictionary (keys are lower-case) +# encoding: transfer encoding +# version: MIME-version +# header: dictionary (keys are lower-case) +# lowerL: list of header keys, lower-case +# mixedL: list of header keys, mixed-case +# value: either "file", "parts", or "string" +# +# file: input file +# fd: cached file-descriptor, typically for root +# root: token for top-level part, for (distant) subordinates +# offset: number of octets from beginning of file/string +# count: length in octets of (encoded) content +# +# parts: list of bodies (tokens) +# +# string: input string +# +# cid: last child-id assigned +# + + +namespace eval ::mime { + variable mime + array set mime {uid 0 cid 0} + + # RFC 822 lexemes + variable addrtokenL + lappend addrtokenL \; , < > : . ( ) @ \" \[ ] \\ + variable addrlexemeL { + LX_SEMICOLON LX_COMMA + LX_LBRACKET LX_RBRACKET + LX_COLON LX_DOT + LX_LPAREN LX_RPAREN + LX_ATSIGN LX_QUOTE + LX_LSQUARE LX_RSQUARE + LX_QUOTE + } + + # RFC 2045 lexemes + variable typetokenL + lappend typetokenL \; , < > : ? ( ) @ \" \[ \] = / \\ + variable typelexemeL { + LX_SEMICOLON LX_COMMA + LX_LBRACKET LX_RBRACKET + LX_COLON LX_QUESTION + LX_LPAREN LX_RPAREN + LX_ATSIGN LX_QUOTE + LX_LSQUARE LX_RSQUARE + LX_EQUALS LX_SOLIDUS + LX_QUOTE + } + + variable encList { + ascii US-ASCII + big5 Big5 + cp1250 Windows-1250 + cp1251 Windows-1251 + cp1252 Windows-1252 + cp1253 Windows-1253 + cp1254 Windows-1254 + cp1255 Windows-1255 + cp1256 Windows-1256 + cp1257 Windows-1257 + cp1258 Windows-1258 + cp437 IBM437 + cp737 {} + cp775 IBM775 + cp850 IBM850 + cp852 IBM852 + cp855 IBM855 + cp857 IBM857 + cp860 IBM860 + cp861 IBM861 + cp862 IBM862 + cp863 IBM863 + cp864 IBM864 + cp865 IBM865 + cp866 IBM866 + cp869 IBM869 + cp874 {} + cp932 {} + cp936 GBK + cp949 {} + cp950 {} + dingbats {} + ebcdic {} + euc-cn EUC-CN + euc-jp EUC-JP + euc-kr EUC-KR + gb12345 GB12345 + gb1988 GB1988 + gb2312 GB2312 + iso2022 ISO-2022 + iso2022-jp ISO-2022-JP + iso2022-kr ISO-2022-KR + iso8859-1 ISO-8859-1 + iso8859-2 ISO-8859-2 + iso8859-3 ISO-8859-3 + iso8859-4 ISO-8859-4 + iso8859-5 ISO-8859-5 + iso8859-6 ISO-8859-6 + iso8859-7 ISO-8859-7 + iso8859-8 ISO-8859-8 + iso8859-9 ISO-8859-9 + iso8859-10 ISO-8859-10 + iso8859-13 ISO-8859-13 + iso8859-14 ISO-8859-14 + iso8859-15 ISO-8859-15 + iso8859-16 ISO-8859-16 + jis0201 JIS_X0201 + jis0208 JIS_C6226-1983 + jis0212 JIS_X0212-1990 + koi8-r KOI8-R + koi8-u KOI8-U + ksc5601 KS_C_5601-1987 + macCentEuro {} + macCroatian {} + macCyrillic {} + macDingbats {} + macGreek {} + macIceland {} + macJapan {} + macRoman {} + macRomania {} + macThai {} + macTurkish {} + macUkraine {} + shiftjis Shift_JIS + symbol {} + tis-620 TIS-620 + unicode {} + utf-8 UTF-8 + } + + variable encodings + array set encodings $encList + variable reversemap + # Initialized at the bottom of the file + + variable encAliasList { + ascii ANSI_X3.4-1968 + ascii iso-ir-6 + ascii ANSI_X3.4-1986 + ascii ISO_646.irv:1991 + ascii ASCII + ascii ISO646-US + ascii us + ascii IBM367 + ascii cp367 + cp437 cp437 + cp437 437 + cp775 cp775 + cp850 cp850 + cp850 850 + cp852 cp852 + cp852 852 + cp855 cp855 + cp855 855 + cp857 cp857 + cp857 857 + cp860 cp860 + cp860 860 + cp861 cp861 + cp861 861 + cp861 cp-is + cp862 cp862 + cp862 862 + cp863 cp863 + cp863 863 + cp864 cp864 + cp865 cp865 + cp865 865 + cp866 cp866 + cp866 866 + cp869 cp869 + cp869 869 + cp869 cp-gr + cp936 CP936 + cp936 MS936 + cp936 Windows-936 + iso8859-1 ISO_8859-1:1987 + iso8859-1 iso-ir-100 + iso8859-1 ISO_8859-1 + iso8859-1 latin1 + iso8859-1 l1 + iso8859-1 IBM819 + iso8859-1 CP819 + iso8859-2 ISO_8859-2:1987 + iso8859-2 iso-ir-101 + iso8859-2 ISO_8859-2 + iso8859-2 latin2 + iso8859-2 l2 + iso8859-3 ISO_8859-3:1988 + iso8859-3 iso-ir-109 + iso8859-3 ISO_8859-3 + iso8859-3 latin3 + iso8859-3 l3 + iso8859-4 ISO_8859-4:1988 + iso8859-4 iso-ir-110 + iso8859-4 ISO_8859-4 + iso8859-4 latin4 + iso8859-4 l4 + iso8859-5 ISO_8859-5:1988 + iso8859-5 iso-ir-144 + iso8859-5 ISO_8859-5 + iso8859-5 cyrillic + iso8859-6 ISO_8859-6:1987 + iso8859-6 iso-ir-127 + iso8859-6 ISO_8859-6 + iso8859-6 ECMA-114 + iso8859-6 ASMO-708 + iso8859-6 arabic + iso8859-7 ISO_8859-7:1987 + iso8859-7 iso-ir-126 + iso8859-7 ISO_8859-7 + iso8859-7 ELOT_928 + iso8859-7 ECMA-118 + iso8859-7 greek + iso8859-7 greek8 + iso8859-8 ISO_8859-8:1988 + iso8859-8 iso-ir-138 + iso8859-8 ISO_8859-8 + iso8859-8 hebrew + iso8859-9 ISO_8859-9:1989 + iso8859-9 iso-ir-148 + iso8859-9 ISO_8859-9 + iso8859-9 latin5 + iso8859-9 l5 + iso8859-10 iso-ir-157 + iso8859-10 l6 + iso8859-10 ISO_8859-10:1992 + iso8859-10 latin6 + iso8859-14 iso-ir-199 + iso8859-14 ISO_8859-14:1998 + iso8859-14 ISO_8859-14 + iso8859-14 latin8 + iso8859-14 iso-celtic + iso8859-14 l8 + iso8859-15 ISO_8859-15 + iso8859-15 Latin-9 + iso8859-16 iso-ir-226 + iso8859-16 ISO_8859-16:2001 + iso8859-16 ISO_8859-16 + iso8859-16 latin10 + iso8859-16 l10 + jis0201 X0201 + jis0208 iso-ir-87 + jis0208 x0208 + jis0208 JIS_X0208-1983 + jis0212 x0212 + jis0212 iso-ir-159 + ksc5601 iso-ir-149 + ksc5601 KS_C_5601-1989 + ksc5601 KSC5601 + ksc5601 korean + shiftjis MS_Kanji + utf-8 UTF8 + } + + namespace export {*}{ + copymessage finalize getbody getheader getproperty initialize + mapencoding parseaddress parsedatetime reversemapencoding setheader + uniqueID + } +} + +# ::mime::initialize -- +# +# Creates a MIME part, and returnes the MIME token for that part. +# +# Arguments: +# args Args can be any one of the following: +# ?-canonical type/subtype +# ?-param {key value}?... +# ?-encoding value? +# ?-header {key value}?... ? +# (-file name | -string value | -parts {token1 ... tokenN}) +# +# If the -canonical option is present, then the body is in +# canonical (raw) form and is found by consulting either the -file, +# -string, or -parts option. +# +# In addition, both the -param and -header options may occur zero +# or more times to specify "Content-Type" parameters (e.g., +# "charset") and header keyword/values (e.g., +# "Content-Disposition"), respectively. +# +# Also, -encoding, if present, specifies the +# "Content-Transfer-Encoding" when copying the body. +# +# If the -canonical option is not present, then the MIME part +# contained in either the -file or the -string option is parsed, +# dynamically generating subordinates as appropriate. +# +# Results: +# An initialized mime token. + +proc ::mime::initialize args { + global errorCode errorInfo + + variable mime + + set token [namespace current]::[incr mime(uid)] + # FRINK: nocheck + variable $token + upvar 0 $token state + + if {[catch [list mime::initializeaux $token {*}$args] result eopts]} { + catch {mime::finalize $token -subordinates dynamic} + return -options $eopts $result + } + return $token +} + +# ::mime::initializeaux -- +# +# Configures the MIME token created in mime::initialize based on +# the arguments that mime::initialize supports. +# +# Arguments: +# token The MIME token to configure. +# args Args can be any one of the following: +# ?-canonical type/subtype +# ?-param {key value}?... +# ?-encoding value? +# ?-header {key value}?... ? +# (-file name | -string value | -parts {token1 ... tokenN}) +# +# Results: +# Either configures the mime token, or throws an error. + +proc ::mime::initializeaux {token args} { + global errorCode errorInfo + # FRINK: nocheck + variable $token + upvar 0 $token state + + array set params [set state(params) {}] + set state(encoding) {} + set state(version) 1.0 + + set state(header) {} + set state(lowerL) {} + set state(mixedL) {} + + set state(cid) 0 + + set userheader 0 + + set argc [llength $args] + for {set argx 0} {$argx < $argc} {incr argx} { + set option [lindex $args $argx] + if {[incr argx] >= $argc} { + error "missing argument to $option" + } + set value [lindex $args $argx] + + switch -- $option { + -canonical { + set state(content) [string tolower $value] + } + + -param { + if {[llength $value] != 2} { + error "-param expects a key and a value, not $value" + } + set lower [string tolower [set mixed [lindex $value 0]]] + if {[info exists params($lower)]} { + error "the $mixed parameter may be specified at most once" + } + + set params($lower) [lindex $value 1] + set state(params) [array get params] + } + + -encoding { + set value [string tolower $value[set value {}]] + + switch -- $value { + 7bit - 8bit - binary - quoted-printable - base64 { + } + + default { + error "unknown value for -encoding $state(encoding)" + } + } + set state(encoding) [string tolower $value] + } + + -header { + if {[llength $value] != 2} { + error "-header expects a key and a value, not $value" + } + set lower [string tolower [set mixed [lindex $value 0]]] + if {$lower eq {content-type}} { + error "use -canonical instead of -header $value" + } + if {$lower eq {content-transfer-encoding}} { + error "use -encoding instead of -header $value" + } + if {$lower in {content-md5 mime-version}} { + error {don't go there...} + } + if {$lower ni $state(lowerL)} { + lappend state(lowerL) $lower + lappend state(mixedL) $mixed + } + + set userheader 1 + + array set header $state(header) + lappend header($lower) [lindex $value 1] + set state(header) [array get header] + } + + -file { + set state(file) $value + } + + -parts { + set state(parts) $value + } + + -string { + set state(string) $value + + set state(lines) [split $value \n] + set state(lines.count) [llength $state(lines)] + set state(lines.current) 0 + } + + -root { + # the following are internal options + + set state(root) $value + } + + -offset { + set state(offset) $value + } + + -count { + set state(count) $value + } + + -lineslist { + set state(lines) $value + set state(lines.count) [llength $state(lines)] + set state(lines.current) 0 + #state(string) is needed, but will be built when required + set state(string) {} + } + + default { + error "unknown option $option" + } + } + } + + #We only want one of -file, -parts or -string: + set valueN 0 + foreach value {file parts string} { + if {[info exists state($value)]} { + set state(value) $value + incr valueN + } + } + if {$valueN != 1 && ![info exists state(lines)]} { + error {specify exactly one of -file, -parts, or -string} + } + + if {[set state(canonicalP) [info exists state(content)]]} { + switch -- $state(value) { + file { + set state(offset) 0 + } + + parts { + switch -glob -- $state(content) { + text/* + - + image/* + - + audio/* + - + video/* { + error "-canonical $state(content) and -parts do not mix" + } + + default { + if {$state(encoding) ne {}} { + error {-encoding and -parts do not mix} + } + } + } + } + default {# Go ahead} + } + + if {[lsearch -exact $state(lowerL) content-id] < 0} { + lappend state(lowerL) content-id + lappend state(mixedL) Content-ID + + array set header $state(header) + lappend header(content-id) [uniqueID] + set state(header) [array get header] + } + + set state(version) 1.0 + return + } + + if {$state(params) ne {}} { + error {-param requires -canonical} + } + if {$state(encoding) ne {}} { + error {-encoding requires -canonical} + } + if {$userheader} { + error {-header requires -canonical} + } + if {[info exists state(parts)]} { + error {-parts requires -canonical} + } + + if {[set fileP [info exists state(file)]]} { + if {[set openP [info exists state(root)]]} { + # FRINK: nocheck + variable $state(root) + upvar 0 $state(root) root + + set state(fd) $root(fd) + } else { + set state(root) $token + set state(fd) [open $state(file) RDONLY] + set state(offset) 0 + seek $state(fd) 0 end + set state(count) [tell $state(fd)] + + fconfigure $state(fd) -translation binary + } + } + + set code [catch {mime::parsepart $token} result] + set ecode $errorCode + set einfo $errorInfo + + if {$fileP} { + if {!$openP} { + unset state(root) + catch {close $state(fd)} + } + unset state(fd) + } + + return -code $code -errorinfo $einfo -errorcode $ecode $result +} + +# ::mime::parsepart -- +# +# Parses the MIME headers and attempts to break up the message +# into its various parts, creating a MIME token for each part. +# +# Arguments: +# token The MIME token to parse. +# +# Results: +# Throws an error if it has problems parsing the MIME token, +# otherwise it just sets up the appropriate variables. + +proc ::mime::parsepart {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + if {[set fileP [info exists state(file)]]} { + seek $state(fd) [set pos $state(offset)] start + set last [expr {$state(offset) + $state(count) - 1}] + } else { + set string $state(string) + } + + set vline {} + while 1 { + set blankP 0 + if {$fileP} { + if {($pos > $last) || ([set x [gets $state(fd) line]] <= 0)} { + set blankP 1 + } else { + incr pos [expr {$x + 1}] + } + } else { + if {$state(lines.current) >= $state(lines.count)} { + set blankP 1 + set line {} + } else { + set line [lindex $state(lines) $state(lines.current)] + incr state(lines.current) + set x [string length $line] + if {$x == 0} {set blankP 1} + } + } + + if {!$blankP && [string match *\r $line]} { + set line [string range $line 0 $x-2]] + if {$x == 1} { + set blankP 1 + } + } + + if {!$blankP && ( + [string first { } $line] == 0 + || + [string first \t $line] == 0 + )} { + append vline \n $line + continue + } + + if {$vline eq {}} { + if {$blankP} { + break + } + + set vline $line + continue + } + + if { + [set x [string first : $vline]] <= 0 + || + [set mixed [string trimright [ + string range $vline 0 [expr {$x - 1}]]]] eq {} + } { + error "improper line in header: $vline" + } + set value [string trim [string range $vline [expr {$x + 1}] end]] + switch -- [set lower [string tolower $mixed]] { + content-type { + if {[info exists state(content)]} { + error "multiple Content-Type fields starting with $vline" + } + + if {![catch {set x [parsetype $token $value]}]} { + set state(content) [lindex $x 0] + set state(params) [lindex $x 1] + } + } + + content-md5 { + } + + content-transfer-encoding { + if { + $state(encoding) ne {} + && + $state(encoding) ne [string tolower $value] + } { + error "multiple Content-Transfer-Encoding fields starting with $vline" + } + + set state(encoding) [string tolower $value] + } + + mime-version { + set state(version) $value + } + + default { + if {[lsearch -exact $state(lowerL) $lower] < 0} { + lappend state(lowerL) $lower + lappend state(mixedL) $mixed + } + + array set header $state(header) + lappend header($lower) $value + set state(header) [array get header] + } + } + + if {$blankP} { + break + } + set vline $line + } + + if {![info exists state(content)]} { + set state(content) text/plain + set state(params) [list charset us-ascii] + } + + if {![string match multipart/* $state(content)]} { + if {$fileP} { + set x [tell $state(fd)] + incr state(count) [expr {$state(offset) - $x}] + set state(offset) $x + } else { + # rebuild string, this is cheap and needed by other functions + set state(string) [join [ + lrange $state(lines) $state(lines.current) end] \n] + } + + if {[string match message/* $state(content)]} { + # FRINK: nocheck + variable [set child $token-[incr state(cid)]] + + set state(value) parts + set state(parts) $child + if {$fileP} { + mime::initializeaux $child \ + -file $state(file) -root $state(root) \ + -offset $state(offset) -count $state(count) + } else { + if {[info exists state(encoding)]} { + set strng [join [ + lrange $state(lines) $state(lines.current) end] \n] + switch -- $state(encoding) { + base64 - + quoted-printable { + set strng [$state(encoding) -mode decode -- $strng] + } + default {} + } + mime::initializeaux $child -string $strng + } else { + mime::initializeaux $child -lineslist [ + lrange $state(lines) $state(lines.current) end] + } + } + } + + return + } + + set state(value) parts + + set boundary {} + foreach {k v} $state(params) { + if {$k eq {boundary}} { + set boundary $v + break + } + } + if {$boundary eq {}} { + error "boundary parameter is missing in $state(content)" + } + if {[string trim $boundary] eq {}} { + error "boundary parameter is empty in $state(content)" + } + + if {$fileP} { + set pos [tell $state(fd)] + # This variable is like 'start', for the reasons laid out + # below, in the other branch of this conditional. + set initialpos $pos + } else { + # This variable is like 'start', a list of lines in the + # part. This record is made even before we find a starting + # boundary and used if we run into the terminating boundary + # before a starting boundary was found. In that case the lines + # before the terminator as recorded by tracelines are seen as + # the part, or at least we attempt to parse them as a + # part. See the forceoctet and nochild flags later. We cannot + # use 'start' as that records lines only after the starting + # boundary was found. + set tracelines [list] + } + + set inP 0 + set moreP 1 + set forceoctet 0 + while {$moreP} { + if {$fileP} { + if {$pos > $last} { + # We have run over the end of the part per the outer + # information without finding a terminating boundary. + # We now fake the boundary and force the parser to + # give any new part coming of this a mime-type of + # application/octet-stream regardless of header + # information. + set line "--$boundary--" + set x [string length $line] + set forceoctet 1 + } else { + if {[set x [gets $state(fd) line]] < 0} { + error "end-of-file encountered while parsing $state(content)" + } + } + incr pos [expr {$x + 1}] + } else { + if {$state(lines.current) >= $state(lines.count)} { + error "end-of-string encountered while parsing $state(content)" + } else { + set line [lindex $state(lines) $state(lines.current)] + incr state(lines.current) + set x [string length $line] + } + set x [string length $line] + } + if {[string last \r $line] == $x - 1} { + set line [string range $line 0 [expr {$x - 2}]] + set crlf 2 + } else { + set crlf 1 + } + + if {[string first --$boundary $line] != 0} { + if {$inP && !$fileP} { + lappend start $line + } + continue + } else { + lappend tracelines $line + } + + if {!$inP} { + # Haven't seen the starting boundary yet. Check if the + # current line contains this starting boundary. + + if {$line eq "--$boundary"} { + # Yes. Switch parser state to now search for the + # terminating boundary of the part and record where + # the part begins (or initialize the recorder for the + # lines in the part). + set inP 1 + if {$fileP} { + set start $pos + } else { + set start [list] + } + continue + } elseif {$line eq "--$boundary--"} { + # We just saw a terminating boundary before we ever + # saw the starting boundary of a part. This forces us + # to stop parsing, we do this by forcing the parser + # into an accepting state. We will try to create a + # child part based on faked start position or recorded + # lines, or, if that fails, let the current part have + # no children. + + # As an example note the test case mime-3.7 and the + # referenced file "badmail1.txt". + + set inP 1 + if {$fileP} { + set start $initialpos + } else { + set start $tracelines + } + set forceoctet 1 + # Fall through. This brings to the creation of the new + # part instead of searching further and possible + # running over the end. + } else { + continue + } + } + + # Looking for the end of the current part. We accept both a + # terminating boundary and the starting boundary of the next + # part as the end of the current part. + + if {[set moreP [string compare $line --$boundary--]] + && $line ne "--$boundary"} { + + # The current part has not ended, so we record the line + # if we are inside a part and doing string parsing. + if {$inP && !$fileP} { + lappend start $line + } + continue + } + + # The current part has ended. We now determine the exact + # boundaries, create a mime part object for it and recursively + # parse it deeper as part of that action. + + # FRINK: nocheck + variable [set child $token-[incr state(cid)]] + + lappend state(parts) $child + + set nochild 0 + if {$fileP} { + if {[set count [expr {$pos - ($start + $x + $crlf + 1)}]] < 0} { + set count 0 + } + if {$forceoctet} { + set ::errorInfo {} + if {[catch { + mime::initializeaux $child \ + -file $state(file) -root $state(root) \ + -offset $start -count $count + }]} { + set nochild 1 + set state(parts) [lrange $state(parts) 0 end-1] + } } else { + mime::initializeaux $child \ + -file $state(file) -root $state(root) \ + -offset $start -count $count + } + seek $state(fd) [set start $pos] start + } else { + if {$forceoctet} { + if {[catch { + mime::initializeaux $child -lineslist $start + }]} { + set nochild 1 + set state(parts) [lrange $state(parts) 0 end-1] + } + } else { + mime::initializeaux $child -lineslist $start + } + set start {} + } + if {$forceoctet && !$nochild} { + variable $child + upvar 0 $child childstate + set childstate(content) application/octet-stream + } + set forceoctet 0 + } +} + +# ::mime::parsetype -- +# +# Parses the string passed in and identifies the content-type and +# params strings. +# +# Arguments: +# token The MIME token to parse. +# string The content-type string that should be parsed. +# +# Results: +# Returns the content and params for the string as a two element +# tcl list. + +proc ::mime::parsetype {token string} { + global errorCode errorInfo + # FRINK: nocheck + variable $token + upvar 0 $token state + + variable typetokenL + variable typelexemeL + + set state(input) $string + set state(buffer) {} + set state(lastC) LX_END + set state(comment) {} + set state(tokenL) $typetokenL + set state(lexemeL) $typelexemeL + + set code [catch {mime::parsetypeaux $token $string} result] + set ecode $errorCode + set einfo $errorInfo + + unset {*}{ + state(input) + state(buffer) + state(lastC) + state(comment) + state(tokenL) + state(lexemeL) + } + + return -code $code -errorinfo $einfo -errorcode $ecode $result +} + +# ::mime::parsetypeaux -- +# +# A helper function for mime::parsetype. Parses the specified +# string looking for the content type and params. +# +# Arguments: +# token The MIME token to parse. +# string The content-type string that should be parsed. +# +# Results: +# Returns the content and params for the string as a two element +# tcl list. + +proc ::mime::parsetypeaux {token string} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + if {[parselexeme $token] ne {LX_ATOM}} { + error [format {expecting type (found %s)} $state(buffer)] + } + set type [string tolower $state(buffer)] + + switch -- [parselexeme $token] { + LX_SOLIDUS { + } + + LX_END { + if {$type ne {message}} { + error "expecting type/subtype (found $type)" + } + + return [list message/rfc822 {}] + } + + default { + error [format "expecting \"/\" (found %s)" $state(buffer)] + } + } + + if {[parselexeme $token] ne {LX_ATOM}} { + error [format "expecting subtype (found %s)" $state(buffer)] + } + append type [string tolower /$state(buffer)] + + array set params {} + while 1 { + switch -- [parselexeme $token] { + LX_END { + return [list $type [array get params]] + } + + LX_SEMICOLON { + } + + default { + error [format "expecting \";\" (found %s)" $state(buffer)] + } + } + + switch -- [parselexeme $token] { + LX_END { + return [list $type [array get params]] + } + + LX_ATOM { + } + + default { + error [format "expecting attribute (found %s)" $state(buffer)] + } + } + + set attribute [string tolower $state(buffer)] + + if {[parselexeme $token] ne {LX_EQUALS}} { + error [format {expecting "=" (found %s)} $state(buffer)] + } + + switch -- [parselexeme $token] { + LX_ATOM { + } + + LX_QSTRING { + set state(buffer) [ + string range $state(buffer) 1 [ + expr {[string length $state(buffer)] - 2}]] + } + + default { + error [format {expecting value (found %s)} $state(buffer)] + } + } + set params($attribute) $state(buffer) + } +} + +# ::mime::finalize -- +# +# mime::finalize destroys a MIME part. +# +# If the -subordinates option is present, it specifies which +# subordinates should also be destroyed. The default value is +# "dynamic". +# +# Arguments: +# token The MIME token to parse. +# args Args can be optionally be of the following form: +# ?-subordinates "all" | "dynamic" | "none"? +# +# Results: +# Returns an empty string. + +proc ::mime::finalize {token args} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + array set options [list -subordinates dynamic] + array set options $args + + switch -- $options(-subordinates) { + all { + #TODO: this code path is untested + if {$state(value) eq {parts}} { + foreach part $state(parts) { + eval [linsert $args 0 mime::finalize $part] + } + } + } + + dynamic { + for {set cid $state(cid)} {$cid > 0} {incr cid -1} { + eval [linsert $args 0 mime::finalize $token-$cid] + } + } + + none { + } + + default { + error "unknown value for -subordinates $options(-subordinates)" + } + } + + foreach name [array names state] { + unset state($name) + } + # FRINK: nocheck + unset $token +} + +# ::mime::getproperty -- +# +# mime::getproperty returns the properties of a MIME part. +# +# The properties are: +# +# property value +# ======== ===== +# content the type/subtype describing the content +# encoding the "Content-Transfer-Encoding" +# params a list of "Content-Type" parameters +# parts a list of tokens for the part's subordinates +# size the approximate size of the content (unencoded) +# +# The "parts" property is present only if the MIME part has +# subordinates. +# +# If mime::getproperty is invoked with the name of a specific +# property, then the corresponding value is returned; instead, if +# -names is specified, a list of all properties is returned; +# otherwise, a dictionary of properties is returned. +# +# Arguments: +# token The MIME token to parse. +# property One of 'content', 'encoding', 'params', 'parts', and +# 'size'. Defaults to returning a dictionary of +# properties. +# +# Results: +# Returns the properties of a MIME part + +proc ::mime::getproperty {token {property {}}} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + switch -- $property { + {} { + array set properties [list content $state(content) \ + encoding $state(encoding) \ + params $state(params) \ + size [getsize $token]] + if {[info exists state(parts)]} { + set properties(parts) $state(parts) + } + + return [array get properties] + } + + -names { + set names [list content encoding params] + if {[info exists state(parts)]} { + lappend names parts + } + + return $names + } + + content + - + encoding + - + params { + return $state($property) + } + + parts { + if {![info exists state(parts)]} { + error {MIME part is a leaf} + } + + return $state(parts) + } + + size { + return [getsize $token] + } + + default { + error "unknown property $property" + } + } +} + +# ::mime::getsize -- +# +# Determine the size (in bytes) of a MIME part/token +# +# Arguments: +# token The MIME token to parse. +# +# Results: +# Returns the size in bytes of the MIME token. + +proc ::mime::getsize {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + switch -- $state(value)/$state(canonicalP) { + file/0 { + set size $state(count) + } + + file/1 { + return [file size $state(file)] + } + + parts/0 + - + parts/1 { + set size 0 + foreach part $state(parts) { + incr size [getsize $part] + } + + return $size + } + + string/0 { + set size [string length $state(string)] + } + + string/1 { + return [string length $state(string)] + } + default { + error "Unknown combination \"$state(value)/$state(canonicalP)\"" + } + } + + if {$state(encoding) eq {base64}} { + set size [expr {($size * 3 + 2) / 4}] + } + + return $size +} + + +proc ::mime::getContentType token { + variable $token + upvar 0 $token state + set boundary {} + set res $state(content) + foreach {k v} $state(params) { + set boundary $v + append res ";\n $k=\"$v\"" + } + if {([string match multipart/* $state(content)]) \ + && ($boundary eq {})} { + # we're doing everything in one pass... + set key [clock seconds]$token[info hostname][array get state] + set seqno 8 + while {[incr seqno -1] >= 0} { + set key [md5 -- $key] + } + set boundary "----- =_[string trim [base64 -mode encode -- $key]]" + + append res ";\n boundary=\"$boundary\"" + } + return $res +} + +# ::mime::getheader -- +# +# mime::getheader returns the header of a MIME part. +# +# A header consists of zero or more key/value pairs. Each value is a +# list containing one or more strings. +# +# If mime::getheader is invoked with the name of a specific key, then +# a list containing the corresponding value(s) is returned; instead, +# if -names is specified, a list of all keys is returned; otherwise, a +# dictionary is returned. Note that when a +# key is specified (e.g., "Subject"), the list returned usually +# contains exactly one string; however, some keys (e.g., "Received") +# often occur more than once in the header, accordingly the list +# returned usually contains more than one string. +# +# Arguments: +# token The MIME token to parse. +# key Either a key or '-names'. If it is '-names' a list +# of all keys is returned. +# +# Results: +# Returns the header of a MIME part. + +proc ::mime::getheader {token {key {}}} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + array set header $state(header) + switch -- $key { + {} { + set result {} + lappend result MIME-Version $state(version) + foreach lower $state(lowerL) mixed $state(mixedL) { + foreach value $header($lower) { + lappend result $mixed $value + } + } + set tencoding [getTransferEncoding $token] + if {$tencoding ne {}} { + lappend result Content-Transfer-Encoding $tencoding + } + lappend result Content-Type [getContentType $token] + return $result + } + + -names { + return $state(mixedL) + } + + default { + set lower [string tolower $key] + + switch $lower { + content-transfer-encoding { + return [getTransferEncoding $token] + } + content-type { + return [list [getContentType $token]] + } + mime-version { + return [list $state(version)] + } + default { + if {![info exists header($lower)]} { + error "key $key not in header" + } + return $header($lower) + } + } + } + } +} + + +proc ::mime::getTransferEncoding token { + variable $token + upvar 0 $token state + set res {} + if {[set encoding $state(encoding)] eq {}} { + set encoding [encoding $token] + } + if {$encoding ne {}} { + set res $encoding + } + switch -- $encoding { + base64 + - + quoted-printable { + set converter $encoding + } + 7bit - 8bit - binary - {} { + # Bugfix for [#477088], also [#539952] + # Go ahead + } + default { + error "Can't handle content encoding \"$encoding\"" + } + } + return $res +} + +# ::mime::setheader -- +# +# mime::setheader writes, appends to, or deletes the value associated +# with a key in the header. +# +# The value for -mode is one of: +# +# write: the key/value is either created or overwritten (the +# default); +# +# append: a new value is appended for the key (creating it as +# necessary); or, +# +# delete: all values associated with the key are removed (the +# "value" parameter is ignored). +# +# Regardless, mime::setheader returns the previous value associated +# with the key. +# +# Arguments: +# token The MIME token to parse. +# key The name of the key whose value should be set. +# value The value for the header key to be set to. +# args An optional argument of the form: +# ?-mode "write" | "append" | "delete"? +# +# Results: +# Returns previous value associated with the specified key. + +proc ::mime::setheader {token key value args} { + # FRINK: nocheck + variable internal + variable $token + upvar 0 $token state + + array set options [list -mode write] + array set options $args + + set lower [string tolower $key] + array set header $state(header) + if {[set x [lsearch -exact $state(lowerL) $lower]] < 0} { + #TODO: this code path is not tested + if {$options(-mode) eq {delete}} { + error "key $key not in header" + } + + lappend state(lowerL) $lower + lappend state(mixedL) $key + + set result {} + } else { + set result $header($lower) + } + switch -- $options(-mode) { + append - write { + if {!$internal} { + switch -- $lower { + content-md5 + - + content-type + - + content-transfer-encoding + - + mime-version { + set values [getheader $token $lower] + if {$value ni $values} { + error "key $key may not be set" + } + } + default {# Skip key} + } + } + switch -- $options(-mode) { + append { + lappend header($lower) $value + } + write { + set header($lower) [list $value] + } + } + } + delete { + unset header($lower) + set state(lowerL) [lreplace $state(lowerL) $x $x] + set state(mixedL) [lreplace $state(mixedL) $x $x] + } + + default { + error "unknown value for -mode $options(-mode)" + } + } + + set state(header) [array get header] + return $result +} + +# ::mime::getbody -- +# +# mime::getbody returns the body of a leaf MIME part in canonical form. +# +# If the -command option is present, then it is repeatedly invoked +# with a fragment of the body as this: +# +# uplevel #0 $callback [list "data" $fragment] +# +# (The -blocksize option, if present, specifies the maximum size of +# each fragment passed to the callback.) +# When the end of the body is reached, the callback is invoked as: +# +# uplevel #0 $callback "end" +# +# Alternatively, if an error occurs, the callback is invoked as: +# +# uplevel #0 $callback [list "error" reason] +# +# Regardless, the return value of the final invocation of the callback +# is propagated upwards by mime::getbody. +# +# If the -command option is absent, then the return value of +# mime::getbody is a string containing the MIME part's entire body. +# +# Arguments: +# token The MIME token to parse. +# args Optional arguments of the form: +# ?-decode? ?-command callback ?-blocksize octets? ? +# +# Results: +# Returns a string containing the MIME part's entire body, or +# if '-command' is specified, the return value of the command +# is returned. + +proc ::mime::getbody {token args} { + global errorCode errorInfo + # FRINK: nocheck + variable $token + upvar 0 $token state + + set decode 0 + if {[set pos [lsearch -exact $args -decode]] >= 0} { + set decode 1 + set args [lreplace $args $pos $pos] + } + + array set options [list -command [ + list mime::getbodyaux $token] -blocksize 4096] + array set options $args + if {$options(-blocksize) < 1} { + error "-blocksize expects a positive integer, not $options(-blocksize)" + } + + set code 0 + set ecode {} + set einfo {} + + switch -- $state(value)/$state(canonicalP) { + file/0 { + set fd [open $state(file) RDONLY] + + set code [catch { + fconfigure $fd -translation binary + seek $fd [set pos $state(offset)] start + set last [expr {$state(offset) + $state(count) - 1}] + + set fragment {} + while {$pos <= $last} { + if {[set cc [ + expr {($last - $pos) + 1}]] > $options(-blocksize)} { + set cc $options(-blocksize) + } + incr pos [set len [ + string length [set chunk [read $fd $cc]]]] + switch -exact -- $state(encoding) { + base64 + - + quoted-printable { + if {([set x [string last \n $chunk]] > 0) \ + && ($x + 1 != $len)} { + set chunk [string range $chunk 0 $x] + seek $fd [incr pos [expr {($x + 1) - $len}]] start + } + set chunk [ + $state(encoding) -mode decode -- $chunk] + } + 7bit - 8bit - binary - {} { + # Bugfix for [#477088] + # Go ahead, leave chunk alone + } + default { + error "Can't handle content encoding \"$state(encoding)\"" + } + } + append fragment $chunk + + set cc [expr {$options(-blocksize) - 1}] + while {[string length $fragment] > $options(-blocksize)} { + uplevel #0 $options(-command) [ + list data [string range $fragment 0 $cc]] + + set fragment [ + string range $fragment $options(-blocksize) end] + } + } + if {[string length $fragment] > 0} { + uplevel #0 $options(-command) [list data $fragment] + } + } result] + set ecode $errorCode + set einfo $errorInfo + + catch {close $fd} + } + + file/1 { + set fd [open $state(file) RDONLY] + + set code [catch { + fconfigure $fd -translation binary + + while {[string length [ + set fragment [read $fd $options(-blocksize)]]] > 0} { + uplevel #0 $options(-command) [list data $fragment] + } + } result] + set ecode $errorCode + set einfo $errorInfo + + catch {close $fd} + } + + parts/0 + - + parts/1 { + error {MIME part isn't a leaf} + } + + string/0 + - + string/1 { + switch -- $state(encoding)/$state(canonicalP) { + base64/0 + - + quoted-printable/0 { + set fragment [ + $state(encoding) -mode decode -- $state(string)] + } + + default { + # Not a bugfix for [#477088], but clarification + # This handles no-encoding, 7bit, 8bit, and binary. + set fragment $state(string) + } + } + + set code [catch { + set cc [expr {$options(-blocksize) -1}] + while {[string length $fragment] > $options(-blocksize)} { + uplevel #0 $options(-command) [ + list data [string range $fragment 0 $cc]] + + set fragment [ + string range $fragment $options(-blocksize) end] + } + if {[string length $fragment] > 0} { + uplevel #0 $options(-command) [list data $fragment] + } + } result] + set ecode $errorCode + set einfo $errorInfo + } + default { + error "Unknown combination \"$state(value)/$state(canonicalP)\"" + } + } + + set code [catch { + if {$code} { + uplevel #0 $options(-command) [list error $result] + } else { + uplevel #0 $options(-command) [list end] + } + } result] + set ecode $errorCode + set einfo $errorInfo + + if {$code} { + return -code $code -errorinfo $einfo -errorcode $ecode $result + } + + if {$decode} { + array set params [mime::getproperty $token params] + + if {[info exists params(charset)]} { + set charset $params(charset) + } else { + set charset US-ASCII + } + + set enc [reversemapencoding $charset] + if {$enc ne {}} { + set result [::encoding convertfrom $enc $result] + } else { + return -code error "-decode failed: can't reversemap charset $charset" + } + } + + return $result +} + +# ::mime::getbodyaux -- +# +# Builds up the body of the message, fragment by fragment. When +# the entire message has been retrieved, it is returned. +# +# Arguments: +# token The MIME token to parse. +# reason One of 'data', 'end', or 'error'. +# fragment The section of data data fragment to extract a +# string from. +# +# Results: +# Returns nothing, except when called with the 'end' argument +# in which case it returns a string that contains all of the +# data that 'getbodyaux' has been called with. Will throw an +# error if it is called with the reason of 'error'. + +proc ::mime::getbodyaux {token reason {fragment {}}} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + switch $reason { + data { + append state(getbody) $fragment + return {} + } + + end { + if {[info exists state(getbody)]} { + set result $state(getbody) + unset state(getbody) + } else { + set result {} + } + + return $result + } + + error { + catch {unset state(getbody)} + error $reason + } + + default { + error "Unknown reason \"$reason\"" + } + } +} + +# ::mime::copymessage -- +# +# mime::copymessage copies the MIME part to the specified channel. +# +# mime::copymessage operates synchronously, and uses fileevent to +# allow asynchronous operations to proceed independently. +# +# Arguments: +# token The MIME token to parse. +# channel The channel to copy the message to. +# +# Results: +# Returns nothing unless an error is thrown while the message +# is being written to the channel. + +proc ::mime::copymessage {token channel} { + global errorCode errorInfo + # FRINK: nocheck + variable $token + upvar 0 $token state + + set openP [info exists state(fd)] + + set code [catch {mime::copymessageaux $token $channel} result] + set ecode $errorCode + set einfo $errorInfo + + if {!$openP && [info exists state(fd)]} { + if {![info exists state(root)]} { + catch {close $state(fd)} + } + unset state(fd) + } + + return -code $code -errorinfo $einfo -errorcode $ecode $result +} + +# ::mime::copymessageaux -- +# +# mime::copymessageaux copies the MIME part to the specified channel. +# +# Arguments: +# token The MIME token to parse. +# channel The channel to copy the message to. +# +# Results: +# Returns nothing unless an error is thrown while the message +# is being written to the channel. + +proc ::mime::copymessageaux {token channel} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + array set header $state(header) + + set boundary {} + + set result {} + foreach {mixed value} [getheader $token] { + puts $channel "$mixed: $value" + } + + foreach {k v} $state(params) { + if {$k eq {boundary}} { + set boundary $v + } + } + + set converter {} + set encoding {} + if {$state(value) ne {parts}} { + if {$state(canonicalP)} { + if {[set encoding $state(encoding)] eq {}} { + set encoding [encoding $token] + } + if {$encoding ne {}} { + puts $channel "Content-Transfer-Encoding: $encoding" + } + switch -- $encoding { + base64 + - + quoted-printable { + set converter $encoding + } + 7bit - 8bit - binary - {} { + # Bugfix for [#477088], also [#539952] + # Go ahead + } + default { + error "Can't handle content encoding \"$encoding\"" + } + } + } + } elseif {([string match multipart/* $state(content)]) \ + && ($boundary eq {})} { + # we're doing everything in one pass... + set key [clock seconds]$token[info hostname][array get state] + set seqno 8 + while {[incr seqno -1] >= 0} { + set key [md5 -- $key] + } + set boundary "----- =_[string trim [base64 -mode encode -- $key]]" + + puts $channel ";\n boundary=\"$boundary\"" + } + + if {[info exists state(error)]} { + unset state(error) + } + + switch -- $state(value) { + file { + set closeP 1 + if {[info exists state(root)]} { + # FRINK: nocheck + variable $state(root) + upvar 0 $state(root) root + + if {[info exists root(fd)]} { + set fd $root(fd) + set closeP 0 + } else { + set fd [set state(fd) [open $state(file) RDONLY]] + } + set size $state(count) + } else { + set fd [set state(fd) [open $state(file) RDONLY]] + # read until eof + set size -1 + } + seek $fd $state(offset) start + if {$closeP} { + fconfigure $fd -translation binary + } + + puts $channel {} + + while {$size != 0 && ![eof $fd]} { + if {$size < 0 || $size > 32766} { + set X [read $fd 32766] + } else { + set X [read $fd $size] + } + if {$size > 0} { + set size [expr {$size - [string length $X]}] + } + if {$converter eq {}} { + puts -nonewline $channel $X + } else { + puts -nonewline $channel [$converter -mode encode -- $X] + } + } + + if {$closeP} { + catch {close $state(fd)} + unset state(fd) + } + } + + parts { + if { + ![info exists state(root)] + && + [info exists state(file)] + } { + set state(fd) [open $state(file) RDONLY] + fconfigure $state(fd) -translation binary + } + + switch -glob -- $state(content) { + message/* { + puts $channel {} + foreach part $state(parts) { + mime::copymessage $part $channel + break + } + } + + default { + # Note RFC 2046: See buildmessageaux for details. + # + # The boundary delimiter MUST occur at the + # beginning of a line, i.e., following a CRLF, and + # the initial CRLF is considered to be attached to + # the boundary delimiter line rather than part of + # the preceding part. + # + # - The above means that the CRLF before $boundary + # is needed per the RFC, and the parts must not + # have a closing CRLF of their own. See Tcllib bug + # 1213527, and patch 1254934 for the problems when + # both file/string branches added CRLF after the + # body parts. + + + foreach part $state(parts) { + puts $channel \n--$boundary + mime::copymessage $part $channel + } + puts $channel \n--$boundary-- + } + } + + if {[info exists state(fd)]} { + catch {close $state(fd)} + unset state(fd) + } + } + + string { + if {[catch {fconfigure $channel -buffersize} blocksize]} { + set blocksize 4096 + } elseif {$blocksize < 512} { + set blocksize 512 + } + set blocksize [expr {($blocksize / 4) * 3}] + + # [893516] + fconfigure $channel -buffersize $blocksize + + puts $channel {} + + #TODO: tests don't cover these paths + if {$converter eq {}} { + puts -nonewline $channel $state(string) + } else { + puts -nonewline $channel [$converter -mode encode -- $state(string)] + } + } + default { + error "Unknown value \"$state(value)\"" + } + } + + flush $channel + + if {[info exists state(error)]} { + error $state(error) + } +} + +# ::mime::buildmessage -- +# +# Like copymessage, but produces a string rather than writing the message into a channel. +# +# Arguments: +# token The MIME token to parse. +# +# Results: +# The message. + +proc ::mime::buildmessage token { + global errorCode errorInfo + # FRINK: nocheck + variable $token + upvar 0 $token state + + set openP [info exists state(fd)] + + set code [catch {mime::buildmessageaux $token} result] + if {![info exists errorCode]} { + set ecode {} + } else { + set ecode $errorCode + } + set einfo $errorInfo + + if {!$openP && [info exists state(fd)]} { + if {![info exists state(root)]} { + catch {close $state(fd)} + } + unset state(fd) + } + + return -code $code -errorinfo $einfo -errorcode $ecode $result +} + + +proc ::mime::buildmessageaux token { + set chan [tcl::chan::memchan] + chan configure $chan -translation crlf + copymessageaux $token $chan + seek $chan 0 + chan configure $chan -translation binary + set res [read $chan] + close $chan + return $res +} + +# ::mime::encoding -- +# +# Determines how a token is encoded. +# +# Arguments: +# token The MIME token to parse. +# +# Results: +# Returns the encoding of the message (the null string, base64, +# or quoted-printable). + +proc ::mime::encoding {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + switch -glob -- $state(content) { + audio/* + - + image/* + - + video/* { + return base64 + } + + message/* + - + multipart/* { + return {} + } + default {# Skip} + } + + set asciiP 1 + set lineP 1 + switch -- $state(value) { + file { + set fd [open $state(file) RDONLY] + fconfigure $fd -translation binary + + while {[gets $fd line] >= 0} { + if {$asciiP} { + set asciiP [encodingasciiP $line] + } + if {$lineP} { + set lineP [encodinglineP $line] + } + if {(!$asciiP) && (!$lineP)} { + break + } + } + + catch {close $fd} + } + + parts { + return {} + } + + string { + foreach line [split $state(string) "\n"] { + if {$asciiP} { + set asciiP [encodingasciiP $line] + } + if {$lineP} { + set lineP [encodinglineP $line] + } + if {(!$asciiP) && (!$lineP)} { + break + } + } + } + default { + error "Unknown value \"$state(value)\"" + } + } + + switch -glob -- $state(content) { + text/* { + if {!$asciiP} { + #TODO: this path is not covered by tests + foreach {k v} $state(params) { + if {$k eq "charset"} { + set v [string tolower $v] + if {($v ne "us-ascii") \ + && (![string match {iso-8859-[1-8]} $v])} { + return base64 + } + + break + } + } + } + + if {!$lineP} { + return quoted-printable + } + } + + + default { + if {(!$asciiP) || (!$lineP)} { + return base64 + } + } + } + + return {} +} + +# ::mime::encodingasciiP -- +# +# Checks if a string is a pure ascii string, or if it has a non-standard +# form. +# +# Arguments: +# line The line to check. +# +# Results: +# Returns 1 if \r only occurs at the end of lines, and if all +# characters in the line are between the ASCII codes of 32 and 126. + +proc ::mime::encodingasciiP {line} { + foreach c [split $line {}] { + switch -- $c { + { } - \t - \r - \n { + } + + default { + binary scan $c c c + if {($c < 32) || ($c > 126)} { + return 0 + } + } + } + } + if { + [set r [string first \r $line]] < 0 + || + $r == {[string length $line] - 1} + } { + return 1 + } + + return 0 +} + +# ::mime::encodinglineP -- +# +# Checks if a string is a line is valid to be processed. +# +# Arguments: +# line The line to check. +# +# Results: +# Returns 1 the line is less than 76 characters long, the line +# contains more characters than just whitespace, the line does +# not start with a '.', and the line does not start with 'From '. + +proc ::mime::encodinglineP {line} { + if {([string length $line] > 76) \ + || ($line ne [string trimright $line]) \ + || ([string first . $line] == 0) \ + || ([string first {From } $line] == 0)} { + return 0 + } + + return 1 +} + +# ::mime::fcopy -- +# +# Appears to be unused. +# +# Arguments: +# +# Results: +# + +proc ::mime::fcopy {token count {error {}}} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + if {$error ne {}} { + set state(error) $error + } + set state(doneP) 1 +} + +# ::mime::scopy -- +# +# Copy a portion of the contents of a mime token to a channel. +# +# Arguments: +# token The token containing the data to copy. +# channel The channel to write the data to. +# offset The location in the string to start copying +# from. +# len The amount of data to write. +# blocksize The block size for the write operation. +# +# Results: +# The specified portion of the string in the mime token is +# copied to the specified channel. + +proc ::mime::scopy {token channel offset len blocksize} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + if {$len <= 0} { + set state(doneP) 1 + fileevent $channel writable {} + return + } + + if {[set cc $len] > $blocksize} { + set cc $blocksize + } + + if {[catch { + puts -nonewline $channel [ + string range $state(string) $offset [expr {$offset + $cc - 1}]] + fileevent $channel writable [ + list mime::scopy $token $channel [ + incr offset $cc] [incr len -$cc] $blocksize] + } result] + } { + set state(error) $result + set state(doneP) 1 + fileevent $channel writable {} + } + return +} + +# ::mime::qp_encode -- +# +# Tcl version of quote-printable encode +# +# Arguments: +# string The string to quote. +# encoded_word Boolean value to determine whether or not encoded words +# (RFC 2047) should be handled or not. (optional) +# +# Results: +# The properly quoted string is returned. + +proc ::mime::qp_encode {string {encoded_word 0} {no_softbreak 0}} { + # 8.1+ improved string manipulation routines used. + # Replace outlying characters, characters that would normally + # be munged by EBCDIC gateways, and special Tcl characters "[\]{} + # with =xx sequence + + if {$encoded_word} { + # Special processing for encoded words (RFC 2047) + set regexp {[\x00-\x08\x0B-\x1E\x21-\x24\x3D\x40\x5B-\x5E\x60\x7B-\xFF\x09\x5F\x3F]} + lappend mapChars { } _ + } else { + set regexp {[\x00-\x08\x0B-\x1E\x21-\x24\x3D\x40\x5B-\x5E\x60\x7B-\xFF]} + } + regsub -all -- $regexp $string {[format =%02X [scan "\\&" %c]]} string + + # Replace the format commands with their result + + set string [subst -novariables $string] + + # soft/hard newlines and other + # Funky cases for SMTP compatibility + lappend mapChars " \n" =20\n \t\n =09\n \n\.\n =2E\n "\nFrom " "\n=46rom " + + set string [string map $mapChars $string] + + # Break long lines - ugh + + # Implementation of FR #503336 + if {$no_softbreak} { + set result $string + } else { + set result {} + foreach line [split $string \n] { + while {[string length $line] > 72} { + set chunk [string range $line 0 72] + if {[regexp -- (=|=.)$ $chunk dummy end]} { + + # Don't break in the middle of a code + + set len [expr {72 - [string length $end]}] + set chunk [string range $line 0 $len] + incr len + set line [string range $line $len end] + } else { + set line [string range $line 73 end] + } + append result $chunk=\n + } + append result $line\n + } + + # Trim off last \n, since the above code has the side-effect + # of adding an extra \n to the encoded string and return the + # result. + set result [string range $result 0 end-1] + } + + # If the string ends in space or tab, replace with =xx + + set lastChar [string index $result end] + if {$lastChar eq { }} { + set result [string replace $result end end =20] + } elseif {$lastChar eq "\t"} { + set result [string replace $result end end =09] + } + + return $result +} + +# ::mime::qp_decode -- +# +# Tcl version of quote-printable decode +# +# Arguments: +# string The quoted-printable string to decode. +# encoded_word Boolean value to determine whether or not encoded words +# (RFC 2047) should be handled or not. (optional) +# +# Results: +# The decoded string is returned. + +proc ::mime::qp_decode {string {encoded_word 0}} { + # 8.1+ improved string manipulation routines used. + # Special processing for encoded words (RFC 2047) + + if {$encoded_word} { + # _ == \x20, even if SPACE occupies a different code position + set string [string map [list _ \u0020] $string] + } + + # smash the white-space at the ends of lines since that must've been + # generated by an MUA. + + regsub -all -- {[ \t]+\n} $string \n string + set string [string trimright $string " \t"] + + # Protect the backslash for later subst and + # smash soft newlines, has to occur after white-space smash + # and any encoded word modification. + + #TODO: codepath not tested + set string [string map [list \\ {\\} =\n {}] $string] + + # Decode specials + + regsub -all -nocase {=([a-f0-9][a-f0-9])} $string {\\u00\1} string + + # process \u unicode mapped chars + + return [subst -novariables -nocommands $string] +} + +# ::mime::parseaddress -- +# +# This was originally written circa 1982 in C. we're still using it +# because it recognizes virtually every buggy address syntax ever +# generated! +# +# mime::parseaddress takes a string containing one or more 822-style +# address specifications and returns a list of dictionaries, for each +# address specified in the argument. +# +# Each dictionary contains these properties: +# +# property value +# ======== ===== +# address local@domain +# comment 822-style comment +# domain the domain part (rhs) +# error non-empty on a parse error +# group this address begins a group +# friendly user-friendly rendering +# local the local part (lhs) +# memberP this address belongs to a group +# phrase the phrase part +# proper 822-style address specification +# route 822-style route specification (obsolete) +# +# Note that one or more of these properties may be empty. +# +# Arguments: +# string The address string to parse +# +# Results: +# Returns a list of dictionaries, one element for each address +# specified in the argument. + +proc ::mime::parseaddress {string} { + global errorCode errorInfo + + variable mime + + set token [namespace current]::[incr mime(uid)] + # FRINK: nocheck + variable $token + upvar 0 $token state + + set code [catch {mime::parseaddressaux $token $string} result] + set ecode $errorCode + set einfo $errorInfo + + foreach name [array names state] { + unset state($name) + } + # FRINK: nocheck + catch {unset $token} + + return -code $code -errorinfo $einfo -errorcode $ecode $result +} + +# ::mime::parseaddressaux -- +# +# This was originally written circa 1982 in C. we're still using it +# because it recognizes virtually every buggy address syntax ever +# generated! +# +# mime::parseaddressaux does the actually parsing for mime::parseaddress +# +# Each dictionary contains these properties: +# +# property value +# ======== ===== +# address local@domain +# comment 822-style comment +# domain the domain part (rhs) +# error non-empty on a parse error +# group this address begins a group +# friendly user-friendly rendering +# local the local part (lhs) +# memberP this address belongs to a group +# phrase the phrase part +# proper 822-style address specification +# route 822-style route specification (obsolete) +# +# Note that one or more of these properties may be empty. +# +# Arguments: +# token The MIME token to work from. +# string The address string to parse +# +# Results: +# Returns a list of dictionaries, one for each address specified in the +# argument. + +proc ::mime::parseaddressaux {token string} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + variable addrtokenL + variable addrlexemeL + + set state(input) $string + set state(glevel) 0 + set state(buffer) {} + set state(lastC) LX_END + set state(tokenL) $addrtokenL + set state(lexemeL) $addrlexemeL + + set result {} + while {[addr_next $token]} { + if {[set tail $state(domain)] ne {}} { + set tail @$state(domain) + } else { + set tail @[info hostname] + } + if {[set address $state(local)] ne {}} { + #TODO: this path is not covered by tests + append address $tail + } + + if {$state(phrase) ne {}} { + #TODO: this path is not covered by tests + set state(phrase) [string trim $state(phrase) \"] + foreach t $state(tokenL) { + if {[string first $t $state(phrase)] >= 0} { + #TODO: is this quoting robust enough? + set state(phrase) \"$state(phrase)\" + break + } + } + + set proper "$state(phrase) <$address>" + } else { + set proper $address + } + + if {[set friendly $state(phrase)] eq {}} { + #TODO: this path is not covered by tests + if {[set note $state(comment)] ne {}} { + if {[string first ( $note] == 0} { + set note [string trimleft [string range $note 1 end]] + } + if { + [string last ) $note] + == [set len [expr {[string length $note] - 1}]] + } { + set note [string range $note 0 [expr {$len - 1}]] + } + set friendly $note + } + + if { + $friendly eq {} + && + [set mbox $state(local)] ne {} + } { + #TODO: this path is not covered by tests + set mbox [string trim $mbox \"] + + if {[string first / $mbox] != 0} { + set friendly $mbox + } elseif {[set friendly [addr_x400 $mbox PN]] ne {}} { + } elseif { + [set friendly [addr_x400 $mbox S]] ne {} + && + [set g [addr_x400 $mbox G]] ne {} + } { + set friendly "$g $friendly" + } + + if {$friendly eq {}} { + set friendly $mbox + } + } + } + set friendly [string trim $friendly \"] + + lappend result [list address $address \ + comment $state(comment) \ + domain $state(domain) \ + error $state(error) \ + friendly $friendly \ + group $state(group) \ + local $state(local) \ + memberP $state(memberP) \ + phrase $state(phrase) \ + proper $proper \ + route $state(route)] + + } + + unset {*}{ + state(input) + state(glevel) + state(buffer) + state(lastC) + state(tokenL) + state(lexemeL) + } + + return $result +} + +# ::mime::addr_next -- +# +# Locate the next address in a mime token. +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns 1 if there is another address, and 0 if there is not. + +proc ::mime::addr_next {token} { + global errorCode errorInfo + # FRINK: nocheck + variable $token + upvar 0 $token state + set nocomplain [package vsatisfies [package provide Tcl] 8.4] + foreach prop {comment domain error group local memberP phrase route} { + if {$nocomplain} { + unset -nocomplain state($prop) + } else { + if {[catch {unset state($prop)}]} {set ::errorInfo {}} + } + } + + switch -- [set code [catch {mime::addr_specification $token} result]] { + 0 { + if {!$result} { + return 0 + } + + switch -- $state(lastC) { + LX_COMMA + - + LX_END { + } + default { + # catch trailing comments... + set lookahead $state(input) + mime::parselexeme $token + set state(input) $lookahead + } + } + } + + 7 { + set state(error) $result + + while {1} { + switch -- $state(lastC) { + LX_COMMA + - + LX_END { + break + } + + default { + mime::parselexeme $token + } + } + } + } + + default { + set ecode $errorCode + set einfo $errorInfo + + return -code $code -errorinfo $einfo -errorcode $ecode $result + } + } + + foreach prop {comment domain error group local memberP phrase route} { + if {![info exists state($prop)]} { + set state($prop) {} + } + } + + return 1 +} + +# ::mime::addr_specification -- +# +# Uses lookahead parsing to determine whether there is another +# valid e-mail address or not. Throws errors if unrecognized +# or invalid e-mail address syntax is used. +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns 1 if there is another address, and 0 if there is not. + +proc ::mime::addr_specification {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + set lookahead $state(input) + switch -- [parselexeme $token] { + LX_ATOM + - + LX_QSTRING { + set state(phrase) $state(buffer) + } + + LX_SEMICOLON { + if {[incr state(glevel) -1] < 0} { + return -code 7 "extraneous semi-colon" + } + + catch {unset state(comment)} + return [addr_specification $token] + } + + LX_COMMA { + catch {unset state(comment)} + return [addr_specification $token] + } + + LX_END { + return 0 + } + + LX_LBRACKET { + return [addr_routeaddr $token] + } + + LX_ATSIGN { + set state(input) $lookahead + return [addr_routeaddr $token 0] + } + + default { + return -code 7 [ + format "unexpected character at beginning (found %s)" \ + $state(buffer)] + } + } + + switch -- [parselexeme $token] { + LX_ATOM + - + LX_QSTRING { + append state(phrase) " " $state(buffer) + + return [addr_phrase $token] + } + + LX_LBRACKET { + return [addr_routeaddr $token] + } + + LX_COLON { + return [addr_group $token] + } + + LX_DOT { + set state(local) "$state(phrase)$state(buffer)" + unset state(phrase) + mime::addr_routeaddr $token 0 + mime::addr_end $token + } + + LX_ATSIGN { + set state(memberP) $state(glevel) + set state(local) $state(phrase) + unset state(phrase) + mime::addr_domain $token + mime::addr_end $token + } + + LX_SEMICOLON + - + LX_COMMA + - + LX_END { + set state(memberP) $state(glevel) + if { + $state(lastC) eq "LX_SEMICOLON" + && + ([incr state(glevel) -1] < 0) + } { + #TODO: this path is not covered by tests + return -code 7 "extraneous semi-colon" + } + + set state(local) $state(phrase) + unset state(phrase) + } + + default { + return -code 7 [ + format "expecting mailbox (found %s)" $state(buffer)] + } + } + + return 1 +} + +# ::mime::addr_routeaddr -- +# +# Parses the domain portion of an e-mail address. Finds the '@' +# sign and then calls mime::addr_route to verify the domain. +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns 1 if there is another address, and 0 if there is not. + +proc ::mime::addr_routeaddr {token {checkP 1}} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + set lookahead $state(input) + if {[parselexeme $token] eq "LX_ATSIGN"} { + #TODO: this path is not covered by tests + mime::addr_route $token + } else { + set state(input) $lookahead + } + + mime::addr_local $token + + switch -- $state(lastC) { + LX_ATSIGN { + mime::addr_domain $token + } + + LX_SEMICOLON + - + LX_RBRACKET + - + LX_COMMA + - + LX_END { + } + + default { + return -code 7 [ + format "expecting at-sign after local-part (found %s)" \ + $state(buffer)] + } + } + + if {($checkP) && ($state(lastC) ne "LX_RBRACKET")} { + return -code 7 [ + format "expecting right-bracket (found %s)" $state(buffer)] + } + + return 1 +} + +# ::mime::addr_route -- +# +# Attempts to parse the portion of the e-mail address after the @. +# Tries to verify that the domain definition has a valid form. +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns nothing if successful, and throws an error if invalid +# syntax is found. + +proc ::mime::addr_route {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + set state(route) @ + + while 1 { + switch -- [parselexeme $token] { + LX_ATOM + - + LX_DLITERAL { + append state(route) $state(buffer) + } + + default { + return -code 7 \ + [format "expecting sub-route in route-part (found %s)" \ + $state(buffer)] + } + } + + switch -- [parselexeme $token] { + LX_COMMA { + append state(route) $state(buffer) + while 1 { + switch -- [parselexeme $token] { + LX_COMMA { + } + + LX_ATSIGN { + append state(route) $state(buffer) + break + } + + default { + return -code 7 \ + [format "expecting at-sign in route (found %s)" \ + $state(buffer)] + } + } + } + } + + LX_ATSIGN + - + LX_DOT { + append state(route) $state(buffer) + } + + LX_COLON { + append state(route) $state(buffer) + return + } + + default { + return -code 7 [ + format "expecting colon to terminate route (found %s)" \ + $state(buffer)] + } + } + } +} + +# ::mime::addr_domain -- +# +# Attempts to parse the portion of the e-mail address after the @. +# Tries to verify that the domain definition has a valid form. +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns nothing if successful, and throws an error if invalid +# syntax is found. + +proc ::mime::addr_domain {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + while 1 { + switch -- [parselexeme $token] { + LX_ATOM + - + LX_DLITERAL { + append state(domain) $state(buffer) + } + + default { + return -code 7 [ + format "expecting sub-domain in domain-part (found %s)" \ + $state(buffer)] + } + } + + switch -- [parselexeme $token] { + LX_DOT { + append state(domain) $state(buffer) + } + + LX_ATSIGN { + append state(local) % $state(domain) + unset state(domain) + } + + default { + return + } + } + } +} + +# ::mime::addr_local -- +# +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns nothing if successful, and throws an error if invalid +# syntax is found. + +proc ::mime::addr_local {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + set state(memberP) $state(glevel) + + while 1 { + switch -- [parselexeme $token] { + LX_ATOM + - + LX_QSTRING { + append state(local) $state(buffer) + } + + default { + return -code 7 \ + [format "expecting mailbox in local-part (found %s)" \ + $state(buffer)] + } + } + + switch -- [parselexeme $token] { + LX_DOT { + append state(local) $state(buffer) + } + + default { + return + } + } + } +} + +# ::mime::addr_phrase -- +# +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns nothing if successful, and throws an error if invalid +# syntax is found. + + +proc ::mime::addr_phrase {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + while {1} { + switch -- [parselexeme $token] { + LX_ATOM + - + LX_QSTRING { + append state(phrase) " " $state(buffer) + } + + default { + break + } + } + } + + switch -- $state(lastC) { + LX_LBRACKET { + return [addr_routeaddr $token] + } + + LX_COLON { + return [addr_group $token] + } + + LX_DOT { + append state(phrase) $state(buffer) + return [addr_phrase $token] + } + + default { + return -code 7 [ + format "found phrase instead of mailbox (%s%s)" \ + $state(phrase) $state(buffer)] + } + } +} + +# ::mime::addr_group -- +# +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns nothing if successful, and throws an error if invalid +# syntax is found. + +proc ::mime::addr_group {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + if {[incr state(glevel)] > 1} { + return -code 7 [ + format "nested groups not allowed (found %s)" $state(phrase)] + } + + set state(group) $state(phrase) + unset state(phrase) + + set lookahead $state(input) + while 1 { + switch -- [parselexeme $token] { + LX_SEMICOLON + - + LX_END { + set state(glevel) 0 + return 1 + } + + LX_COMMA { + } + + default { + set state(input) $lookahead + return [addr_specification $token] + } + } + } +} + +# ::mime::addr_end -- +# +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns nothing if successful, and throws an error if invalid +# syntax is found. + +proc ::mime::addr_end {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + switch -- $state(lastC) { + LX_SEMICOLON { + if {[incr state(glevel) -1] < 0} { + return -code 7 "extraneous semi-colon" + } + } + + LX_COMMA + - + LX_END { + } + + default { + return -code 7 [ + format "junk after local@domain (found %s)" $state(buffer)] + } + } +} + +# ::mime::addr_x400 -- +# +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns nothing if successful, and throws an error if invalid +# syntax is found. + +proc ::mime::addr_x400 {mbox key} { + if {[set x [string first /$key= [string toupper $mbox]]] < 0} { + return {} + } + set mbox [string range $mbox [expr {$x + [string length $key] + 2}] end] + + if {[set x [string first / $mbox]] > 0} { + set mbox [string range $mbox 0 [expr {$x - 1}]] + } + + return [string trim $mbox \"] +} + +# ::mime::parsedatetime -- +# +# Fortunately the clock command in the Tcl 8.x core does all the heavy +# lifting for us (except for timezone calculations). +# +# mime::parsedatetime takes a string containing an 822-style date-time +# specification and returns the specified property. +# +# The list of properties and their ranges are: +# +# property range +# ======== ===== +# clock raw result of "clock scan" +# hour 0 .. 23 +# lmonth January, February, ..., December +# lweekday Sunday, Monday, ... Saturday +# mday 1 .. 31 +# min 0 .. 59 +# mon 1 .. 12 +# month Jan, Feb, ..., Dec +# proper 822-style date-time specification +# rclock elapsed seconds between then and now +# sec 0 .. 59 +# wday 0 .. 6 (Sun .. Mon) +# weekday Sun, Mon, ..., Sat +# yday 1 .. 366 +# year 1900 ... +# zone -720 .. 720 (minutes east of GMT) +# +# Arguments: +# value Either a 822-style date-time specification or '-now' +# if the current date/time should be used. +# property The property (from the list above) to return +# +# Results: +# Returns the string value of the 'property' for the date/time that was +# specified in 'value'. + +namespace eval ::mime { + variable WDAYS_SHORT [list Sun Mon Tue Wed Thu Fri Sat] + variable WDAYS_LONG [list Sunday Monday Tuesday Wednesday Thursday \ + Friday Saturday] + + # Counting months starts at 1, so just insert a dummy element + # at index 0. + variable MONTHS_SHORT [list {} \ + Jan Feb Mar Apr May Jun \ + Jul Aug Sep Oct Nov Dec] + variable MONTHS_LONG [list {} \ + January February March April May June July \ + August Sepember October November December] +} +proc ::mime::parsedatetime {value property} { + if {$value eq "-now"} { + set clock [clock seconds] + } elseif {[regexp {^(.*) ([+-])([0-9][0-9])([0-9][0-9])$} $value \ + -> value zone_sign zone_hour zone_min] + } { + set clock [clock scan $value -gmt 1] + if {[info exists zone_min]} { + set zone_min [scan $zone_min %d] + set zone_hour [scan $zone_hour %d] + set zone [expr {60 * ($zone_min + 60 * $zone_hour)}] + if {$zone_sign eq "+"} { + set zone -$zone + } + incr clock $zone + } + } else { + set clock [clock scan $value] + } + + switch -- $property { + clock { + return $clock + } + + hour { + set value [clock format $clock -format %H] + } + + lmonth { + variable MONTHS_LONG + return [lindex $MONTHS_LONG \ + [scan [clock format $clock -format %m] %d]] + } + + lweekday { + variable WDAYS_LONG + return [lindex $WDAYS_LONG [clock format $clock -format %w]] + } + + mday { + set value [clock format $clock -format %d] + } + + min { + set value [clock format $clock -format %M] + } + + mon { + set value [clock format $clock -format %m] + } + + month { + variable MONTHS_SHORT + return [lindex $MONTHS_SHORT [ + scan [clock format $clock -format %m] %d]] + } + + proper { + set gmt [clock format $clock -format "%Y-%m-%d %H:%M:%S" -gmt true] + if {[set diff [expr {($clock-[clock scan $gmt]) / 60}]] < 0} { + set s - + set diff [expr {-($diff)}] + } else { + set s + + } + set zone [format %s%02d%02d $s [ + expr {$diff / 60}] [expr {$diff % 60}]] + + variable WDAYS_SHORT + set wday [lindex $WDAYS_SHORT [clock format $clock -format %w]] + variable MONTHS_SHORT + set mon [lindex $MONTHS_SHORT [ + scan [clock format $clock -format %m] %d]] + + return [ + clock format $clock -format "$wday, %d $mon %Y %H:%M:%S $zone"] + } + + rclock { + #TODO: these paths are not covered by tests + if {$value eq "-now"} { + return 0 + } else { + return [expr {[clock seconds] - $clock}] + } + } + + sec { + set value [clock format $clock -format %S] + } + + wday { + return [clock format $clock -format %w] + } + + weekday { + variable WDAYS_SHORT + return [lindex $WDAYS_SHORT [clock format $clock -format %w]] + } + + yday { + set value [clock format $clock -format %j] + } + + year { + set value [clock format $clock -format %Y] + } + + zone { + set value [string trim [string map [list \t { }] $value]] + if {[set x [string last { } $value]] < 0} { + return 0 + } + set value [string range $value [expr {$x + 1}] end] + switch -- [set s [string index $value 0]] { + + - - { + if {$s eq "+"} { + #TODO: This path is not covered by tests + set s {} + } + set value [string trim [string range $value 1 end]] + if {( + [string length $value] != 4) + || + [scan $value %2d%2d h m] != 2 + || + $h > 12 + || + $m > 59 + || + ($h == 12 && $m > 0) + } { + error "malformed timezone-specification: $value" + } + set value $s[expr {$h * 60 + $m}] + } + + default { + set value [string toupper $value] + set z1 [list UT GMT EST EDT CST CDT MST MDT PST PDT] + set z2 [list 0 0 -5 -4 -6 -5 -7 -6 -8 -7] + if {[set x [lsearch -exact $z1 $value]] < 0} { + error "unrecognized timezone-mnemonic: $value" + } + set value [expr {[lindex $z2 $x] * 60}] + } + } + } + + date2gmt + - + date2local + - + dst + - + sday + - + szone + - + tzone + - + default { + error "unknown property $property" + } + } + + if {[set value [string trimleft $value 0]] eq {}} { + #TODO: this path is not covered by tests + set value 0 + } + return $value +} + +# ::mime::uniqueID -- +# +# Used to generate a 'globally unique identifier' for the content-id. +# The id is built from the pid, the current time, the hostname, and +# a counter that is incremented each time a message is sent. +# +# Arguments: +# +# Results: +# Returns the a string that contains the globally unique identifier +# that should be used for the Content-ID of an e-mail message. + +proc ::mime::uniqueID {} { + variable mime + + return <[pid].[clock seconds].[incr mime(cid)]@[info hostname]> +} + +# ::mime::parselexeme -- +# +# Used to implement a lookahead parser. +# +# Arguments: +# token The MIME token to operate on. +# +# Results: +# Returns the next token found by the parser. + +proc ::mime::parselexeme {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + set state(input) [string trimleft $state(input)] + + set state(buffer) {} + if {$state(input) eq {}} { + set state(buffer) end-of-input + return [set state(lastC) LX_END] + } + + set c [string index $state(input) 0] + set state(input) [string range $state(input) 1 end] + + if {$c eq "("} { + set noteP 0 + set quoteP 0 + + while 1 { + append state(buffer) $c + + #TODO: some of these paths are not covered by tests + switch -- $c/$quoteP { + (/0 { + incr noteP + } + + \\/0 { + set quoteP 1 + } + + )/0 { + if {[incr noteP -1] < 1} { + if {[info exists state(comment)]} { + append state(comment) { } + } + append state(comment) $state(buffer) + + return [parselexeme $token] + } + } + + default { + set quoteP 0 + } + } + + if {[set c [string index $state(input) 0]] eq {}} { + set state(buffer) "end-of-input during comment" + return [set state(lastC) LX_ERR] + } + set state(input) [string range $state(input) 1 end] + } + } + + if {$c eq "\""} { + set firstP 1 + set quoteP 0 + + while 1 { + append state(buffer) $c + + switch -- $c/$quoteP { + "\\/0" { + set quoteP 1 + } + + "\"/0" { + if {!$firstP} { + return [set state(lastC) LX_QSTRING] + } + set firstP 0 + } + + default { + set quoteP 0 + } + } + + if {[set c [string index $state(input) 0]] eq {}} { + set state(buffer) "end-of-input during quoted-string" + return [set state(lastC) LX_ERR] + } + set state(input) [string range $state(input) 1 end] + } + } + + if {$c eq {[}} { + set quoteP 0 + + while 1 { + append state(buffer) $c + + switch -- $c/$quoteP { + \\/0 { + set quoteP 1 + } + + ]/0 { + return [set state(lastC) LX_DLITERAL] + } + + default { + set quoteP 0 + } + } + + if {[set c [string index $state(input) 0]] eq {}} { + set state(buffer) "end-of-input during domain-literal" + return [set state(lastC) LX_ERR] + } + set state(input) [string range $state(input) 1 end] + } + } + + if {[set x [lsearch -exact $state(tokenL) $c]] >= 0} { + append state(buffer) $c + + return [set state(lastC) [lindex $state(lexemeL) $x]] + } + + while 1 { + append state(buffer) $c + + switch -- [set c [string index $state(input) 0]] { + {} - " " - "\t" - "\n" { + break + } + + default { + if {[lsearch -exact $state(tokenL) $c] >= 0} { + break + } + } + } + + set state(input) [string range $state(input) 1 end] + } + + return [set state(lastC) LX_ATOM] +} + +# ::mime::mapencoding -- +# +# mime::mapencodings maps tcl encodings onto the proper names for their +# MIME charset type. This is only done for encodings whose charset types +# were known. The remaining encodings return {} for now. +# +# Arguments: +# enc The tcl encoding to map. +# +# Results: +# Returns the MIME charset type for the specified tcl encoding, or {} +# if none is known. + +proc ::mime::mapencoding {enc} { + + variable encodings + + if {[info exists encodings($enc)]} { + return $encodings($enc) + } + return {} +} + +# ::mime::reversemapencoding -- +# +# mime::reversemapencodings maps MIME charset types onto tcl encoding names. +# Those that are unknown return {}. +# +# Arguments: +# mimeType The MIME charset to convert into a tcl encoding type. +# +# Results: +# Returns the tcl encoding name for the specified mime charset, or {} +# if none is known. + +proc ::mime::reversemapencoding {mimeType} { + + variable reversemap + + set lmimeType [string tolower $mimeType] + if {[info exists reversemap($lmimeType)]} { + return $reversemap($lmimeType) + } + return {} +} + +# ::mime::word_encode -- +# +# Word encodes strings as per RFC 2047. +# +# Arguments: +# charset The character set to encode the message to. +# method The encoding method (base64 or quoted-printable). +# string The string to encode. +# ?-charset_encoded 0 or 1 Whether the data is already encoded +# in the specified charset (default 1) +# ?-maxlength maxlength The maximum length of each encoded +# word to return (default 66) +# +# Results: +# Returns a word encoded string. + +proc ::mime::word_encode {charset method string {args}} { + + variable encodings + + if {![info exists encodings($charset)]} { + error "unknown charset '$charset'" + } + + if {$encodings($charset) eq {}} { + error "invalid charset '$charset'" + } + + if {$method ne "base64" && $method ne "quoted-printable"} { + error "unknown method '$method', must be base64 or quoted-printable" + } + + # default to encoded and a length that won't make the Subject header to long + array set options [list -charset_encoded 1 -maxlength 66] + array set options $args + + if {$options(-charset_encoded)} { + set unencoded_string [::encoding convertfrom $charset $string] + } else { + set unencoded_string $string + } + + set string_length [string length $unencoded_string] + + if {!$string_length} { + return {} + } + + set string_bytelength [string bytelength $unencoded_string] + + # the 7 is for =?, ?Q?, ?= delimiters of the encoded word + set maxlength [expr {$options(-maxlength) - [string length $encodings($charset)] - 7}] + switch -exact -- $method { + base64 { + if {$maxlength < 4} { + error "maxlength $options(-maxlength) too short for chosen charset and encoding" + } + set count 0 + set maxlength [expr {($maxlength / 4) * 3}] + while {$count < $string_length} { + set length 0 + set enc_string {} + while {$length < $maxlength && $count < $string_length} { + set char [string range $unencoded_string $count $count] + set enc_char [::encoding convertto $charset $char] + if {$length + [string length $enc_char] > $maxlength} { + set length $maxlength + } else { + append enc_string $enc_char + incr count + incr length [string length $enc_char] + } + } + set encoded_word [string map [ + list \n {}] [base64 -mode encode -- $enc_string]] + append result "=?$encodings($charset)?B?$encoded_word?=\n " + } + # Trim off last "\n ", since the above code has the side-effect + # of adding an extra "\n " to the encoded string. + + set result [string range $result 0 end-2] + } + quoted-printable { + if {$maxlength < 1} { + error "maxlength $options(-maxlength) too short for chosen charset and encoding" + } + set count 0 + while {$count < $string_length} { + set length 0 + set encoded_word {} + while {$length < $maxlength && $count < $string_length} { + set char [string range $unencoded_string $count $count] + set enc_char [::encoding convertto $charset $char] + set qp_enc_char [qp_encode $enc_char 1] + set qp_enc_char_length [string length $qp_enc_char] + if {$qp_enc_char_length > $maxlength} { + error "maxlength $options(-maxlength) too short for chosen charset and encoding" + } + if { + $length + [string length $qp_enc_char] > $maxlength + } { + set length $maxlength + } else { + append encoded_word $qp_enc_char + incr count + incr length [string length $qp_enc_char] + } + } + append result "=?$encodings($charset)?Q?$encoded_word?=\n " + } + # Trim off last "\n ", since the above code has the side-effect + # of adding an extra "\n " to the encoded string. + + set result [string range $result 0 end-2] + } + {} { + # Go ahead + } + default { + error "Can't handle content encoding \"$method\"" + } + } + return $result +} + +# ::mime::word_decode -- +# +# Word decodes strings that have been word encoded as per RFC 2047. +# +# Arguments: +# encoded The word encoded string to decode. +# +# Results: +# Returns the string that has been decoded from the encoded message. + +proc ::mime::word_decode {encoded} { + + variable reversemap + + if {[regexp -- {=\?([^?]+)\?(.)\?([^?]*)\?=} $encoded \ + - charset method string] != 1 + } { + error "malformed word-encoded expression '$encoded'" + } + + set enc [reversemapencoding $charset] + if {$enc eq {}} { + error "unknown charset '$charset'" + } + + switch -exact -- $method { + b - + B { + set method base64 + } + q - + Q { + set method quoted-printable + } + default { + error "unknown method '$method', must be B or Q" + } + } + + switch -exact -- $method { + base64 { + set result [base64 -mode decode -- $string] + } + quoted-printable { + set result [qp_decode $string 1] + } + {} { + # Go ahead + } + default { + error "Can't handle content encoding \"$method\"" + } + } + + return [list $enc $method $result] +} + +# ::mime::field_decode -- +# +# Word decodes strings that have been word encoded as per RFC 2047 +# and converts the string from the original encoding/charset to UTF. +# +# Arguments: +# field The string to decode +# +# Results: +# Returns the decoded string in UTF. + +proc ::mime::field_decode {field} { + # ::mime::field_decode is broken. Here's a new version. + # This code is in the public domain. Don Libes + + # Step through a field for mime-encoded words, building a new + # version with unencoded equivalents. + + # Sorry about the grotesque regexp. Most of it is sensible. One + # notable fudge: the final $ is needed because of an apparent bug + # in the regexp engine where the preceding .* otherwise becomes + # non-greedy - perhaps because of the earlier ".*?", sigh. + + while {[regexp {(.*?)(=\?(?:[^?]+)\?(?:.)\?(?:[^?]*)\?=)(.*)$} $field \ + ignore prefix encoded field] + } { + # don't allow whitespace between encoded words per RFC 2047 + if {{} ne $prefix} { + if {![string is space $prefix]} { + append result $prefix + } + } + + set decoded [word_decode $encoded] + foreach {charset - string} $decoded break + + append result [::encoding convertfrom $charset $string] + } + append result $field + return $result +} + +## One-Shot Initialization + +::apply {{} { + variable encList + variable encAliasList + variable reversemap + + foreach {enc mimeType} $encList { + if {$mimeType eq {}} continue + set reversemap([string tolower $mimeType]) $enc + } + + foreach {enc mimeType} $encAliasList { + set reversemap([string tolower $mimeType]) $enc + } + + # Drop the helper variables + unset encList encAliasList + +} ::mime} + + +variable ::mime::internal 0 diff --git a/src/bootsupport/modules/punk/cap-0.1.0.tm b/src/bootsupport/modules/punk/cap-0.1.0.tm index 34bed4c..4cc6f30 100644 --- a/src/bootsupport/modules/punk/cap-0.1.0.tm +++ b/src/bootsupport/modules/punk/cap-0.1.0.tm @@ -14,20 +14,36 @@ # @@ Meta End +#*** !doctools +#[manpage_begin punk::cap 0 0.1.0] +#[copyright "2023 JMNoble - BSD licensed"] +#[titledesc {Module API}] +#[moddesc {punk capabilities plugin system}] +#[require punk::cap] +#[description] +#[list_begin definitions] # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Requirements ##e.g package require frobz +package require oolib + -#concepts: -# A capability may be something like providing a folder of files, or just a data dictionary, and/or an API -# -# capability handler - a package/namespace which may provide validation and standardised ways of looking up provider data -# registered (or not) using register_capabilityname -# capability provider - a package which registers as providing one or more capablities. -# registered using register_package -# the capabilitylist is a list of 2-element lists where the first element is the capabilityname and the second element is a (possibly empty) dict of data relevant to that capability -# A capabilityname may appear multiple times. ie a package may register that it provides the capability with multiple datasets. + +# mkdoc markdown +#' --- +#' author: JMNoble +#' --- +#' ## Concepts: +#' > A **capability** may be something like providing a folder of files, or just a data dictionary, and/or an API +#' +#' > **capability handler** - a package/namespace which may provide validation and standardised ways of looking up provider data +#' registered (or not) using register_capabilityname +#' +#' > **capability provider** - a package which registers as providing one or more capablities. +#' registered using register_package +#' the capabilitylist is a list of 2-element lists where the first element is the capabilityname and the second element is a (possibly empty) dict of data relevant to that capability +#' A capabilityname may appear multiple times. ie a package may register that it provides the capability with multiple datasets. # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ @@ -35,32 +51,99 @@ namespace eval punk::cap { variable pkgcapsdeclared [dict create] variable pkgcapsaccepted [dict create] variable caps [dict create] - if {[info commands [namespace current]::interface_caphandler.registry] eq ""} { - oo::class create [namespace current]::interface_caphandler.registry { - method pkg_register {pkg capname capdict fullcapabilitylist} { - #handler may override and return 0 (indicating don't register)e.g if pkg capdict data wasn't valid - #overridden handler must be able to handle multiple calls for same pkg - but it may return 1 or 0 as it wishes. - return 1 ;#default to permit - } - method pkg_unregister {pkg} { - return ;#unregistration return is ignored - review + + namespace eval class { + if {[info commands [namespace current]::interface_caphandler.registry] eq ""} { + #Handler classes + oo::class create [namespace current]::interface_caphandler.registry { + method pkg_register {pkg capname capdict fullcapabilitylist} { + #*** + #[call [class interface_caphandler.registry] [method pkg_register] [arg pkg] [arg capname] [arg capdict] [arg fullcapabilitylist]] + #handler may override and return 0 (indicating don't register)e.g if pkg capdict data wasn't valid + #overridden handler must be able to handle multiple calls for same pkg - but it may return 1 or 0 as it wishes. + return 1 ;#default to permit + } + method pkg_unregister {pkg} { + #*** + #[call [class interface_caphandler.registry] [method pkg_unregister] [arg pkg]] + return ;#unregistration return is ignored - review + } } - } + oo::class create [namespace current]::interface_caphandler.sysapi { - oo::class create [namespace current]::interface_capprovider.registration { - method get_declarations {} { - error "interface_capprovider.registration not implemented by provider" } - } - oo::class create [namespace current]::interface_capprovider.provider { - method register {{capabilityname_glob *}} { + + #Provider classes + oo::class create [namespace current]::interface_capprovider.registration { + method get_declarations {} { + #*** + #[call [class interface_capprovider.registration] [method pkg_unregister] [arg pkg]] + error "interface_capprovider.registration not implemented by provider" + } } - method capabilities {} { + oo::class create [namespace current]::interface_capprovider.provider { + variable provider_pkg + variable registrationobj + constructor {providerpkg} { + variable provider_pkg + if {$providerpkg in [list "" "::"]} { + error "interface_capprovider.provider constructor error. Invalid provider '$providerpkg'" + } + if {![namespace exists ::$providerpkg]} { + error "interface_capprovider.provider constructor error. Invalid provider '$providerpkg' - matching namespace not found" + } + + set registrationobj ::${providerpkg}::capsystem::capprovider.registration + if {[info commands $registrationobj] eq ""} { + error "capprovider.provider constructor error. Missing capprovider.registration interface at '$obj' (command not found) interface_capprovider.regstration instantiation must precede interface_capprovider.provider" + } + + set provider_pkg [string trim $providerpkg ""] + } + method register {{capabilityname_glob *}} { + #*** + #[call [class interface_capprovider.provider] [method register] [opt capabilityname_glob]] + variable provider_pkg + set all_decls [$registrationobj get_declarations] + set register_decls [lsearch -all -inline -index 0 $all_decls $capabilityname_glob] + punk::cap::register_package $provider_pkg $register_decls + } + method capabilities {} { + #*** + #[call [class interface_capprovider.provider] [method capabilities]] + variable provider_pkg + variable registrationobj + + set capabilities [list] + set decls [$registrationobj get_declarations] + foreach decl $decls { + lassign $decl capname capdict + if {$capname ni $capabilities} { + lappend capabilities $capname + } + } + return $capname + } } } + } ;# end namespace class + namespace eval capsystem { + proc get_caphandler_registry {capname} { + set ns [::punk::cap::get_handler $capname]::capsystem + if {[namespace exists ${ns}]} { + if {[info command ${ns}::caphandler.registry] ne ""} { + if {[info object isa object ${ns}::caphandler.registry]} { + return ${ns}::caphandler.registry + } + } + } + return "" + } } + + #Not all capabilities have to be registered. #A package registering as a provider using register_package can include capabilitynames in it's capabilitylist which have no associated capnamespace (handler). #such unregistered capabilitynames may be used just to flag something, or have datamembers significant to callers cooperatively interested in that capname. @@ -88,7 +171,7 @@ namespace eval punk::cap { } if {[llength [set providers [dict get $caps $capname providers]]]} { #some provider(s) were in place before the handler was registered - if {[set capreg [get_caphandler_registry $capname]] ne ""} { + if {[set capreg [punk::cap::capsystem::get_caphandler_registry $capname]] ne ""} { foreach pkg $providers { set fullcapabilitylist [dict get $pkgcapsdeclared $pkg] foreach capspec $fullcapabilitylist { @@ -131,10 +214,31 @@ namespace eval punk::cap { } } proc exists {capname} { + #*** !doctools + # [call [fun exists] [arg capname]] + # Return a boolean indicating if the named capability exists (0|1) + + # mkdoc markdown + #' + #' ## **exists(capname)** + #' + #' > return a boolean indicating the existence of a capability + #' + #' > Arguments: + #' + #' > - *capname* - string indicating the name of the capability + #' + #' > Returns: 0|1 + #' variable caps return [dict exists $caps $capname] } proc has_handler {capname} { + #*** !doctools + # [call [fun has_handler] [arg capname]] + # Return a boolean indicating if the named capability has a handler package installed (0|1) + + variable caps return [expr {[dict exists $caps $capname handler] && [dict get $caps $capname handler] ne ""}] } @@ -157,20 +261,9 @@ namespace eval punk::cap { if {[set handler [get_handler $capname]] eq ""} { error "punk::cap::call_handler $capname $args - no handler registered for capability $capname" } - set obj ${handler}::$capname + set obj ${handler}::api_$capname $obj [lindex $args 0] {*}[lrange $args 1 end] } - proc get_caphandler_registry {capname} { - set ns [get_handler $capname]::capsystem - if {[namespace exists ${ns}]} { - if {[info command ${ns}::caphandler.registry] ne ""} { - if {[info object isa object ${ns}::caphandler.registry]} { - return ${ns}::caphandler.registry - } - } - } - return "" - } proc get_providers {capname} { variable caps if {[dict exists $caps $capname]} { @@ -188,6 +281,11 @@ namespace eval punk::cap { if {[string match ::* $pkg]} { set pkg [string range $pkg 2 end] } + if {[dict exists $pkgcapsaccepted $pkg]} { + set pkg_already_accepted [dict get $pkgcapsaccepted $pkg] + } else { + set pkg_already_accepted [list] + } #for each capability # - ensure 1st element is a single word # - ensure that if 2nd element (capdict) is present - it is dict shaped @@ -199,6 +297,11 @@ namespace eval punk::cap { if {[expr {[llength $capdict] %2 != 0}]} { error "register_package error. pkg:'$pkg' The second element for capname:'$capname' doesn't appear to be a valid dict. Problematic entry: '$capspec'" } + if {$capspec in $pkg_already_accepted} { + #review - multiple handlers? if so - will need to record which handler(s) accepted the capspec + puts stderr "register_package pkg $pkg already has capspec marked as accepted: $capspec" + continue + } if {[dict exists $caps $capname]} { set cap_pkgs [dict get $caps $capname providers] } else { @@ -207,7 +310,7 @@ namespace eval punk::cap { } #todo - if there's a caphandler - call it's init/validation callback for the pkg set do_register 1 ;#default assumption unless vetoed by handler - if {[set capreg [get_caphandler_registry $capname]] ne ""} { + if {[set capreg [punk::cap::capsystem::get_caphandler_registry $capname]] ne ""} { #Note that the interface_caphandler.registry instance must be able to handle multiple calls for same pkg set do_register [$capreg pkg_register $pkg $capname $capdict $capabilitylist] } @@ -219,17 +322,23 @@ namespace eval punk::cap { dict lappend pkgcapsaccepted $pkg $capspec ;#if pkg is being registered prior to handler-registration - the handler may undo this entry } } - #another call to register_pkg with same pkg may have been made (most likely with different capname) so we must append + #another call to register_pkg with same pkg may have been made (most likely with different capname) so we must append - but check not already present #dict lappend pkgcapsdeclared $pkg $capabilitylist if {[dict exists $pkgcapsdeclared $pkg]} { - set caps [dict get $pkgcapsdeclared $pkg] - lappend caps {*}$capabilitylist - dict set pkgcapsdeclared $pkg $caps + set capspecs [dict get $pkgcapsdeclared $pkg] + foreach spec $capspecs { + if {$spec ni $capspecs} { + lappend capspecs $spec + } + } + dict set pkgcapsdeclared $pkg $capspecs } else { dict set pkgcapsdeclared $pkg $capabilitylist } } - proc unregister_package {pkg} { + + #todo! + proc unregister_package {pkg {capname *}} { variable pkgcapsdeclared variable caps if {[string match ::* $pkg]} { @@ -245,13 +354,13 @@ namespace eval punk::cap { set pkglist [dict get $cap_info providers] set posn [lsearch $pkglist $pkg] if {$posn >= 0} { - if {[set capreg [get_caphandler_registry $capname]] ne ""} { + if {[set capreg [punk::cap::capsystem::get_caphandler_registry $capname]] ne ""} { #review # it seems not useful to allow the callback to block this unregister action #the pkg may have multiple datasets for each capname so callback will only be called for first dataset we encounter #vetoing unregister would make this more complex for no particular advantage - #if per capability deregistration required this should probably be a separate thing (e.g disable_capability?) - $capreg pkg_unregister $pkg + #if per dataset deregistration required this should probably be a separate thing + $capreg pkg_unregister $pkg $capname } set pkglist [lreplace $pkglist $posn $posn] dict set caps $capname providers $pkglist @@ -398,21 +507,22 @@ namespace eval punk::cap { - - - - - - - - - - - # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::cap [namespace eval punk::cap { variable version + variable pkg punk::cap set version 0.1.0 + variable README.md [string map [list %pkg% $pkg %ver% $version] { + # punk capabilities system + ## pkg: %pkg% version: %ver% + + punk::cap base namespace + }] + return $version }] -return \ No newline at end of file +return + +#*** !doctools +#[list_end] +#[manpage_end] diff --git a/src/bootsupport/modules/punk/cap/handlers/templates-0.1.0.tm b/src/bootsupport/modules/punk/cap/handlers/templates-0.1.0.tm index 28a25e6..75a925d 100644 --- a/src/bootsupport/modules/punk/cap/handlers/templates-0.1.0.tm +++ b/src/bootsupport/modules/punk/cap/handlers/templates-0.1.0.tm @@ -35,10 +35,14 @@ namespace eval punk::cap::handlers::templates { namespace eval capsystem { #interfaces for punk::cap to call into if {[info commands caphandler.registry] eq ""} { - punk::cap::interface_caphandler.registry create caphandler.registry + punk::cap::class::interface_caphandler.registry create caphandler.registry oo::objdefine caphandler.registry { method pkg_register {pkg capname capdict caplist} { #caplist may not be complete set - which somewhat reduces its utility here regarding any decisions based on the context of this capname/capdict (review - remove this arg?) + + # -- --- --- --- --- --- --- ---- --- + # validation of capdict + # -- --- --- --- --- --- --- ---- --- if {![dict exists $capdict relpath]} { puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of '$capname' capability, but is missing 'relpath' key" return 0 @@ -52,16 +56,28 @@ namespace eval punk::cap::handlers::templates { set tpath [file normalize [file join $tmfile [dict get $capdict relpath]]] ;#relpath is relative to the tm *file* - not it's containing folder if {![file isdirectory $tpath]} { puts stderr "punk::cap::handlers::templates::capsystem pkg_register WARNING - unable to validate relpath location [dict get $capdict relpath] ($tpath) for package '$pkg' which is attempting to register with punk::cap as a provider of '$capname' capability" + return 0 } + + + # -- --- --- --- --- --- --- ---- --- + # update package internal data + # -- --- --- --- --- --- --- ---- --- if {$capname ni $::punk::cap::handlers::templates::handled_caps} { lappend ::punk::cap::handlers::templates::handled_caps $capname } - if {[info commands punk::cap::handlers::templates::$capname] eq ""} { - punk::cap::handlers::templates::api create ::punk::cap::handlers::templates::$capname $capname - } set cname [string map [list . _] $capname] upvar ::punk::cap::handlers::templates::pkg_folders_$cname pfolders dict lappend pfolders $pkg $tpath + + + # -- --- --- --- --- --- --- ---- --- + # instantiation of api at punk::cap::handlers::templates::api_$capname + # -- --- --- --- --- --- --- ---- --- + if {[info commands ::punk::cap::handlers::templates::$capname] eq ""} { + punk::cap::handlers::templates::class::api create ::punk::cap::handlers::templates::api_$capname $capname + } + return 1 } method pkg_unregister {pkg} { @@ -84,36 +100,38 @@ namespace eval punk::cap::handlers::templates { #handler api for clients of this capability - called via punk::cap::call_handler ?args? # -- --- --- --- --- --- --- namespace export * - - oo::class create api { - #return a dict keyed on folder with source pkg as value - constructor {capname} { - variable capabilityname - variable cname - set cname [string map [list . _] $capname] - set capabilityname $capname - } - method folders {} { - variable capabilityname - variable cname - upvar punk::cap::handlers::templates::pkg_folders_$cname pkg_folders - package require punk::cap - set capinfo [punk::cap::capability $capabilityname] - # e.g {punk.templates {handler punk::mix::templates providers ::somepkg}} - - #use the order of pkgs as registered with punk::cap - may have been modified with punk::cap::promote_package/demote_package - set pkgs [dict get $capinfo providers] - set folderdict [dict create] - foreach pkg $pkgs { - foreach pfolder [dict get $pkg_folders $pkg] { - dict set folderdict $pfolder [list source $pkg sourcetype package] + namespace eval class { + oo::class create api { + #return a dict keyed on folder with source pkg as value + constructor {capname} { + variable capabilityname + variable cname + set cname [string map [list . _] $capname] + set capabilityname $capname + } + method folders {} { + variable capabilityname + variable cname + upvar punk::cap::handlers::templates::pkg_folders_$cname pkg_folders + package require punk::cap + set capinfo [punk::cap::capability $capabilityname] + # e.g {punk.templates {handler punk::mix::templates providers ::somepkg}} + + #use the order of pkgs as registered with punk::cap - may have been modified with punk::cap::promote_package/demote_package + set pkgs [dict get $capinfo providers] + set folderdict [dict create] + foreach pkg $pkgs { + foreach pfolder [dict get $pkg_folders $pkg] { + dict set folderdict $pfolder [list source $pkg sourcetype package] + } } + return $folderdict } - return $folderdict } } + } diff --git a/src/bootsupport/modules/punk/mix-0.2.tm b/src/bootsupport/modules/punk/mix-0.2.tm index d09dfca..482c79a 100644 --- a/src/bootsupport/modules/punk/mix-0.2.tm +++ b/src/bootsupport/modules/punk/mix-0.2.tm @@ -5,7 +5,7 @@ package require punk::cap::handlers::templates ;#handler for templates cap punk::cap::register_capabilityname punk.templates ::punk::cap::handlers::templates package require punk::mix::templates ;#registers as provider pkg for 'punk.templates' capability with punk::cap -#punk::mix::templates::provider register * +punk::mix::templates::provider register * package require punk::mix::base package require punk::mix::cli diff --git a/src/bootsupport/modules/punk/mix/cli-0.3.tm b/src/bootsupport/modules/punk/mix/cli-0.3.tm index 6967226..790cfc6 100644 --- a/src/bootsupport/modules/punk/mix/cli-0.3.tm +++ b/src/bootsupport/modules/punk/mix/cli-0.3.tm @@ -170,7 +170,8 @@ namespace eval punk::mix::cli { } cd $sourcefolder #use run so that stdout visible as it goes - if {![catch {run --timeout=5000 -debug [info nameofexecutable] $sourcefolder/make.tcl {*}$args} exitinfo]} { + if {![catch {run --timeout=55000 -debug [info nameofexecutable] $sourcefolder/make.tcl {*}$args} exitinfo]} { + #todo - notify if exit because of timeout! puts stderr "exitinfo: $exitinfo" set exitcode [dict get $exitinfo exitcode] } else { diff --git a/src/bootsupport/modules/punk/mix/commandset/doc-0.1.0.tm b/src/bootsupport/modules/punk/mix/commandset/doc-0.1.0.tm index 6184a38..0b7c292 100644 --- a/src/bootsupport/modules/punk/mix/commandset/doc-0.1.0.tm +++ b/src/bootsupport/modules/punk/mix/commandset/doc-0.1.0.tm @@ -18,7 +18,11 @@ ## Requirements ##e.g package require frobz - +package require punk ;# for treefilenames +package require punk::repo +package require punk::docgen ;#inline doctools - generate doctools .man files at src/docgen prior to using kettle to producing .html .md etc +package require punk::mix::cli ;#punk::mix::cli::lib used for kettle_call +package require punk::mix::util ;#for path_relative # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ @@ -38,6 +42,30 @@ namespace eval punk::mix::commandset::doc { puts stderr "No current project dir - unable to build docs" return } + #user may delete the comment containing "--- punk::docgen::overwrites" and then manually edit, and we won't overwrite + #we still generate output in src/docgen so user can diff and manually update if thats what they prefer + set oldfiles [glob -nocomplain -dir $projectdir/src/doc -type f _module_*] + foreach maybedoomed $oldfiles { + set fd [open $maybedoomed r] + set data [read $fd] + close $fd + if {[string match "*--- punk::docgen overwrites *" $data]} { + file delete -force $maybedoomed + } + } + set generated [lib::do_docgen modules] + if {[dict get $generated count] > 0} { + #review + set doclist [dict get $generated docs] + foreach dinfo $doclist { + lassign $dinfo module fpath + set target $projectdir/src/doc/_module_[file tail $fpath] + if {![file exists $target]} { + file copy $fpath $target + } + } + } + if {[file exists $projectdir/src/doc]} { set original_wd [pwd] cd $projectdir/src @@ -125,6 +153,7 @@ namespace eval punk::mix::commandset::doc { cd $original_wd } proc validate {} { + #todo - run and validate punk::docgen output set projectdir [punk::repo::find_project] if {$projectdir eq ""} { puts stderr "No current project dir - unable to check doc status" @@ -154,6 +183,49 @@ namespace eval punk::mix::commandset::doc { namespace eval lib { variable pkg set pkg punk::mix::commandset::doc + proc do_docgen {{project_subpath modules}} { + set projectdir [punk::repo::find_project] + set outdir [file join $projectdir src docgen] + set subpath [file join $projectdir $project_subpath] + if {![file isdirectory $subpath]} { + puts stderr "WARNING punk::mix::commandset::doc unable to find subpath $subpath during do_docgen - skipping inline doctools generation" + return + } + if {[file isdirectory $outdir]} { + if {[catch { + file delete -force $outdir + }]} { + error "do_docgen failed to delete existing $outdir" + } + } + file mkdir $outdir + + set matched_paths [punk::treefilenames $subpath *.tm] + set count 0 + set newdocs [list] + set docgen_header_comments "" + append docgen_header_comments {[comment {--- punk::docgen generated from inline doctools comments ---}]} \n + append docgen_header_comments {[comment {--- punk::docgen DO NOT EDIT DOCS HERE UNLESS YOU REMOVE THESE COMMENT LINES ---}]} \n + append docgen_header_comments {[comment {--- punk::docgen overwrites this file ---}]} \n + foreach fullpath $matched_paths { + set relpath [punk::mix::util::path_relative $subpath $fullpath] + set tailsegs [file split $relpath] + set module_fullname [join $tailsegs ::] + set docname [string map [list :: _] $module_fullname].man ;#todo - something better - need to ensure unique + set doctools [punk::docgen::get_doctools_comments $fullpath] + if {$doctools ne ""} { + puts stdout "generating doctools output from file $relpath" + set outfile [file join $outdir $docname] + set fd [open $outfile w] + fconfigure $fd -translation binary + puts -nonewline $fd $docgen_header_comments$doctools + close $fd + incr count + lappend newdocs [list $module_fullname $outfile] + } + } + return [list count $count docs $newdocs] + } } } diff --git a/src/bootsupport/modules/punk/mix/templates-0.1.0.tm b/src/bootsupport/modules/punk/mix/templates-0.1.0.tm index 8d52517..46065bd 100644 --- a/src/bootsupport/modules/punk/mix/templates-0.1.0.tm +++ b/src/bootsupport/modules/punk/mix/templates-0.1.0.tm @@ -26,17 +26,19 @@ namespace eval punk::mix::templates { variable pkg punk::mix::templates variable cap_provider - punk::cap::register_package punk::mix::templates [list\ - {punk.templates {relpath ../templates}}\ - ] + #punk::cap::register_package punk::mix::templates [list\ + # {punk.templates {relpath ../templates}}\ + #] + namespace eval capsystem { if {[info commands capprovider.registration] eq ""} { - punk::cap::interface_capprovider.registration create capprovider.registration + punk::cap::class::interface_capprovider.registration create capprovider.registration oo::objdefine capprovider.registration { method get_declarations {} { set decls [list] - lappend decls punk.templates {relpath ../templates} - lappend decls punk.templates {relpath ../templates2} + lappend decls [list punk.templates {relpath ../templates}] + lappend decls [list punk.templates {relpath ../templates2}] + lappend decls [list punk.test {something blah}] return $decls } } @@ -44,7 +46,7 @@ namespace eval punk::mix::templates { } if {[info commands provider] eq ""} { - punk::cap::interface_capprovider.provider create provider + punk::cap::class::interface_capprovider.provider create provider punk::mix::templates oo::objdefine provider { method register {{capabilityname_glob *}} { #puts registering punk::mix::templates $capabilityname diff --git a/src/bootsupport/modules/punkcheck-0.1.0.tm b/src/bootsupport/modules/punkcheck-0.1.0.tm index 41d8759..0dc9523 100644 --- a/src/bootsupport/modules/punkcheck-0.1.0.tm +++ b/src/bootsupport/modules/punkcheck-0.1.0.tm @@ -1078,7 +1078,7 @@ namespace eval punkcheck { } proc install_non_tm_files {srcdir basedir args} { #set keys [dict keys $args] - #adjust the default anti_glob_dir_core entries so that .fossil-custom, .fossil-settings are copied + #adjust the default antiglob_dir_core entries so that .fossil-custom, .fossil-settings are copied set antiglob_dir_core [punkcheck::default_antiglob_dir_core] set posn [lsearch $antiglob_dir_core ".fossil*"] if {$posn >=0} { @@ -1168,7 +1168,7 @@ namespace eval punkcheck { -antiglob_file "" \ -antiglob_dir_core "\uFFFF"\ -antiglob_dir {}\ - -unpublish_paths {}\ + -antiglob_paths {}\ -overwrite no-targets\ -source_checksum comparestore\ -punkcheck_folder target\ @@ -1225,8 +1225,8 @@ namespace eval punkcheck { # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_antiglob_dir [dict get $opts -antiglob_dir] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- - set opt_unpublish_paths [dict get $opts -unpublish_paths] ;#todo - combine with config file in source tree .punkcheckpublish (?) - set unpublish_paths_matched [list] + set opt_antiglob_paths [dict get $opts -antiglob_paths] ;#todo - combine with config file in source tree .punkcheckpublish (?) + set antiglob_paths_matched [list] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set known_whats [list no-targets newer-targets older-targets all-targets installedsourcechanged-targets synced-targets] set overwrite_what [string tolower [dict get $opts -overwrite]]; #accept any case for value to allow emphasis by caller e.g -overwrite NEWER-TARGETS @@ -1347,11 +1347,11 @@ namespace eval punkcheck { if {$target_relative_to_punkcheck_dir eq "."} { set target_relative_to_punkcheck_dir "" } - foreach unpub $opt_unpublish_paths { + foreach unpub $opt_antiglob_paths { #puts "testing folder - globmatchpath $unpub $relative_source_dir" if {[globmatchpath $unpub $relative_source_dir]} { - lappend unpublish_paths_matched $current_source_dir - return [list files_copied {} files_skipped {} sources_unchanged {} punkcheck_records $punkcheck_records unpublish_paths_matched $unpublish_paths_matched srcdir $srcdir tgtdir $tgtdir punkcheck_folder $punkcheck_folder] + lappend antiglob_paths_matched $current_source_dir + return [list files_copied {} files_skipped {} sources_unchanged {} punkcheck_records $punkcheck_records antiglob_paths_matched $antiglob_paths_matched srcdir $srcdir tgtdir $tgtdir punkcheck_folder $punkcheck_folder] } } @@ -1418,16 +1418,16 @@ namespace eval punkcheck { set relative_target_path [file join $relative_target_dir $m] set relative_source_path [file join $relative_source_dir $m] set punkcheck_target_relpath [file join $target_relative_to_punkcheck_dir $m] - set is_unpublished 0 - foreach unpub $opt_unpublish_paths { - #puts "testing file - globmatchpath $unpub vs $relative_source_path" - if {[globmatchpath $unpub $relative_source_path]} { - lappend unpublish_paths_matched $current_source_dir - set is_unpublished 1 + set is_antipath 0 + foreach antipath $opt_antiglob_paths { + #puts "testing file - globmatchpath $antipath vs $relative_source_path" + if {[globmatchpath $antipath $relative_source_path]} { + lappend antiglob_paths_matched $current_source_dir + set is_antipath 1 break } } - if {$is_unpublished} { + if {$is_antipath} { continue } #puts stdout " checking file : $current_source_dir/$m" @@ -1642,7 +1642,7 @@ namespace eval punkcheck { lappend files_copied {*}[dict get $sub_result files_copied] lappend files_skipped {*}[dict get $sub_result files_skipped] lappend sources_unchanged {*}[dict get $sub_result sources_unchanged] - lappend unpublish_paths_matched {*}[dict get $sub_result unpublish_paths_matched] + lappend antiglob_paths_matched {*}[dict get $sub_result antiglob_paths_matched] set punkcheck_records [dict get $sub_result punkcheck_records] } @@ -1664,7 +1664,7 @@ namespace eval punkcheck { } } - return [list files_copied $files_copied files_skipped $files_skipped sources_unchanged $sources_unchanged unpublish_paths_matched $unpublish_paths_matched punkcheck_records $punkcheck_records punkcheck_folder $punkcheck_folder srcdir $srcdir tgtdir $tgtdir] + return [list files_copied $files_copied files_skipped $files_skipped sources_unchanged $sources_unchanged antiglob_paths_matched $antiglob_paths_matched punkcheck_records $punkcheck_records punkcheck_folder $punkcheck_folder srcdir $srcdir tgtdir $tgtdir] } proc summarize_install_resultdict {resultdict} { set msg "" diff --git a/src/bootsupport/modules/textutil-0.9.tm b/src/bootsupport/modules/textutil-0.9.tm new file mode 100644 index 0000000..5925851 --- /dev/null +++ b/src/bootsupport/modules/textutil-0.9.tm @@ -0,0 +1,80 @@ +# textutil.tcl -- +# +# Utilities for manipulating strings, words, single lines, +# paragraphs, ... +# +# Copyright (c) 2000 by Ajuba Solutions. +# Copyright (c) 2000 by Eric Melski +# Copyright (c) 2002 by Joe English +# Copyright (c) 2001-2006 by Andreas Kupries +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: textutil.tcl,v 1.17 2006/09/21 06:46:24 andreas_kupries Exp $ + +# ### ### ### ######### ######### ######### +## Requirements + +package require Tcl 8.2 + +namespace eval ::textutil {} + +# ### ### ### ######### ######### ######### +## API implementation +## All through sub-packages imported here. + +package require textutil::string +package require textutil::repeat +package require textutil::adjust +package require textutil::split +package require textutil::tabify +package require textutil::trim +package require textutil::wcswidth + +namespace eval ::textutil { + # Import the miscellaneous string command for public export + + namespace import -force string::chop string::tail + namespace import -force string::cap string::uncap string::capEachWord + namespace import -force string::longestCommonPrefix + namespace import -force string::longestCommonPrefixList + + # Import the repeat commands for public export + + namespace import -force repeat::strRepeat repeat::blank + + # Import the adjust commands for public export + + namespace import -force adjust::adjust adjust::indent adjust::undent + + # Import the split commands for public export + + namespace import -force split::splitx split::splitn + + # Import the trim commands for public export + + namespace import -force trim::trim trim::trimleft trim::trimright + namespace import -force trim::trimPrefix trim::trimEmptyHeading + + # Import the tabify commands for public export + + namespace import -force tabify::tabify tabify::untabify + namespace import -force tabify::tabify2 tabify::untabify2 + + # Re-export all the imported commands + + namespace export chop tail cap uncap capEachWord + namespace export longestCommonPrefix longestCommonPrefixList + namespace export strRepeat blank + namespace export adjust indent undent + namespace export splitx splitn + namespace export trim trimleft trimright trimPrefix trimEmptyHeading + namespace export tabify untabify tabify2 untabify2 +} + + +# ### ### ### ######### ######### ######### +## Ready + +package provide textutil 0.9 diff --git a/src/bootsupport/modules/textutil/adjust-0.7.3.tm b/src/bootsupport/modules/textutil/adjust-0.7.3.tm new file mode 100644 index 0000000..d47c82f --- /dev/null +++ b/src/bootsupport/modules/textutil/adjust-0.7.3.tm @@ -0,0 +1,761 @@ +# trim.tcl -- +# +# Various ways of trimming a string. +# +# Copyright (c) 2000 by Ajuba Solutions. +# Copyright (c) 2000 by Eric Melski +# Copyright (c) 2002-2004 by Johannes-Heinrich Vogeler +# Copyright (c) 2001-2006 by Andreas Kupries +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: adjust.tcl,v 1.16 2011/12/13 18:12:56 andreas_kupries Exp $ + +# ### ### ### ######### ######### ######### +## Requirements + +package require Tcl 8.2 +package require textutil::repeat +package require textutil::string + +namespace eval ::textutil::adjust {} + +# ### ### ### ######### ######### ######### +## API implementation + +namespace eval ::textutil::adjust { + namespace import -force ::textutil::repeat::strRepeat +} + +proc ::textutil::adjust::adjust {text args} { + if {[string length [string trim $text]] == 0} { + return "" + } + + Configure $args + Adjust text newtext + + return $newtext +} + +proc ::textutil::adjust::Configure {args} { + variable Justify left + variable Length 72 + variable FullLine 0 + variable StrictLength 0 + variable Hyphenate 0 + variable HyphPatterns ; # hyphenation patterns (TeX) + + set args [ lindex $args 0 ] + foreach { option value } $args { + switch -exact -- $option { + -full { + if { ![ string is boolean -strict $value ] } then { + error "expected boolean but got \"$value\"" + } + set FullLine [ string is true $value ] + } + -hyphenate { + # the word exceeding the length of line is tried to be + # hyphenated; if a word cannot be hyphenated to fit into + # the line processing stops! The length of the line should + # be set to a reasonable value! + + if { ![ string is boolean -strict $value ] } then { + error "expected boolean but got \"$value\"" + } + set Hyphenate [string is true $value] + if { $Hyphenate && ![info exists HyphPatterns(_LOADED_)]} { + error "hyphenation patterns not loaded!" + } + } + -justify { + set lovalue [ string tolower $value ] + switch -exact -- $lovalue { + left - + right - + center - + plain { + set Justify $lovalue + } + default { + error "bad value \"$value\": should be center, left, plain or right" + } + } + } + -length { + if { ![ string is integer $value ] } then { + error "expected positive integer but got \"$value\"" + } + if { $value < 1 } then { + error "expected positive integer but got \"$value\"" + } + set Length $value + } + -strictlength { + # the word exceeding the length of line is moved to the + # next line without hyphenation; words longer than given + # line length are cut into smaller pieces + + if { ![ string is boolean -strict $value ] } then { + error "expected boolean but got \"$value\"" + } + set StrictLength [ string is true $value ] + } + default { + error "bad option \"$option\": must be -full, -hyphenate, \ + -justify, -length, or -strictlength" + } + } + } + + return "" +} + +# ::textutil::adjust::Adjust +# +# History: +# rewritten on 2004-04-13 for bugfix tcllib-bugs-882402 (jhv) + +proc ::textutil::adjust::Adjust { varOrigName varNewName } { + variable Length + variable FullLine + variable StrictLength + variable Hyphenate + + upvar $varOrigName orig + upvar $varNewName text + + set pos 0; # Cursor after writing + set line "" + set text "" + + + if {!$FullLine} { + regsub -all -- "(\n)|(\t)" $orig " " orig + regsub -all -- " +" $orig " " orig + regsub -all -- "(^ *)|( *\$)" $orig "" orig + } + + set words [split $orig] + set numWords [llength $words] + set numline 0 + + for {set cnt 0} {$cnt < $numWords} {incr cnt} { + + set w [lindex $words $cnt] + set wLen [string length $w] + + # the word $w doesn't fit into the present line + # case #1: we try to hyphenate + + if {$Hyphenate && ($pos+$wLen >= $Length)} { + # Hyphenation instructions + set w2 [textutil::adjust::Hyphenation $w] + + set iMax [llength $w2] + if {$iMax == 1 && [string length $w] > $Length} { + # word cannot be hyphenated and exceeds linesize + + error "Word \"$w2\" can\'t be hyphenated\ + and exceeds linesize $Length!" + } else { + # hyphenating of $w was successfull, but we have to look + # that every sylable would fit into the line + + foreach x $w2 { + if {[string length $x] >= $Length} { + error "Word \"$w\" can\'t be hyphenated\ + to fit into linesize $Length!" + } + } + } + + for {set i 0; set w3 ""} {$i < $iMax} {incr i} { + set syl [lindex $w2 $i] + if {($pos+[string length " $w3$syl-"]) > $Length} {break} + append w3 $syl + } + for {set w4 ""} {$i < $iMax} {incr i} { + set syl [lindex $w2 $i] + append w4 $syl + } + + if {[string length $w3] && [string length $w4]} { + # hyphenation was successfull: redefine + # list of words w => {"$w3-" "$w4"} + + set x [lreplace $words $cnt $cnt "$w4"] + set words [linsert $x $cnt "$w3-"] + set w [lindex $words $cnt] + set wLen [string length $w] + incr numWords + } + } + + # the word $w doesn't fit into the present line + # case #2: we try to cut the word into pieces + + if {$StrictLength && ([string length $w] > $Length)} { + # cut word into two pieces + set w2 $w + + set over [expr {$pos+2+$wLen-$Length}] + + incr Length -1 + set w3 [string range $w2 0 $Length] + incr Length + set w4 [string range $w2 $Length end] + + set x [lreplace $words $cnt $cnt $w4] + set words [linsert $x $cnt $w3 ] + set w [lindex $words $cnt] + set wLen [string length $w] + incr numWords + } + + # continuing with the normal procedure + + if {($pos+$wLen < $Length)} { + # append word to current line + + if {$pos} {append line " "; incr pos} + append line $w + incr pos $wLen + } else { + # line full => write buffer and begin a new line + + if {[string length $text]} {append text "\n"} + append text [Justification $line [incr numline]] + set line $w + set pos $wLen + } + } + + # write buffer and return! + + if {[string length $text]} {append text "\n"} + append text [Justification $line end] + return $text +} + +# ::textutil::adjust::Justification +# +# justify a given line +# +# Parameters: +# line text for justification +# index index for line in text +# +# Returns: +# the justified line +# +# Remarks: +# Only lines with size not exceeding the max. linesize provided +# for text formatting are justified!!! + +proc ::textutil::adjust::Justification { line index } { + variable Justify + variable Length + variable FullLine + + set len [string length $line]; # length of current line + + if { $Length <= $len } then { + # the length of current line ($len) is equal as or greater than + # the value provided for text formatting ($Length) => to avoid + # inifinite loops we leave $line unchanged and return! + + return $line + } + + # Special case: + # for the last line, and if the justification is set to 'plain' + # the real justification is 'left' if the length of the line + # is less than 90% (rounded) of the max length allowed. This is + # to avoid expansion of this line when it is too small: without + # it, the added spaces will 'unbeautify' the result. + # + + set justify $Justify + if { ( "$index" == "end" ) && \ + ( "$Justify" == "plain" ) && \ + ( $len < round($Length * 0.90) ) } then { + set justify left + } + + # For a left justification, nothing to do, but to + # add some spaces at the end of the line if requested + + if { "$justify" == "left" } then { + set jus "" + if { $FullLine } then { + set jus [strRepeat " " [ expr { $Length - $len } ]] + } + return "${line}${jus}" + } + + # For a right justification, just add enough spaces + # at the beginning of the line + + if { "$justify" == "right" } then { + set jus [strRepeat " " [ expr { $Length - $len } ]] + return "${jus}${line}" + } + + # For a center justification, add half of the needed spaces + # at the beginning of the line, and the rest at the end + # only if needed. + + if { "$justify" == "center" } then { + set mr [ expr { ( $Length - $len ) / 2 } ] + set ml [ expr { $Length - $len - $mr } ] + set jusl [strRepeat " " $ml] + set jusr [strRepeat " " $mr] + if { $FullLine } then { + return "${jusl}${line}${jusr}" + } else { + return "${jusl}${line}" + } + } + + # For a plain justification, it's a little bit complex: + # + # if some spaces are missing, then + # + # 1) sort the list of words in the current line by decreasing size + # 2) foreach word, add one space before it, except if it's the + # first word, until enough spaces are added + # 3) rebuild the line + + if { "$justify" == "plain" } then { + set miss [ expr { $Length - [ string length $line ] } ] + + # Bugfix tcllib-bugs-860753 (jhv) + + set words [split $line] + set numWords [llength $words] + + if {$numWords < 2} { + # current line consists of less than two words - we can't + # insert blanks to achieve a plain justification => leave + # $line unchanged and return! + + return $line + } + + for {set i 0; set totalLen 0} {$i < $numWords} {incr i} { + set w($i) [lindex $words $i] + if {$i > 0} {set w($i) " $w($i)"} + set wLen($i) [string length $w($i)] + set totalLen [expr {$totalLen+$wLen($i)}] + } + + set miss [expr {$Length - $totalLen}] + + # len walks through all lengths of words of the line under + # consideration + + for {set len 1} {$miss > 0} {incr len} { + for {set i 1} {($i < $numWords) && ($miss > 0)} {incr i} { + if {$wLen($i) == $len} { + set w($i) " $w($i)" + incr wLen($i) + incr miss -1 + } + } + } + + set line "" + for {set i 0} {$i < $numWords} {incr i} { + set line "$line$w($i)" + } + + # End of bugfix + + return "${line}" + } + + error "Illegal justification key \"$justify\"" +} + +proc ::textutil::adjust::SortList { list dir index } { + + if { [ catch { lsort -integer -$dir -index $index $list } sl ] != 0 } then { + error "$sl" + } + + return $sl +} + +# Hyphenation utilities based on Knuth's algorithm +# +# Copyright (C) 2001-2003 by Dr.Johannes-Heinrich Vogeler (jhv) +# These procedures may be used as part of the tcllib + +# textutil::adjust::Hyphenation +# +# Hyphenate a string using Knuth's algorithm +# +# Parameters: +# str string to be hyphenated +# +# Returns: +# the hyphenated string + +proc ::textutil::adjust::Hyphenation { str } { + + # if there are manual set hyphenation marks e.g. "Recht\-schrei\-bung" + # use these for hyphenation and return + + if {[regexp {[^\\-]*[\\-][.]*} $str]} { + regsub -all {(\\)(-)} $str {-} tmp + return [split $tmp -] + } + + # Don't hyphenate very short words! Minimum length for hyphenation + # is set to 3 characters! + + if { [string length $str] < 4 } then { return $str } + + # otherwise follow Knuth's algorithm + + variable HyphPatterns; # hyphenation patterns (TeX) + + set w ".[string tolower $str]."; # transform to lower case + set wLen [string length $w]; # and add delimiters + + # Initialize hyphenation weights + + set s {} + for {set i 0} {$i < $wLen} {incr i} { + lappend s 0 + } + + for {set i 0} {$i < $wLen} {incr i} { + set kmax [expr {$wLen-$i}] + for {set k 1} {$k < $kmax} {incr k} { + set sw [string range $w $i [expr {$i+$k}]] + if {[info exists HyphPatterns($sw)]} { + set hw $HyphPatterns($sw) + set hwLen [string length $hw] + for {set l1 0; set l2 0} {$l1 < $hwLen} {incr l1} { + set c [string index $hw $l1] + if {[string is digit $c]} { + set sPos [expr {$i+$l2}] + if {$c > [lindex $s $sPos]} { + set s [lreplace $s $sPos $sPos $c] + } + } else { + incr l2 + } + } + } + } + } + + # Replace all even hyphenation weigths by zero + + for {set i 0} {$i < [llength $s]} {incr i} { + set c [lindex $s $i] + if {!($c%2)} { set s [lreplace $s $i $i 0] } + } + + # Don't start with a hyphen! Take also care of words enclosed in quotes + # or that someone has forgotten to put a blank between a punctuation + # character and the following word etc. + + for {set i 1} {$i < ($wLen-1)} {incr i} { + set c [string range $w $i end] + if {[regexp {^[:alpha:][.]*} $c]} { + for {set k 1} {$k < ($i+1)} {incr k} { + set s [lreplace $s $k $k 0] + } + break + } + } + + # Don't separate the last character of a word with a hyphen + + set max [expr {[llength $s]-2}] + if {$max} {set s [lreplace $s $max end 0]} + + # return the syllabels of the hyphenated word as a list! + + set ret "" + set w ".$str." + for {set i 1} {$i < ($wLen-1)} {incr i} { + if {[lindex $s $i]} { append ret - } + append ret [string index $w $i] + } + return [split $ret -] +} + +# textutil::adjust::listPredefined +# +# Return the names of the hyphenation files coming with the package. +# +# Parameters: +# None. +# +# Result: +# List of filenames (without directory) + +proc ::textutil::adjust::listPredefined {} { + variable here + return [glob -type f -directory $here -tails *.tex] +} + +# textutil::adjust::getPredefined +# +# Retrieve the full path for a predefined hyphenation file +# coming with the package. +# +# Parameters: +# name Name of the predefined file. +# +# Results: +# Full path to the file, or an error if it doesn't +# exist or is matching the pattern *.tex. + +proc ::textutil::adjust::getPredefined {name} { + variable here + + if {![string match *.tex $name]} { + return -code error \ + "Illegal hyphenation file \"$name\"" + } + set path [file join $here $name] + if {![file exists $path]} { + return -code error \ + "Unknown hyphenation file \"$path\"" + } + return $path +} + +# textutil::adjust::readPatterns +# +# Read hyphenation patterns from a file and store them in an array +# +# Parameters: +# filNam name of the file containing the patterns + +proc ::textutil::adjust::readPatterns { filNam } { + + variable HyphPatterns; # hyphenation patterns (TeX) + + # HyphPatterns(_LOADED_) is used as flag for having loaded + # hyphenation patterns from the respective file (TeX format) + + if {[info exists HyphPatterns(_LOADED_)]} { + unset HyphPatterns(_LOADED_) + } + + # the array xlat provides translation from TeX encoded characters + # to those of the ISO-8859-1 character set + + set xlat(\"s) \337; # 223 := sharp s " + set xlat(\`a) \340; # 224 := a, grave + set xlat(\'a) \341; # 225 := a, acute + set xlat(\^a) \342; # 226 := a, circumflex + set xlat(\"a) \344; # 228 := a, diaeresis " + set xlat(\`e) \350; # 232 := e, grave + set xlat(\'e) \351; # 233 := e, acute + set xlat(\^e) \352; # 234 := e, circumflex + set xlat(\`i) \354; # 236 := i, grave + set xlat(\'i) \355; # 237 := i, acute + set xlat(\^i) \356; # 238 := i, circumflex + set xlat(\~n) \361; # 241 := n, tilde + set xlat(\`o) \362; # 242 := o, grave + set xlat(\'o) \363; # 243 := o, acute + set xlat(\^o) \364; # 244 := o, circumflex + set xlat(\"o) \366; # 246 := o, diaeresis " + set xlat(\`u) \371; # 249 := u, grave + set xlat(\'u) \372; # 250 := u, acute + set xlat(\^u) \373; # 251 := u, circumflex + set xlat(\"u) \374; # 252 := u, diaeresis " + + set fd [open $filNam RDONLY] + set status 0 + + while {[gets $fd line] >= 0} { + + switch -exact $status { + PATTERNS { + if {[regexp {^\}[.]*} $line]} { + # End of patterns encountered: set status + # and ignore that line + set status 0 + continue + } else { + # This seems to be pattern definition line; to process it + # we have first to do some editing + # + # 1) eat comments in a pattern definition line + # 2) eat braces and coded linefeeds + + set z [string first "%" $line] + if {$z > 0} { set line [string range $line 0 [expr {$z-1}]] } + + regsub -all {(\\n|\{|\})} $line {} tmp + set line $tmp + + # Now $line should consist only of hyphenation patterns + # separated by white space + + # Translate TeX encoded characters to ISO-8859-1 characters + # using the array xlat defined above + + foreach x [array names xlat] { + regsub -all {$x} $line $xlat($x) tmp + set line $tmp + } + + # split the line and create a lookup array for + # the repective hyphenation patterns + + foreach item [split $line] { + if {[string length $item]} { + if {![string match {\\} $item]} { + # create index for hyphenation patterns + + set var $item + regsub -all {[0-9]} $var {} idx + # store hyphenation patterns as elements of an array + + set HyphPatterns($idx) $item + } + } + } + } + } + EXCEPTIONS { + if {[regexp {^\}[.]*} $line]} { + # End of patterns encountered: set status + # and ignore that line + set status 0 + continue + } else { + # to be done in the future + } + } + default { + if {[regexp {^\\endinput[.]*} $line]} { + # end of data encountered, stop processing and + # ignore all the following text .. + break + } elseif {[regexp {^\\patterns[.]*} $line]} { + # begin of patterns encountered: set status + # and ignore that line + set status PATTERNS + continue + } elseif {[regexp {^\\hyphenation[.]*} $line]} { + # some particular cases to be treated separately + set status EXCEPTIONS + continue + } else { + set status 0 + } + } + } + } + + close $fd + set HyphPatterns(_LOADED_) 1 + + return +} + +####################################################### + +# @c The specified block is indented +# @c by ing each line. The first +# @c lines ares skipped. +# +# @a text: The paragraph to indent. +# @a prefix: The string to use as prefix for each line +# @a prefix: of with. +# @a skip: The number of lines at the beginning to leave untouched. +# +# @r Basically , but indented a certain amount. +# +# @i indent +# @n This procedure is not checked by the testsuite. + +proc ::textutil::adjust::indent {text prefix {skip 0}} { + set text [string trimright $text] + + set res [list] + foreach line [split $text \n] { + if {[string compare "" [string trim $line]] == 0} { + lappend res {} + } else { + set line [string trimright $line] + if {$skip <= 0} { + lappend res $prefix$line + } else { + lappend res $line + } + } + if {$skip > 0} {incr skip -1} + } + return [join $res \n] +} + +# Undent the block of text: Compute LCP (restricted to whitespace!) +# and remove that from each line. Note that this preverses the +# shaping of the paragraph (i.e. hanging indent are _not_ flattened) +# We ignore empty lines !! + +proc ::textutil::adjust::undent {text} { + + if {$text == {}} {return {}} + + set lines [split $text \n] + set ne [list] + foreach l $lines { + if {[string length [string trim $l]] == 0} continue + lappend ne $l + } + set lcp [::textutil::string::longestCommonPrefixList $ne] + + if {[string length $lcp] == 0} {return $text} + + regexp "^(\[\t \]*)" $lcp -> lcp + + if {[string length $lcp] == 0} {return $text} + + set len [string length $lcp] + + set res [list] + foreach l $lines { + if {[string length [string trim $l]] == 0} { + lappend res {} + } else { + lappend res [string range $l $len end] + } + } + return [join $res \n] +} + +# ### ### ### ######### ######### ######### +## Data structures + +namespace eval ::textutil::adjust { + variable here [file dirname [info script]] + + variable Justify left + variable Length 72 + variable FullLine 0 + variable StrictLength 0 + variable Hyphenate 0 + variable HyphPatterns + + namespace export adjust indent undent +} + +# ### ### ### ######### ######### ######### +## Ready + +package provide textutil::adjust 0.7.3 diff --git a/src/bootsupport/modules/textutil/dehypht.tex b/src/bootsupport/modules/textutil/dehypht.tex new file mode 100644 index 0000000..8f1dfb0 --- /dev/null +++ b/src/bootsupport/modules/textutil/dehypht.tex @@ -0,0 +1,902 @@ +% This is `dehypht.tex' as of 03 March 1999. +% +% Copyright (C) 1988,1991 Rechenzentrum der Ruhr-Universitaet Bochum +% [german hyphen patterns] +% Copyright (C) 1993,1994,1999 Bernd Raichle/DANTE e.V. +% [macros, adaption for TeX 2] +% +% ----------------------------------------------------------------- +% IMPORTANT NOTICE: +% +% This program can be redistributed and/or modified under the terms +% of the LaTeX Project Public License Distributed from CTAN +% archives in directory macros/latex/base/lppl.txt; either +% version 1 of the License, or any later version. +% ----------------------------------------------------------------- +% +% +% This file contains german hyphen patterns following traditional +% hyphenation rules and includes umlauts and sharp s, but without +% `c-k' and triple consonants. It is based on hyphen patterns +% containing 5719 german hyphen patterns with umlauts in the +% recommended version of September 27, 1990. +% +% For use with TeX generated by +% +% Norbert Schwarz +% Rechenzentrum Ruhr-Universitaet Bochum +% Universitaetsstrasse 150 +% D-44721 Bochum, FRG +% +% +% Adaption of these patterns for TeX, Version 2.x and 3.x and +% all fonts in T1/`Cork'/EC/DC and/or OT1/CM encoding by +% +% Bernd Raichle +% Stettener Str. 73 +% D-73732 Esslingen, FRG +% Email: raichle@Informatik.Uni-Stuttgart.DE +% +% +% Error reports in case of UNCHANGED versions to +% +% DANTE e.V., Koordinator `german.sty' +% Postfach 10 18 40 +% D-69008 Heidelberg, FRG +% Email: german@Dante.DE +% +% or one of the addresses given above. +% +% +% Changes: +% 1990-09-27 First version of `ghyphen3.tex' (Norbert Schwarz) +% 1991-02-13 PC umlauts changed to ^^xx (Norbert Schwarz) +% 1993-08-27 Umlauts/\ss changed to "a/\3 macros, added macro +% definitions and additional logic to select correct +% patterns/encoding (Bernd Raichle) +% 1994-02-13 Release of `ghyph31.tex' V3.1a (Bernd Raichle) +% 1999-03-03 Renamed file to `dehypht.tex' according to the +% naming scheme using the ISO country code `de', the +% common part `hyph' for all hyphenation patterns files, +% and the additional postfix `t' for traditional, +% removed wrong catcode change of ^^e (the comment +% character %) and ^^f (the character &), +% do _not_ change \catcode, \lccode, \uccode to avoid +% problems with other hyphenation pattern files, +% changed code to distinguish TeX 2.x/3.x, +% changed license conditions to LPPL (Bernd Raichle) +% +% +% For more information see the additional documentation +% at the end of this file. +% +% ----------------------------------------------------------------- +% +\message{German Traditional Hyphenation Patterns % + `dehypht' Version 3.2a <1999/03/03>} +\message{(Formerly known under the name `ghyph31' and `ghyphen'.)} +% +% +% Next we define some commands which are used inside the patterns. +% To keep them local, we enclose the rest of the file in a group +% (The \patterns command globally changes the hyphenation trie!). +% +\begingroup +% +% +% Make sure that doublequote is not active: +\catcode`\"=12 +% +% +% Because ^^e4 is used in the following macros which is read by +% TeX 2.x as ^^e or %, the comment character of TeX, some trick +% has to be found to avoid this problem. The same is true for the +% character ^^f or & in the TeX 2.x code. +% Therefore in the code the exclamationmark ! is used instead of +% the circumflex ^ and its \catcode is set appropriately +% (normally \catcode`\!=12, in the code \catcode`\!=7). +% +% The following \catcode, \lccode assignments and macro definitions +% are defined in such a way that the following \pattern{...} list +% can be used for both, TeX 2.x and TeX 3.x. +% +% We first change the \lccode of ^^Y to make sure that we can +% include this character in the hyphenation patterns. +% +\catcode`\^^Y=11 \lccode`\^^Y=`\^^Y +% +% Then we have to define some macros depending on the TeX version. +% Therefore we have to distinguish TeX version 2.x and 3.x: +% +\ifnum`\@=`\^^40 % true => TeX 3.x + % + % For TeX 3: + % ---------- + % + % Assign appropriate \catcode and \lccode values for all + % accented characters used in the patterns (\uccode changes are + % not used within \patterns{...} and thus not necessary): + % + \catcode"E4=11 \catcode"C4=11 % \"a \"A + \catcode"F6=11 \catcode"D6=11 % \"o \"O + \catcode"FC=11 \catcode"DC=11 % \"u \"U + \catcode"FF=11 \catcode"DF=11 % \ss SS + % + \lccode"C4="E4 \uccode"C4="C4 \lccode"E4="E4 \uccode"E4="C4 + \lccode"D6="F6 \uccode"D6="D6 \lccode"F6="F6 \uccode"F6="D6 + \lccode"DC="FC \uccode"DC="DC \lccode"FC="FC \uccode"FC="DC + \lccode"DF="FF \uccode"DF="DF \lccode"FF="FF \uccode"FF="DF + % + % In the following definitions we use ??xy instead of ^^xy + % to avoid errors when reading the following macro definitions + % with TeX 2.x (remember ^^e(4) is the comment character): + % + \catcode`\?=7 + % + % Define the accent macro " in such a way that it + % expands to single letters in font encoding T1. + \catcode`\"=13 + \def"#1{\ifx#1a??e4\else \ifx#1o??f6\else \ifx#1u??fc\else + \errmessage{Hyphenation pattern file corrupted!}% + \fi\fi\fi} + % + % - patterns with umlauts are ok + \def\n#1{#1} + % + % For \ss which exists in T1 _and_ OT1 encoded fonts but with + % different glyph codes, duplicated patterns for both encodings + % are included. Thus you can use these hyphenation patterns for + % T1 and OT1 encoded fonts: + % - define \3 to be code `\^^ff (\ss in font encoding T1) + % - define \9 to be code `\^^Y (\ss in font encoding OT1) + \def\3{??ff} + \def\9{??Y} + % - duplicated patterns to support font encoding OT1 are ok + \def\c#1{#1} + % >>>>>> UNCOMMENT the next line, if you do not want + % >>>>>> to use fonts in font encoding OT1 + %\def\c#1{} + % + \catcode`\?=12 + % +\else + % + % For TeX 2: + % ---------- + % + % Define the accent macro " to throw an error message. + \catcode`\"=13 + \def"#1{\errmessage{Hyphenation pattern file corrupted!}} + % + % - ignore all patterns with umlauts + \def\n#1{} + % + % With TeX 2 fonts in encoding T1 can be used, but all glyphs + % in positions > 127 can not be used in hyphenation patterns. + % Thus only patterns with glyphs in OT1 positions are included: + % - define \3 to be code ^^Y (\ss in CM font encoding) + % - define \9 to throw an error message + \def\3{^^Y} + \def\9{\errmessage{Hyphenation pattern file corrupted!}} + % - ignore all duplicated patterns with \ss in T1 encoding + \def\c#1{} + % +\fi +% +% +\patterns{% +.aa6l .ab3a4s .ab3ei .abi2 .ab3it .ab1l .ab1r .ab3u .ad3o4r .alti6 +.ana3c .an5alg .an1e .ang8s .an1s .ap1p .ar6sc .ar6ta .ar6tei .as2z +.au2f1 .au2s3 .be5erb .be3na .ber6t5r .bie6r5 .bim6s5t .brot3 .bru6s +.ch6 .che6f5 .da8c .da2r .dar5in .dar5u .den6ka .de5r6en .des6pe +.de8spo .de3sz .dia3s4 .dien4 .dy2s1 .ehren5 .eine6 .ei6n5eh .ei8nen +.ein5sa .en6der .en6d5r .en3k4 .en8ta8 .en8tei .en4t3r .epo1 .er6ban +.er6b5ei .er6bla .er6d5um .er3ei .er5er .er3in .er3o4b .erwi5s .es1p +.es8t .ex1a2 .ex3em .fal6sc .fe6st5a .flu4g3 .furch8 .ga6ner .ge3n4a +\n{.ge5r"o} .ges6 .halb5 .halbe6 .hal6br .haup4 .hau4t .heima6 .he4r3e +.her6za .he5x .hin3 .hir8sc .ho4c .hu3sa .hy5o .ibe5 .ima6ge .in1 +.ini6 .is5chi .jagd5 .kal6k5o .ka6ph .ki4e .kop6f3 .kraf6 \n{.k"u5ra} +.lab6br .liie6 .lo6s5k \n{.l"o4s3t} .ma5d .mi2t1 .no6th .no6top +.obe8ri .ob1l .obs2 .ob6st5e .or3c .ort6s5e .ost3a .oste8r .pe4re +.pe3ts .ph6 .po8str .rau4m3 .re5an .ro8q .ru5the \n{.r"u5be} +\n{.r"u8stet} .sch8 .se6e .se5n6h .se5ra .si2e .spi6ke .st4 .sy2n +.tages5 .tan6kl .ta8th .te6e .te8str .to6der .to8nin .to6we .um1 +.umpf4 .un1 .une6 .unge5n .ur1c .ur5en .ve6rin .vora8 .wah6l5 .we8ges +.wo6r .wor3a .wun4s .zi4e .zuch8 \n{."ande8re} \n{."och8} aa1c aa2gr +aal5e aa6r5a a5arti aa2s1t aat2s 6aba ab3art 1abdr 6abel aben6dr +ab5erk ab5err ab5esse 1abf 1abg \n{1abh"a} ab1ir 1abko a1bl ab1la +5ablag a6bla\3 \c{a6bla\9} ab4ler ab1lu \n{a8bl"a} \n{5a6bl"o} abma5c +1abn ab1ra ab1re 5a6brec ab1ro ab1s ab8sk abs2z 3abtei ab1ur 1abw +5abze 5abzu \n{ab1"an} \n{ab"au8} a4ce. a5chal ach5art ach5au a1che +a8chent ach6er. a6ch5erf a1chi ach1l ach3m ach5n a1cho ach3re a1chu +ach1w a1chy \n{ach5"af} ack1o acks6t ack5sta a1d 8ad. a6d5ac ad3ant +ad8ar 5addi a8dein ade5o8 adi5en 1adj 1adle ad1op a2dre 3adres adt1 +1adv \n{a6d"a} a1e2d ae1r a1er. 1aero 8afa a3fal af1an a5far a5fat +af1au a6fentl a2f1ex af1fr af5rau af1re 1afri af6tent af6tra aft5re +a6f5um \n{8af"a} ag5abe 5a4gent ag8er ages5e 1aggr ag5las ag1lo a1gn +ag2ne 1agog a6g5und a1ha a1he ah5ein a4h3erh a1hi ahl1a ah1le ah4m3ar +ahn1a a5ho ahra6 ahr5ab ah1re ah8rei ahren8s ahre4s3 ahr8ti ah1ru a1hu +\n{ah8"o} ai3d2s ai1e aif6 a3inse ai4re. a5isch. ais8e a3ismu ais6n +aiso6 a1j 1akad a4kade a1ke a1ki 1akko 5akro1 a5lal al5ans 3al8arm +al8beb al8berw alb5la 3album al1c a1le a6l5e6be a4l3ein a8lel a8lerb +a8lerh a6lert 5a6l5eth 1algi al4gli al3int al4lab al8lan al4l3ar +alle3g a1lo a4l5ob al6schm al4the altist5 al4t3re 8a1lu alu5i a6lur +alu3ta \n{a1l"a} a6mate 8ame. 5a6meise am6m5ei am6mum am2n ampf3a +am6schw am2ta a1mu \n{a1m"a} a3nac a1nad anadi5e an3ako an3alp 3analy +an3ame an3ara a1nas an5asti a1nat anat5s an8dent ande4s3 an1ec an5eis +an1e2k 4aner. a6n5erd a8nerf a6n5erke 1anfa 5anfert \n{1anf"a} 3angab +5angebo an3gli ang6lis an2gn 3angri ang5t6 \n{5anh"a} ani5g ani4ka +an5i8on an1kl an6kno an4kro 1anl anma5c anmar4 3annah anne4s3 a1no +5a6n1o2d 5a6n3oma 5a6nord 1anr an1sa 5anschl an4soz an1st 5anstal +an1s2z 5antenn an1th \n{5anw"a} a5ny an4z3ed 5anzeig 5anzieh 3anzug +\n{an1"a} \n{5an"as} \n{a1n"o} \n{an"o8d} a1os a1pa 3apfel a2ph1t +\n{aph5"a6} a1pi 8apl apo1c apo1s a6poste a6poth 1appa ap1pr a1pr +\n{a5p"a} \n{a3p"u} a1ra a4r3af ar3all 3arbei 2arbt ar1c 2a1re ar3ein +ar2gl 2a1ri ari5es ar8kers ar6les ar4nan ar5o6ch ar1o2d a1rol ar3ony +a8ror a3ros ar5ox ar6schl 8artei ar6t5ri a1ru a1ry 1arzt arz1w +\n{ar8z"a} \n{ar"a8m} \n{ar"o6} \n{ar5"om} \n{ar1"u2} a1sa a6schec +asch5l asch3m a6schn a3s4hi as1pa asp5l a8steb as5tev 1asth a6stoc +a1str ast3re 8a1ta ata5c ata3la a6tapf ata5pl a1te a6teli aten5a +ate5ran 6atf 6atg a1th at3hal 1athl 2a1ti 5atlant 3atlas 8atmus 6atn +a1to a6t5ops ato6ra a6t5ort. 4a1tr a6t5ru at2t1h \n{at5t6h"a} 6a1tu +atz1w \n{a1t"a} \n{a1t"u} au1a au6bre auch3a au1e aue4l 5aufent +\n{3auff"u} 3aufga 1aufn auf1t 3auftr 1aufw 3auge. au4kle aule8s 6aum +au8mar aum5p 1ausb 3ausd 1ausf 1ausg au8sin 3auss au4sta 1ausw 1ausz +aut5eng au1th 1auto au\3e8 \c{au\9e8} a1v ave5r6a aver6i a1w a6wes a1x +a2xia a6xio a1ya a1z azi5er. 8a\3 \c{8a\9} 1ba 8ba8del ba1la ba1na +ban6k5r ba5ot bardi6n ba1ro basten6 bau3sp 2b1b bb6le b2bli 2b1c 2b1d +1be be1a be8at. be1ch 8becht 8becke. be5el be1en bee8rei be5eta bef2 +8beff be1g2 \n{beh"o8} bei1s 6b5eisen bei3tr b8el bel8o belu3t be3nac +bend6o be6ners be6nerw be4nor ben4se6 bens5el \n{be1n"a} \n{be1n"u} +be1o2 b8er. be1ra be8rac ber8gab. ber1r \n{be1r"u} bes8c bes5erh +bes2p be5tha bet5sc be1un be1ur 8bex be6zwec 2b1f8 bfe6st5e 2b1g2 +bga2s5 bge1 2b1h bhole6 1bi bi1bl b6ie bi1el bi1la \n{bil"a5} bi1na +bi4nok bi5str bi6stu bi5tr bit4t5r b1j 2b1k2 \n{bk"u6} bl8 b6la. +6b1lad 6blag 8blam 1blat b8latt 3blau. b6lav 3ble. b1leb b1led +8b1leg 8b1leh 8bleid 8bleih 6b3lein blei3s ble4m3o 4blich b4lind +8bling b2lio 5blit b4litz b1loh 8b1los 1blu 5blum 2blun blut3a blut5sc +\n{3bl"a} \n{bl"as5c} \n{5bl"o} \n{3bl"u} \n{bl"u8sc} 2b1m 2b1n 1bo +bo1ch bo5d6s boe5 8boff 8bonk bo1ra b1ort 2b1p2 b1q 1br brail6 brast8 +bre4a b5red 8bref 8b5riem b6riga bro1s b1rup b2ruz \n{8br"oh} +\n{br"os5c} 8bs b1sa b8sang b2s1ar b1sc bs3erl bs3erz b8sof b1s2p +bst1h b3stru \n{b5st"a} b6sun 2b1t b2t1h 1bu bu1ie bul6k b8ure bu6sin +6b1v 2b1w 1by1 by6te. 8b1z bzi1s \n{1b"a} \n{b5"a6s5} \n{1b"u} +\n{b6"u5bere} \n{b"uge6} \n{b"ugel5e} \n{b"ur6sc} 1ca cag6 ca5la ca6re +ca5y c1c 1ce celi4c celich5 ce1ro c8h 2ch. 1chae ch1ah ch3akt cha6mer +8chanz 5chara 3chari 5chato 6chb 1chef 6chei ch3eil ch3eis 6cherkl +6chf 4chh 5chiad 5chias 6chins 8chj chl6 5chlor 6ch2m 2chn6 ch8nie +5cho. 8chob choi8d 6chp ch3ren ch6res \n{ch3r"u} 2chs 2cht cht5ha +cht3hi 5chthon ch6tin 6chuh chu4la 6ch3unt chut6t 8chw 1ci ci5tr c2k +2ck. ck1ei 4ckh ck3l ck3n ck5o8f ck1r 2cks ck5stra ck6s5u c2l 1c8o +con6ne 8corb cos6t c3q 1c6r 8c1t 1cu 1cy \n{5c"a1} \n{c"o5} 1da. +8daas 2dabg 8dabr 6dabt 6dabw 1dac da2gr 6d5alk 8d5amt dan6ce. +dani5er dan8ker 2danl danla6 6dans 8danzi 6danzu d1ap da2r1a8 2d1arb +d3arc dar6men 4d3art 8darz 1dat 8datm 2d1auf 2d1aus 2d1b 2d1c 2d1d +d5de d3d2h \n{dd"amme8} 1de 2deal de5an de3cha de1e defe6 6deff 2d1ehr +5d4eic de5isc de8lar del6s5e del6spr de4mag de8mun de8nep dene6r +8denge. 8dengen de5o6d 2deol de5ram 8derdb der5ein de1ro der1r d8ers +der5um de4s3am de4s3an de4sau de6sil de4sin de8sor de4spr de2su 8deul +de5us. 2d1f df2l 2d1g 2d1h 1di dia5c di5ara dice5 di3chr di5ena di1gn +di1la dil8s di1na 8dind 6dinf 4d3inh 2d1ins di5o6d di3p4t di8sen dis1p +di5s8per di6s5to dis5tra di8tan di8tin d1j 6dje 2dju 2d1k 2d1l 2d1m +2d1n6 dni6 dnje6 1do 6d5obe do6berf 6d5ony do3ran 6dord 2d1org dor4t3h +do6ste 6doth dott8e 2d1p d5q dr4 1drah 8drak d5rand 6dre. 4drech +d6reck 4d3reg 8d3reic d5reife 8drem 8d1ren 2drer 8dres. 6d5rh 1dria +d1ric 8drind droi6 dro5x 1dru 8drut \n{dr"os5c} \n{1dr"u} \n{dr"u5b} +\n{dr"u8sc} 2ds d1sa d6san dsat6 d1sc 5d6scha. 5dschik dse8e d8serg +8dsl d1sp d4spak ds2po \n{d8sp"a} d1st \n{d1s"u} 2dt d1ta d1te d1ti +d1to dt1s6 d1tu \n{d5t"a} 1du du5als du1b6 du1e duf4t3r 4d3uh du5ie +8duml 8dumw 2d1und du8ni 6d5unt dur2c durch3 6durl 6dursa 8durt du1s +du8schr 2d1v 2d1w dwa8l 2d1z \n{1d"a} \n{6d"ah} \n{8d"and} \n{d"a6r} +\n{d"o8bl} \n{d5"ol} \n{d"or6fl} \n{d"o8sc} \n{d5"o4st} \n{d"os3te} +\n{1d"u} ea4ben e1ac e1ah e1akt e1al. e5alf e1alg e5a8lin e1alk e1all +e5alp e1alt e5alw e1am e1and ea6nim e1ar. e5arf e1ark e5arm e3art +e5at. e6ate e6a5t6l e8ats e5att e6au. e1aus e1b e6b5am ebens5e +eb4lie eb4ser eb4s3in e1che e8cherz e1chi ech3m 8ech3n ech1r ech8send +ech4su e1chu eck5an e5cl e1d ee5a ee3e ee5g e1ei ee5isc eei4s3t +ee6lend e1ell \n{ee5l"o} e1erd ee3r4e ee8reng eere6s5 \n{ee5r"a} +ee6tat e1ex e1f e6fau e8fe8b 3effek ef3rom ege6ra eglo6si 1egy e1ha +e6h5ach eh5ans e6hap eh5auf e1he e1hi ehl3a eh1le ehl5ein eh1mu ehn5ec +e1ho ehr1a eh1re ehre6n eh1ri eh1ru ehr5um e1hu eh1w e1hy \n{e1h"a} +\n{e1h"o} \n{e3h"ut} ei1a eia6s ei6bar eich3a eich5r ei4dar ei6d5ei +ei8derf ei3d4sc ei1e 8eifen 3eifri 1eign eil1d ei6mab ei8mag ein1a4 +ei8nat ei8nerh ei8ness ei6nete ein1g e8ini ein1k ei6n5od ei8nok ei4nor +\n{e3ins"a} ei1o e1irr ei5ru ei8sab ei5schn ei6s5ent ei8sol ei4t3al +eit3ar eit1h ei6thi ei8tho eit8samt ei6t5um e1j 1ekd e1ke e1ki e1k2l +e1kn ekni4 e1la e2l1al 6elan e6lanf e8lanl e6l5ans el3arb el3arm +e6l3art 5e6lasti e6lauge elbst5a e1le 6elef ele6h e6l5ehe e8leif +e6l5einh 1elek e8lel 3eleme e6lemen e6lente el5epi e4l3err e6l5ersc +elf2l elg2 e6l5ins ell8er 4e1lo e4l3ofe el8soh el8tent 5eltern e1lu +elut2 \n{e1l"a} \n{e1l"u} em8dei em8meis 4emo emo5s 1emp1f 1empt 1emto +e1mu emurk4 emurks5 \n{e1m"a} en5a6ben en5achs en5ack e1nad en5af +en5all en3alt en1am en3an. en3ant en3anz en1a6p en1ar en1a6s 6e1nat +en3auf en3aus en2ce enda6l end5erf end5erg en8dess 4ene. en5eck +e8neff e6n5ehr e6n5eim en3eis 6enem. 6enen e4nent 4ener. e8nerd +e6n3erf e4nerg 5energi e6n5erla en5ers e6nerst en5erw 6enes e6n5ess +e2nex en3glo 2eni enni6s5 ennos4 enns8 e1no e6nober eno8f en5opf +e4n3ord en8sers ens8kl en1sp ens6por en5t6ag enta5go en8terbu en6tid +3entla ent5ric 5entwic 5entwu 1entz enu5i e3ny en8zan \n{en1"of} +\n{e1n"os} \n{e1n"ug} eo1c e5o6fe e5okk e1on. e3onf e5onk e5onl e5onr +e5opf e5ops e5or. e1ord e1org eo5r6h eo1t e1pa e8pee e6p5e6g ep5ent +e1p2f e1pi 5epid e6pidem e1pl 5epos e6pos. ep4p3a e1pr \n{e1p"a} e1q +e1ra. er5aal 8eraba e5rabel er5a6ben e5rabi er3abs er3ach era5e +era5k6l er3all er3amt e3rand e3rane er3ans e5ranz. e1rap er3arc +e3rari er3a6si e1rat erat3s er3auf e3raum 3erbse er1c e1re 4e5re. +er3eck er5egg er5e2h 2erei e3rei. e8reine er5einr 6eren. e4r3enm +4erer. e6r5erm er5ero er5erst e4r3erz er3ess \n{5erf"ul} er8gan. +5ergebn er2g5h \n{5erg"anz} \n{5erh"ohu} 2e1ri eri5ak e6r5iat e4r3ind +e6r5i6n5i6 er5ins e6r5int er5itio er1kl \n{3erkl"a} \n{5erl"os.} +ermen6s er6nab 3ernst 6e1ro. e1rod er1o2f e1rog 6e3roi ero8ide e3rol +e1rom e1ron e3rop8 e2r1or e1ros e1rot er5ox ersch4 5erstat er6t5ein +er2t1h er5t6her 2e1ru eruf4s3 e4r3uhr er3ums e5rus 5erwerb e1ry er5zwa +er3zwu \n{er"a8m} \n{er5"as} \n{er"o8} \n{e3r"os.} \n{e6r1"u2b} e1sa +esa8b e8sap e6s5a6v e1sc esch4l ese1a es5ebe eserve5 e8sh es5ill +es3int es4kop e2sl eso8b e1sp espei6s5 es2po es2pu 5essenz e6stabs +e6staf e6st5ak est3ar e8stob e1str est5res es3ur e2sz \n{e1s"u} e1ta +et8ag etari5e eta8ta e1te eten6te et5hal e5thel e1ti 1etn e1to e1tr +et3rec e8tscha et8se et6tei et2th et2t1r e1tu etu1s et8zent et8zw +\n{e1t"a} \n{e1t"o} \n{e1t"u} eu1a2 eu1e eue8rei eu5fe euin5 euk2 +e1um. eu6nio e5unter eu1o6 eu5p 3europ eu1sp eu5str eu8zo e1v eval6s +eve5r6en ever4i e1w e2wig ex1or 1exp 1extr ey3er. e1z \n{e1"a2} +\n{e5"o8} \n{e1"u} e8\3es \c{e8\9es} fa6ch5i fade8 fa6del fa5el. +fal6lo falt8e fa1na fan4gr 6fanl 6fap far6ba far4bl far6r5a 2f1art +fa1sc fau8str fa3y 2f1b2 6f1c 2f1d 1fe 2f1eck fe6dr feh6lei f6eim +8feins f5eis fel5en 8feltern 8femp fe5rant 4ferd. ferri8 fe8stof +fe6str fe6stum fe8tag fet6ta fex1 2ff f1fa f6f5arm f5fe ffe5in ffe6la +ffe8ler ff1f f1fla ff3lei ff4lie ff8sa ff6s5ta 2f1g2 fgewen6 4f1h 1fi +fid4 fi3ds fieb4 fi1la fi8lei fil4m5a f8in. fi1na 8finf fi8scho fi6u +6f1j 2f1k2 f8lanz fl8e 4f3lein 8flib 4fling f2lix 6f3lon 5flop 1flor +\n{5f8l"ac} \n{3fl"ot} 2f1m 2f1n 1fo foh1 f2on fo6na 2f1op fo5ra +for8mei for8str for8th for6t5r fo5ru 6f5otte 2f1p8 f1q fr6 f5ram +1f8ran f8ra\3 \c{f8ra\9} f8re. frei1 5frei. f3reic f3rest f1rib +8f1ric 6frig 1fris fro8na \n{fr"as5t} 2fs f1sc f2s1er f5str +\n{fs3t"at} 2ft f1tak f1te ft5e6h ftere6 ft1h f1ti f5to f1tr ft5rad +ft1sc ft2so f1tu ftwi3d4 ft1z 1fu 6f5ums 6funf fun4ka fu8\3end +\c{fu8\9end} 6f1v 2f1w 2f1z \n{1f"a} \n{f"a1c} \n{8f"arm} \n{6f"aug} +\n{f"a8\3} \n{\c{f"a8\9}} \n{f"ode3} \n{8f"of} \n{3f"or} \n{1f"u} +\n{f"un4f3u} 1ga ga6bl 6gabw 8gabz g3a4der ga8ho ga5isc 4gak ga1la +6g5amt ga1na gan5erb gan6g5a ga5nj 6ganl 8gansc 6garb 2g1arc 2g1arm +ga5ro 6g3arti ga8sa ga8sc ga6stre 2g1atm 6g5auf gau5fr g5aus 2g1b g5c +6gd g1da 1ge ge1a2 ge6an ge8at. ge1e2 ge6es gef2 8geff ge1g2l ge1im +4g3eise geist5r gel8bra gelt8s \n{ge5l"o} ge8nin gen3k 6g5entf +\n{ge3n"a} ge1or ge1ra ge6rab ger8au \n{8gerh"o} ger8ins ge1ro 6g5erz. +\n{ge1r"a} \n{ge1r"u} ge1s ges2p ge5unt 4g3ex3 2g1f8 2g1g g1ha 6g1hei +5ghel. g5henn 6g1hi g1ho 1ghr \n{g1h"o} 1gi gi5la gi8me. gi1na +4g3ins gi3str g1j 2g1k 8gl. 1glad g5lag glan4z3 1glas 6glass 5glaub +g3lauf 1gle. g5leb 3gleic g3lein 5gleis 1glem 2gler 8g3leu gli8a +g2lie 3glied 1g2lik 1g2lim g6lio 1gloa 5glom 1glon 1glop g1los g4loss +g5luf 1g2ly \n{1gl"u} 2g1m gn8 6gn. 1gna 8gnach 2gnah g1nas g8neu +g2nie g3nis 1gno 8gnot 1go goe1 8gof 2gog 5gogr 6g5oh goni5e 6gonist +go1ra 8gord 2g1p2 g1q 1gr4 g5rahm gra8m gra4s3t 6g1rec gre6ge 4g3reic +g5reit 8grenn gri4e g5riem 5grif 2grig g5ring 6groh 2grot gro6\3 +\c{gro6\9} 4grut 2gs gs1ab g5sah gs1ak gs1an gs8and gs1ar gs1au g1sc +gs1ef g5seil gs5ein g2s1er gs1in g2s1o gso2r gs1pr g2s1u 2g1t g3te +g2t1h 1gu gu5as gu2e 2gue. 6gued 4g3uh 8gums 6g5unt gu1s gut3h gu2tu +4g1v 2g1w gy1n g1z \n{1g"a} \n{8g"a8m} \n{6g"arm} \n{1g"o} \n{1g"u} +\n{6g"ub} 1haa hab8r ha8del hade4n 8hae ha5el. haf6tr 2hal. ha1la +hal4b5a 6hale 8han. ha1na han6dr han6ge. 2hani h5anth 6hanz 6harb +h3arbe h3arme ha5ro ha2t1h h1atm hau6san ha8\3 \c{ha8\9} h1b2 h1c h1d +he2bl he3cho h3echt he5d6s 5heft h5e6he. hei8ds h1eif 2hein he3ism +he5ist. heit8s3 hek6ta hel8lau 8helt he6mer 1hemm 6h1emp hen5end +hen5klo hen6tri he2nu 8heo he8q her3ab he5rak her3an 4herap her3au +h3erbi he1ro he8ro8b he4r3um her6z5er he4spe he1st heta6 het5am he5th +heu3sc he1xa hey5e h1f2 h1g hgol8 h1h h1iat hie6r5i hi5kt hil1a2 +hil4fr hi5nak hin4ta hi2nu hi5ob hirn5e hir6ner hi1sp hi1th hi5tr +5hitz h1j h6jo h1k2 hlabb4 hla4ga hla6gr h5lai hl8am h1las h1la\3 +\c{h1la\9} hl1c h1led h3lein h5ler. h2lif h2lim h8linf hl5int h2lip +h2lit h4lor h3lose \n{h1l"as} hme5e h2nee h2nei hn3eig h2nel hne8n +hne4p3f hn8erz h6netz h2nip h2nit h1nol hn5sp h2nuc h2nud h2nul hoch1 +1hoh hoh8lei 2hoi ho4l3ar 1holz h2on ho1ra 6horg 5horn. ho3sl hos1p +ho4spi h1p hpi6 h1q 6hr h1rai h8rank h5raum hr1c hrcre8 h1red h3reg +h8rei. h4r3erb h8rert hrg2 h1ric hr5ins h2rom hr6t5erl hr2t1h hr6t5ra +hr8tri h6rum hr1z hs3ach h6s5amt h1sc h6s5ec h6s5erl hs8erle h4sob +h1sp h8spa\3 \c{h8spa\9} h8spel hs6po h4spun h1str h4s3tum hs3und +\n{h1s"u} h5ta. h5tab ht3ac ht1ak ht3ang h5tanz ht1ar ht1at h5taub +h1te h2t1ec ht3eff ht3ehe h4t3eif h8teim h4t3ein ht3eis h6temp h8tentf +hte8ren \n{h6terf"u} h8tergr h4t3erh h6t5ersc h8terst h8tese h8tess +h2t1eu h4t3ex ht1he ht5hu h1ti ht5rak hts3ah ht1sc ht6sex ht8sk ht8so +h1tu htz8 \n{h5t"um} hub5l hu6b5r huh1l h5uhr. huld5a6 hu8lent +\n{hu8l"a} h5up. h1v h5weib h3weis h1z \n{h"a8kl} \n{h"al8s} +\n{h"ama8tu8} \n{h"a8sche.} \n{h"at1s} \n{h"au4s3c} \n{2h"o.} +\n{2h"oe} \n{8h"oi} \n{h"o6s} \n{h"os5c} \n{h"uhne6} \n{h"ul4s3t} +\n{h"utte8re} i5adn i1af i5ak. i1al. i1al1a i1alb i1ald i5alei i1alf +i1alg i3alh i1alk i1all i1alp i1alr i1als i1alt i1alv i5alw i3alz +i1an. ia5na i3and ian8e ia8ne8b i1ang i3ank i5ann i1ant i1anz i6apo +i1ar. ia6rab i5arr i1as. i1asm i1ass i5ast. i1at. i5ats i1au i5azz +i6b5eig i6b5eis ib2le i4blis i6brig i6b5unt \n{i6b"ub} i1che ich5ei +i6cherb i1chi ich5ins ich1l ich3m ich1n i1cho icht5an icht3r i1chu +ich1w ick6s5te ic5l i1d id3arm 3ideal ide8na 3ideol \n{ide5r"o} i6diot +id5rec id1t ie1a ie6b5ar iebe4s3 ie2bl ieb1r ie8bra ie4bre \n{ie8b"a} +ie2dr ie1e8 ie6f5ad ief5f ie2f1l ie4fro ief1t i1ei ie4l3ec ie8lei +ie4lek i3ell i1en. i1end ien6e i3enf i5enn ien6ne. i1enp i1enr +i5ensa ien8stal i5env i1enz ie5o ier3a4b ie4rap i2ere ie4rec ie6r5ein +ie6r5eis ier8er i3ern. ie8rum ie8rund ie6s5che ie6tau ie8tert ie5the +ie6t5ri i1ett ie5un iex5 2if i1fa if5ang i6fau if1fr if5lac i5f6lie +i1fre ift5a if6t5r ig3art 2ige i8gess ig5he i5gla ig2ni i5go ig3rot +ig3s2p i1ha i8ham i8hans i1he i1hi ih1n ih1r i1hu i8hum ih1w 8i1i ii2s +ii2t i1j i1k i6kak i8kerz i6kes ik4ler i6k5unt 2il i5lac i1lag il3ans +i5las i1lau il6auf i1le ile8h i8lel il2fl il3ipp il6l5enn i1lo ilt8e +i1lu \n{i1l"a} i8mart imb2 i8mele i8mid imme6l5a i1mu \n{i1m"a} +\n{i5m"o} ina5he i1nat in1au inau8s 8ind. in4d3an 5index ind2r 3indus +i5nec i2n1ei i8nerw 3infek 1info 5ingeni ing5s6o 5inhab ini5er. 5inj +\n{in8k"at} in8nan i1no inoi8d in3o4ku in5sau in1sp 5inspe 5instit +5instru ins4ze 5intere 5interv in3the in5t2r i5ny \n{in"a2} \n{i1n"ar} +\n{in1"as} \n{in"o8} \n{in5"od} \n{i1n"os} 2io io1a8 io1c iode4 io2di +ioi8 i1ol. i1om. i1on. i5onb ion2s1 i1ont i5ops i5o8pt i1or. +i3oral io3rat i5orc i1os. i1ot. i1o8x 2ip i1pa i1pi i1p2l i1pr i1q +i1ra ir6bl i1re i1ri ir8me8d ir2m1o2 ir8nak i1ro ir5rho ir6schl +ir6sch5r i5rus i5ry \n{i5r"a} i1sa i8samt i6sar i2s1au i8scheh i8schei +isch5m isch3r \n{isch"a8} is8ele ise3ra i4s3erh is3err isi6de i8sind +is4kop ison5e is6por i8s5tum i5sty \n{i5s"o} i1ta it5ab. i2t1a2m +i8tax i1te i8tersc i1thi i1tho i5thr \n{it8h"a} i1ti i8ti8d iti6kl +itmen4 i1to i8tof it3ran it3rau i1tri itri5o it1sc it2se it5spa it8tru +i1tu it6z5erg it6z1w \n{i1t"a} \n{it"a6r5e} \n{it"at2} \n{it"ats5} +\n{i1t"u} i1u iu6r 2i1v i6vad iva8tin i8vei i6v5ene i8verh i2vob i8vur +i1w iwi2 i5xa i1xe i1z ize8n i8zir i6z5w \n{i"a8m} \n{i1"a6r} +\n{i5"at.} \n{i5"av} \n{i1"o8} \n{i"u8} i6\35ers \c{i6\95ers} ja5la +je2t3r 6jm 5jo jo5as jo1ra jou6l ju5cha jugen4 jugend5 jung5s6 ju1s +\n{3j"a} 1ka 8kachs 8kakz ka1la kal5d kam5t ka1na 2kanl 8kapf ka6pl +ka5r6a 6k3arbe ka1ro kar6p5f 4k3arti 8karz \n{ka1r"a} kasi5e ka6teb +kat8ta kauf6s kau3t2 2k1b 2k1c 4k1d kehr6s kehrs5a 8keic 2k1eig 6k5ein +6k5eis ke6lar ke8leis ke8lo 8kemp k5ente. k3entf 8k5ents 6kentz ke1ra +k5erlau 2k1f8 2k1g 2k1h ki5fl 8kik king6s5 6kinh ki5os ki5sp ki5th +\n{8ki8"o} 2k1k2 kl8 1kla 8klac k5lager kle4br k3leib 3kleid kle5isc +4k3leit k3lek 6k5ler. 5klet 2klic 8klig k2lim k2lin 5klip 5klop k3lor +\n{1kl"a} 2k1m kmani5e kn8 6kner k2ni \n{kn"a8} 1k2o ko1a2 ko6de. +ko1i koi8t ko6min ko1op ko1or ko6pht ko3ra kor6d5er ko5ru ko5t6sc k3ou +3kow 6k5ox 2k1p2 k1q 1kr8 4k3rad 2k1rec 4k3reic kre5ie 2krib 6krig +2krip 6kroba 2ks k1sa k6sab ksal8s k8samt k6san k1sc k2s1ex k5spat +k5spe k8spil ks6por k1spr kst8 k2s1uf 2k1t kta8l kt5a6re k8tein kte8re +k2t1h k8tinf kt3rec kt1s 1ku ku1ch kuck8 k3uhr ku5ie kum2s1 kunfts5 +kun2s kunst3 ku8rau ku4ro kurz1 ku1st 4kusti ku1ta ku8\3 \c{ku8\9} +6k1v 2k1w ky5n 2k1z \n{1k"a} \n{k"a4m} \n{4k3"ami} \n{k"ase5} \n{1k"o} +\n{k"o1c} \n{k"o1s} \n{1k"u} \n{k"u1c} \n{k"ur6sc} \n{k"u1s} 1la. +8labf 8labh lab2r 2l1abs lach3r la8dr 5ladu 8ladv 6laff laf5t la2gn +5laken 8lamb la6mer 5lampe. 2l1amt la1na 1land lan4d3a lan4d3r lan4gr +8lanme 6lann 8lanw \n{6lan"a} 8lappa lap8pl lap6pr l8ar. la5ra lar4af +la8rag la8ran la6r5a6s l3arbe la8rei 6larm. la8sa la1sc la8sta lat8i +6l5atm 4lauss 4lauto 1law 2lb l8bab l8bauf l8bede l4b3ins l5blo +lbst5an lbst3e 8lc l1che l8chert l1chi lch3m l5cho lch5w 6ld l4d3ei +ld1re \n{l6d"ub} le2bl le8bre lecht6s5 led2r 6leff le4gas 1lehr lei6br +le8inf 8leinn 5leistu 4lektr le6l5ers lemo2 8lemp l8en. 8lends +6lendun le8nend len8erw 6l5ents 4l3entw 4lentz 8lenzy 8leoz 6lepi +le6pip 8lepo 1ler l6er. 8lerbs 6l5erde le8reis le8rend le4r3er 4l3erg +l8ergr 6lerkl 6l5erzie \n{8ler"o} 8lesel lesi5e le3sko le3tha let1s +5leuc 4leuro leu4s3t le5xe 6lexp l1f 2l1g lgend8 l8gh lglie3 lglied6 +6l1h 1li li1ar li1as 2lick li8dr li1en lien6n li8ers li8ert 2lie\3 +\c{2lie\9} 3lig li8ga8b li1g6n li1l8a 8limb li1na 4l3indu lings5 +4l3inh 6linj link4s3 4linkt 2lint 8linv lion5s6t 4lipp 5lipt 4lisam +livi5e 6l1j 6l1k l8keim l8kj lk2l lko8f lkor8 lk2sa lk2se 6ll l1la +ll3a4be l8labt ll8anl ll1b ll1c ll1d6 l1le l4l3eim l6l5eise ller3a +l4leti l5lip l1lo ll3ort ll5ov ll6spr llte8 l1lu ll3urg \n{l1l"a} +\n{l5l"u} \n{l6l"ub} 2l1m l6m5o6d 6ln l1na l1no 8lobl lo6br 3loch. +l5o4fen 5loge. 5lohn 4l3ohr 1lok l2on 4l3o4per lo1ra 2l1ord 6lorg +4lort lo1ru 1los. lo8sei 3losig lo6ve lowi5 6l1p lp2f l8pho l8pn +lp4s3te l2pt l1q 8l1r 2ls l1sa l6sarm l1sc l8sec l6s5erg l4s3ers l8sh +l5s6la l1sp ls4por ls2pu l1str l8suni \n{l1s"u} 2l1t lt5amp l4t3ein +l5ten l6t5eng l6t5erp l4t3hei lt3her l2t1ho l6t5i6b lti1l \n{l8tr"o} +lt1sc lt6ser lt4s3o lt5ums lu8br lu2dr lu1en8 8lu8fe luft3a luf8tr +lu6g5r 2luh l1uhr lu5it 5luk 2l1umf 2l1umw 1lun 6l5u6nio 4l3unte lu5ol +4lurg 6lurs l3urt lu4sto lu3str lu6st5re lu8su lu6tal lu6t5e6g lu8terg +lu3the lu6t5or lu2t1r lu6\35 \c{lu6\95} l1v lve5r6u 2l1w 1ly lya6 +6lymp ly1no l8zess l8zo8f l3zwei lz5wu \n{3l"and} \n{l"a5on} +\n{l"a6sc} \n{l"at1s} \n{5l"auf} \n{2l"aug} \n{l"au6s5c} \n{l"a5v} +\n{l1"ol} \n{1l"os} \n{l"o1\36t} \n{\c{l"o1\96t}} \n{6l1"ube} 1ma +8mabg ma5chan mad2 ma5el 4magg mag8n ma1la ma8lau mal5d 8malde mali5e +malu8 ma8lut 2m1amp 3man mand2 man3ds 8mangr mani5o 8m5anst 6mappa +4m3arbe mar8kr ma1r4o mar8schm 3mas ma1sc \n{ma1t"o} 4m5auf ma5yo 2m1b +mb6r 2m1c 2m1d \n{md6s"a} 1me me1ch me5isc 5meld mel8sa 8memp me5nal +men4dr men8schl men8schw 8mentsp me1ra mer4gl me1ro 3mes me6s5ei me1th +me8\3 \c{me8\9} 2m1f6 2m1g 2m1h 1mi mi1a mi6ale mi1la 2m1imm mi1na +\n{mi5n"u} mi4s3an mit1h mi5t6ra 3mitt mitta8 mi6\35 \c{mi6\95} 6mj +2m1k8 2m1l 2m1m m6mad m6m5ak m8menth m8mentw mme6ra m2mn mm5sp mm5ums +mmut5s \n{m8m"an} m1n8 m5ni 1mo mo5ar mo4dr 8mof mo8gal mo4kla mol5d +m2on mon8do mo4n3od mont8a 6m5ony mopa6 mo1ra mor8d5a mo1sc mo1sp 5mot +moy5 2mp m1pa mpfa6 mpf3l mphe6 m1pi mpin6 m1pl mp2li m2plu mpo8ste +m1pr \n{mpr"a5} mp8th mput6 mpu5ts \n{m1p"o} 8m1q 2m1r 2ms ms5au m1sc +msch4l ms6po m3spri m1str 2m1t mt1ar m8tein m2t1h mt6se \n{mt8s"a} +mu5e 6m5uh mumi1 1mun mun6dr muse5e mu1ta 2m1v mvol2 mvoll3 2m1w 1my +2m1z \n{m"a6kl} \n{1m"an} \n{m"a1s} \n{m"a5tr} \n{m"au4s3c} \n{3m"a\3} +\n{\c{3m"a\9}} \n{m"ob2} \n{6m"ol} \n{1m"u} \n{5m"un} \n{3m"ut} 1na. +n5ab. 8nabn n1abs n1abz \n{na6b"a} na2c nach3e 3nacht 1nae na5el +n1afr 1nag 1n2ah na8ha na8ho 1nai 6nair na4kol n1akt nal1a 8naly 1nama +na4mer na1mn n1amp 8n1amt 5nanc nan6ce n1and n6and. 2n1ang 1nani +1nann n1ans 8nanw 5napf. 1n2ar. na2ra 2n1arc n8ard 1nari n8ark +6n1arm 5n6ars 2n1art n8arv 6natm nat6s5e 1naue 4nauf n3aug 5naui n5auk +na5um 6nausb 6nauto 1nav 2nax 3naz 1na\3 \c{1na\9} n1b2 nbau5s n1c +nche5e nch5m 2n1d nda8d n2d1ak nd5ans n2d1ei nde8lac ndel6sa n8derhi +nde4se nde8stal n2dj ndnis5 n6d5or6t nd3rec nd3rot nd8samt nd6sau +ndt1h n8dumd 1ne ne5as ne2bl 6n5ebn 2nec 5neei ne5en ne1g4l 2negy +4n1ein 8neis 4n3e4lem 8nemb 2n1emp nen1a 6n5energ nen3k 8nentb +4n3en3th 8nentl 8n5entn 8n5ents ne1ra ne5r8al ne8ras 8nerbi 6n5erde. +nere5i6d nerfor6 \n{6n5erh"o} \n{8nerl"o} 2n1err n8ers. 6n5ertra +2n1erz nesi3e net1h neu4ra neu5sc 8neu\3 \c{8neu\9} n1f nf5f nf2l +nflei8 nf5lin nft8st n8g5ac ng5d ng8en nge8ram ngg2 ng1h n6glic ng3rip +ng8ru ng2se4 ng2si n2g1um n1gy \n{n8g"al} n1h nhe6r5e 1ni ni1bl +\n{ni5ch"a} ni8dee n6ie ni1en nie6s5te niet5h ni8etn 4n3i6gel n6ik +ni1la 2n1imp ni5na 2n1ind 8ninf 6n5inh ni8nit 6n5inn 2n1ins 4n1int +n6is ni3str ni1th ni1tr n1j n6ji n8kad nk5ans n1ke n8kerla n1ki nk5inh +\n{n5kl"o} n1k2n n8k5not nk3rot \n{n8kr"u} nk5spo nk6t5r n8kuh +\n{n6k"ub} n5l6 nli4mi n1m nmen4s n1na n8nerg nni5o n1no nn4t3ak nnt1h +nnu1e n1ny \n{n1n"a} \n{n1n"o} \n{n1n"u} no5a no4b3la 4n3obs 2nobt +noche8 no6die no4dis no8ia no5isc 6n5o6leu no4mal noni6er 2n1onk n1ony +4n3o4per 6nopf 6nopti no3ra no4ram nor6da 4n1org 2n1ort n6os no1st +8nost. no8tan no8ter noty6pe 6n5ox n1p2 n1q n1r \n{nr"os3} 6ns n1sac +ns3ang n1sc n8self n8s5erf n8serg n6serk ns5erw n8sint n1s2pe n1spr +n6s5tat. n5s6te. n6stob n1str n1ta n4t3a4go nt5anh nt3ark nt3art +n1te nt3eis nte5n6ar nte8nei nter3a nte6rei nt1ha nt6har n3ther nt5hie +n3thus n1ti nti1c n8tinh nti1t ntlo6b ntmen8 n1to nt3o4ti n1tr ntra5f +ntra5ut nt8rea nt3rec nt8rep n4t3rin nt8rop n4t3rot \n{n4tr"u} nt1s +nts6an nt2sk n1tu nt1z \n{n1t"a} \n{n1t"o} \n{n8t"ol} \n{n1t"u} 1nu +nu1a nu5el nu5en 4n1uhr nu5ie 8numl 6n5ums 6n5umw 2n1und 6nuni 6n5unr +2n1unt 2nup 2nu6r n5uri nu3skr nu5ta n1v 8n1w 1nys n1za n6zab n2z1ar +n6zaus nzi4ga n8zof n6z5unt n1zw n6zwir \n{1n"ac} \n{5n"ae} \n{5n"ai} +\n{n8"al} \n{n"a6m} \n{n"a6re} \n{n5"arz} \n{5n"aus} \n{n1"ol} +\n{1n"ot} \n{n5"oz} \n{5n"u.} \n{6n1"u2b} \n{5n"u\3} \n{\c{5n"u\9}} +o5ab. oa2l o8ala o1a2m o1an ob1ac obe4ra o6berh 5o4bers o4beru +obe6ser 1obj o1bl o2bli ob5sk 3obst. ob8sta obst5re ob5sz o1che +oche8b o8chec o3chi och1l och3m ocho8f o3chro och3to o3chu och1w o1d +o2d1ag od2dr ode5i ode6n5e od1tr o5e6b o5e6der. oe8du o1ef o1e2l +o1e2p o1er. o5e8x o1fa of8fan 1offi of8fin of6f5la o5fla o1fr 8o1g +og2n o1ha o1he o6h5eis o1hi ohl1a oh1le oh4l3er 5ohm. oh2ni o1ho +oh1re oh1ru o1hu oh1w o1hy \n{o1h"a} o5ia o1id. o8idi oi8dr o5ids +o5isch. oiset6 o1ism o3ist. o5i6tu o1j o1k ok2l ok3lau \n{o8kl"a} +1okta o1la old5am old5r o1le ole5in ole1r ole3u ol6gl ol2kl olk4s1 +ol8lak ol8lauf. ol6lel ol8less o1lo ol1s ol6sk o1lu oly1e2 5olym +o2mab om6an o8mau ombe4 o8merz om5sp o1mu o8munt \n{o1m"a} \n{o1m"o} +o1na ona8m on1ax on8ent o6n5erb 8oni oni5er. on1k on6n5a6b o1no ono1c +o4nokt 1ons onts8 \n{o1n"a} oo8f 1oog oo2pe oo2sa o1pa 3o4pera o3pfli +opf3lo opf3r o1pi o1pl o2pli o5p6n op8pa op6pl o1pr o3p4ter 1opti +\n{o1p"a} \n{o5p"o} o1q o1ra. o3rad o8radd 1oram o6rang o5ras o8rauf +or5cha or4d3a4m or8dei or8deu 1ordn or4dos o1re o5re. ore2h o8r5ein +ore5isc or6enn or8fla or8fli 1orga 5orgel. or2gl o1ri 5o6rient or8nan +\n{or8n"a} o1ro or1r2h or6t5an or8tau or8tere o1rus o1ry \n{o1r"a} +\n{or1"u2} o1sa osa3i 6ose o8serk o1sk o6ske o6ski os2kl os2ko os2kr +osni5e o2s1o2d o3s4per o4stam o6stau o3stra ost3re osu6 o6s5ur o5s6ze +o1ta ot3auf o6taus o1te o6terw o1th othe5u o2th1r o1ti o1to oto1a +ot1re o1tri o1tro ot1sc o3tsu ot6t5erg ot2t3h ot2t5r \n{ot8t"o} o1tu +ou3e ouf1 ou5f6l o5u6gr ou5ie ou6rar ou1t6a o1v o1wa o1we o6wer. o1wi +owid6 o1wo o5wu o1xe oy5al. oy1e oy1i o5yo o1z oza2r 1o2zea ozo3is +\n{o"o8} o\35elt \c{o\95elt} o\31t \c{o\91t} 3paa pa6ce 5pad pag2 1pak +pa1la pa8na8t pani5el pa4nor pan1s2 1pap pap8s pa8rei par8kr paro8n +par5o6ti part8e 5partei 3partn pas6sep pa4tha 1pau 6paug pau3sc p1b +8p5c 4p1d 1pe 4peic pe5isc 2pek pen3k pen8to8 p8er pe1ra pere6 per5ea +per5eb pe4rem 2perr per8ran 3pers 4persi \n{pe3r"u} pe4sta pet2s +p2f1ec p4fei pf1f pf2l 5pflanz pf8leg pf3lei 2pft pf3ta p1g 1ph 2ph. +2p1haf 6phb 8phd 6p5heit ph5eme 6phg phi6e 8phk 6phn p5holl pht2 +ph3tha 4ph3the phu6 6phz pi1en pi5err pi1la pi1na 5pinse pioni8e 1pis +pi1s2k pi1th p1k pl8 5pla p2lau 4plei p3lein 2pler 6p5les 2plig p6lik +6p5ling p2liz plo8min 6p1m p1n 1p2o 8poh 5pol po8lan poly1 po3ny po1ra +2porn por4t3h \n{po5r"o} 5poti p1pa p6p5ei ppe6la pp5f p2p1h p1pi pp1l +ppp6 pp5ren pp1s \n{p5p"o} pr6 3preis 1pres 2p3rig 5prinz 1prob 1prod +5prog pro8pt pro6t5a prote5i 8pro\3 \c{8pro\9} \n{pr"a3l} \n{1pr"as} +\n{pr"ate4} \n{1pr"uf} p5schl 2pst 1p2sy p1t p8to8d pt1s 5p6ty 1pu +pu1b2 2puc pu2dr puf8fr 6p5uh pun8s pu8rei pu5s6h pu1ta p1v p3w 5py +py5l p1z \n{p"a6der} \n{p5"a6m} \n{p"a8nu} \n{8p"ar} \n{p"at5h} +\n{p"at1s} qu6 1qui 8rabk ra6bla 3rable ra2br r1abt 6rabz ra4dan ra2dr +5rafal ra4f3er ra5gla ra2g3n 6raha ral5am 5rald 4ralg ra8lins 2rall +ral5t 8ramei r3anal r6and ran8der ran4dr 8ranf 6ranga 5rangi ran8gli +r3angr rans5pa 8ranw r8anz. ra5or 6rapf ra5pl rap6s5er 2r1arb 1rarh +r1arm ra5ro 2r1art 6r1arz ra8tei ra6t5he 6ratl ra4t3ro r5atta raue4n +6raus. r5austa rau8tel raut5s ray1 r1b rb5lass r6bler rb4lie rbon6n +r8brecht \n{rb6s5t"a} r8ces r1che rch1l rch3m rch3re rch3tr rch1w 8rd +r1da r8dachs r8dap rda5ro rde5ins rdio5 r8dir rd3ost r1dr r8drau 1re. +re1ak 3reakt re3als re6am. re1as 4reben re6bl rech5a r8edi re3er +8reff 3refl 2reh 5reha r4ei. reich6s5 8reier 6reign re5imp 4r3eina +6r3einb 6reing 6r5einn 6reinr 4r3eins r3eint reli3e 8r5elt 6rempf +2remt ren5a6b ren8gl r3enni 1reno 5rente 4r3enth 8rentl 4r3entw 8rentz +ren4zw re1on requi5 1rer rer4bl 6rerbs 4r3erd \n{8rerh"o} 8rerkl +4r3erla \n{8rerl"o} 4r3erns \n{6r5ern"a} rer5o 6r5erreg r5ertr r5erwec +\n{r5er"o} re2sa re8schm 2ress re5u8ni 6rewo 2r1ex r1f r8ferd rf4lie +8r1g r8gah rge4bl rge5na rgest4 rg6ne r2gni2 r8gob r4g3ret rg8sel r1h8 +r2hy 5rhyt ri1ar ri5cha rid2g r2ie rieg4s5 ri8ei ri1el ri6ele ri1en +ri3er. ri5ers. ri6fan ri8fer ri8fr 1r2ig ri8kn ri5la \n{rim"a8} +ri1na r8inde rin4ga rin6gr 1rinn 6rinner rino1 r8insp 4rinst +\n{ri1n"a} ri5o6ch ri1o2d ri3o6st 2r1ir r2is ri3sko ri8spr \n{ri8st"u} +ri5sv r2it 6r5i6tal ri5tr ri6ve. 8r1j 6rk r1ke rkehrs5 r1ki r3klin +r1k2n rk3str rk4t3an rk6to r6kuh \n{rk"a4s3t} r1l r5li rline5a 6r1m +r6manl rma4p r4m3aph r8minf r8mob rm5sa 2rn r1na rna8be r5ne rn2ei +r6neif r6nex r6nh rn1k r1no r6n5oc rn1sp \n{r1n"a} \n{r1n"u} ro6bern +6robs ro1ch 3rock. ro5de ro1e 4rofe ro8hert 1rohr ro5id ro1in ro5isc +6rolym r2on 6roog ro6phan r3ort ro1s2p ro5s6w ro4tau ro1tr ro6ts 5rout +r1p rpe8re rp2f r2ps r2pt r1q 2rr r1ra r1re rrer6 rr6hos \n{r5rh"o} +r1ri r1ro rro8f rr8or rror5a r1ru r3ry \n{r1r"a} \n{r1r"o} \n{r1r"u} +2r1s r6sab r4sanf rse6e rse5na r2sh r6ska r6ski rs2kl r8sko r2sl rs2p +r6stauf r8sterw r8stran rswi3d4 r2sz 2r1t rt3art r8taut r5tei rt5eige +r8tepe r4t3erh r8terla r4t3hei r5t6hu r4t3int rt5reif rt1sc rt6ser +rt6s5o rt6s5u rt5und r8turt rube6 ru1en 1r4uf ruf4st ru1ie 2r1umg +2r1uml 2rums run8der run4d5r 6rundz 6runf 8runs 2r1unt 2r1ur r6us +ru6sta ru3str ru6tr 1ruts r1v rven1 rvi2c r1w r1x r1za rz5ac r6z5al +r8z1ar r8zerd r6z5erf rz8erh rz4t3h r8zum \n{r"a4ste} \n{r"au8sc} +\n{r1"of} \n{5r"ohr} \n{r"o5le} \n{3r"oll} \n{5r"omis} \n{r1"or} +\n{r"o2sc} \n{3r"ump} 1sa. 1saa s3a4ben sa2bl 2s1abs 6s1abt 6sabw +3sack. 6s3a4der 1saf sa1fa 4s1aff sa5fr 1sag 1sai sa1i2k1 4s1akt 1sal +sa1la 4s3alpi 6salter salz3a 1sam s5anb san2c 1sand s5angeh 6sanl +2s1ans 6s3antr 8s1anw s1ap s6aph 8sapo sap5p6 s8ar. 2s1arb 3sarg +s1arm sa5ro 2s1art 6s1arz 1sas 1sat sat8a 2s1atl sa8tom 3s8aue s5auff +sau5i s6aur 2s1aus 5s6ause 2s1b2 2sca s4ce 8sch. 3scha. 5schade +3schaf 3schal sch5ame 8schanc 8schb 1sche 6schef 8schex 2schf 2schg +2schh 1schi 2schk 5schlag 5schlu \n{6schm"a\3} \n{\c{6schm"a\9}} +6schna\3 \c{6schna\9} 1scho 6schord 6schp 3schri 8schric 8schrig +8schrou 6schs 2scht sch3ta sch3tr 1schu 8schunt 6schv 2schz \n{5sch"o} +\n{5sch"u} 2sco scre6 6scu 2s1d 1se se5an se1ap se6ben se5ec see5i6g +se3erl 8seff se6han se8hi \n{se8h"o} 6s5eid. 2s1eig s8eil 5sein. +sei5n6e 6s5einh 3s8eit 3sel. se4lar selb4 6s3e4lem se8lerl 2s1emp +sen3ac se5nec 6s5ents 4sentz s8er. se8reim ser5inn \n{8serm"a} +8s5erzi \n{6ser"of} se1um 8sexa 6sexp 2s1f2 sfal8ler 2s3g2 sge5b2 s1h +s8hew 5s6hip 5s4hop 1si 2siat si1b sicht6s 6s5i6dee siege6s5 si1en +si5err si1f2 si1g2n si6g5r si8kau sik1i si4kin si2kl \n{si8k"u} si1la +sil6br si1na 2s1inf sin5gh 2s1inh sinne6s5 2s1ins si5ru si5str 4s1j +s1k2 6sk. 2skau skel6c skelch5 s6kele 1s2ki. 3s4kin. s6kiz s8kj +6skn 2skow 3skrib 3skrip 2sku \n{8sk"u} s1l s8lal slei3t s4low 2s1m +s1n 6sna 6snot 1so so1ch 2s1odo so4dor 6s5o4fen solo3 s2on so5of 4sope +so1ra 2s1ord 4sorga sou5c so3un 4s3ox sp2 8spaa 5spal 1span 2spap +s2pec s4peis 1spek s6perg 4spers s6pes 2s1pf 8sphi \n{1s2ph"a} 1spi +spi4e 6s5pig 6spinse 2spis 2spla 2spol 5s6pom 6s5pos 6spoti 1spra +3s8prec 6spreis 5spring 6sprob 1spru s2pul 1s2pur 6spy \n{5sp"an} +\n{1sp"u} s1q 2s1r 2s1s2 sse8nu ssini6s ssoi6r 2st. 1sta 4stafe 2stag +sta3la 6stale 4stalg 8stalk 8stamt 6st5anf 4stans 6stanw 6starb sta4te +6staus 2stb 6stc 6std 1ste 4steil 3s2tel st3elb 8stemb 6steppi 8stese +8stesse 6stf 2stg 2sth st1ha st3hei s8t1hi st1ho st5hu 1sti sti4el +4stigm sti3na 6stind 4stinf sti8r 2stk 2stl 2stm 1sto 6stoll. 4st3ope +6stopf. 6stord 6stp 5stra. 4strai 3s4tral 6s5traum 3stra\3 +\c{3stra\9} 3strec 6s3tref 8streib 5streif 6streno 6stres 6strev +5s6tria 6strig 5strik 8strisi 3s4troa s8troma st5rose 4struf 3strum +\n{6str"ag} 2st1s6 2stt 1stu stu5a 4stuc 2stue 8stun. 2stv 2stw s2tyl +6stz \n{1st"a} \n{8st"ag} \n{1st"o} \n{1st"u} \n{8st"uch} \n{4st"ur.} +1su su2b1 3suc su1e su2fe su8mar 6sumfa 8sumk 2s1unt sup1p2 6s5u6ran +6surte 2s1v 2s1w 1sy 8syl. sy5la syn1 sy2na syne4 s1z s4zend 5s6zene. +8szu \n{1s"a} \n{6s5"and} \n{6s"augi} \n{6s"au\3} \n{\c{6s"au\9}} +\n{5s"om} \n{2s1"u2b} \n{1s"uc} \n{s"u8di} \n{1s"un} \n{5s"u\3} +\n{\c{5s"u\9}} taats3 4tab. taba6k ta8ban tab2l ta6bre 4tabs t3absc +8tabz 6t3acht ta6der 6tadr tad6s tad2t 1tafe4 1tag ta6ga6 ta8gei +tage4s tag6s5t tah8 tahl3 tai6ne. ta5ir. tak8ta tal3au 1tale ta8leng +tal5ert 6t5a6mer 6tamp tampe6 2t1amt tan5d6a tan8dr tands5a tani5e +6tanl 2tanr t3ans 8t5antr tanu6 t5anw 8tanwa tan8zw ta8rau 6tarbe +1tari 2tark 2t1arm ta1ro 2tart t3arti 6tarz ta1sc ta6sien ta8stem +ta8sto t5aufb 4taufn 8taus. 5tause 8tausf 6tausg t5ausl 2t1b2 2t1c +t6chu 2t1d te2am tea4s te8ben 5techn 4teff te4g3re te6hau 2tehe te4hel +2t1ehr te5id. teig5l 6teign tei8gr 1teil 4teinh t5einhe 4teis t5eisen +8teiw te8lam te4lar 4telek 8telem te6man te6n5ag ten8erw ten5k tens4p +ten8tro 4t3entw 8tentz te6pli 5teppi ter5a6b te3ral ter5au 8terbar +t5erbe. 6terben 8terbs 4t3erbt t5erde. ter5ebe ter5ein te8rers terf4 +\n{8terh"o} \n{6terkl"a} ter8nor ter6re. t8erscha t5e6sel te8stau +t3euro te1xa tex3e 8texp tex6ta 2t1f2 2t1g2 2th. th6a 5tha. 2thaa +6t1hab 6t5haf t5hah 8thak 3thal. 6thals 6t3hand 2t1hau 1the. 3t4hea +t1heb t5heil t3heit t3helf 1theo 5therap 5therf 6t5herz 1thes 1thet +5thi. 2t1hil t3him 8thir 3this t5hj 2th1l 2th1m th1n t5hob t5hof +4tholz 6thopti 1thr6 4ths t1hum 1thy \n{4t1h"a} \n{2t1h"o} \n{t1h"u} +ti1a2m ti1b tie6fer ti1en ti8gerz tig3l ti8kin ti5lat 1tilg t1ind +tin4k3l ti3spa ti5str 5tite ti5tr ti8vel ti8vr 2t1j 2t1k2 2t1l tl8a +2t1m8 2t1n 3tobe 8tobj to3cha 5tocht 8tock tode4 to8del to8du to1e +6t5o6fen to1in toi6r 5toll. to8mene t2ons 2t1ony to4per 5topf. 6topt +to1ra to1s to6ska tos2l 2toti to1tr t8ou 2t1p2 6t1q tr6 tra5cha +tra8far traf5t 1trag tra6gl tra6gr t3rahm 1trai t6rans tra3sc tra6st +3traue t4re. 2trec t3rech t8reck 6t1red t8ree 4t1reg 3treib 4treif +8t3reis 8trepo tre6t5r t3rev 4t3rez 1trib t6rick tri6er 2trig t8rink +tri6o5d trizi5 tro1a 3troc trocke6 troi8d tro8man. tro3ny 5tropf +6t5rosa t5ro\3 \c{t5ro\9} 5trub 5trup trut5 \n{1tr"ag} \n{6t1r"oh} +\n{5tr"ub} \n{tr"u3bu} \n{t1r"uc} \n{t1r"us} 2ts ts1ab t1sac tsa8d +ts1ak t6s5alt ts1an ts1ar ts3auf t3schr \n{t5sch"a} tse6e tsee5i +tsein6s ts3ent ts1er t8serf t4serk t8sh 5t6sik t4s3int ts5ort. +t5s6por t6sprei t1st t6s5tanz ts1th t6stit t4s3tor 1t2sua t2s1uf +t8sum. t2s1u8n t2s1ur 2t1t tt5eif tte6sa tt1ha tt8ret tt1sc tt8ser +tt5s6z 1tuc tuch5a 1tu1e 6tuh t5uhr tu1i tu6it 1tumh 6t5umr 1tums +8tumt 6tund 6tunf 2t1unt tu5ra tu6rau tu6re. tu4r3er 2t1v 2t1w 1ty1 +ty6a ty8la 8tym 6ty6o 2tz tz5al tz1an tz1ar t8zec tzeh6 tzehn5 t6z5ei. +t6zor t4z3um \n{t6z"au} \n{5t"ag} \n{6t"ah} \n{t5"alt} \n{t8"an} +\n{t"are8} \n{8t"a8st} \n{6t"au\3} \n{\c{6t"au\9}} \n{t5"offen} +\n{8t"o8k} \n{1t"on} \n{4t"ub} \n{t6"u5ber.} \n{5t"uch} \n{1t"ur.} +u3al. u5alb u5alf u3alh u5alk u3alp u3an. ua5na u3and u5ans u5ar. +ua6th u1au ua1y u2bab ubi5er. u6b5rit ubs2k \n{u5b"o} \n{u8b"ub} 2uc +u1che u6ch5ec u1chi uch1l uch3m uch5n uch1r uch5to ucht5re u1chu uch1w +uck1a uck5in u1d ud4a u1ei u6ela uene8 u6ep u1er uer1a ue8rerl uer5o +u8esc u2est u8ev u1fa u2f1ei u4f3ent u8ferh uf1fr uf1l uf1ra uf1re +\n{uf1r"a} \n{uf1r"u} uf1s2p uf1st uft1s u8gabt u8gad u6gap ugeb8 u8gn +ugo3s4 u1ha u1he u1hi uh1le u1ho uh1re u1hu uh1w \n{u1h"a} \n{u1h"o} +6ui ui5en u1ig u3ins uin8tes u5isch. u1j 6uk u1ke u1ki u1kl u8klu +u1k6n u5ky u1la uld8se u1le ul8lac ul6lau ul6le6l ul6lo ulni8 u1lo +ulo6i ult6a ult8e u1lu ul2vr \n{u1l"a} \n{u1l"o} 3umfan 5umlau umo8f +um8pho u1mu umu8s \n{u5m"o} u1n1a un2al un6at unau2 6und. 5undein +un4d3um 3undzw \n{und"u8} \n{un8d"ub} une2b un1ec une2h un3eis 3unfal +\n{1unf"a} 5ungea \n{3ungl"u} ung2s1 \n{un8g"a} 1u2nif un4it un8kro +unk5s u1no unpa2 uns2p unvol4 unvoll5 u5os. u1pa u1pi u1p2l u1pr +up4s3t up2t1a u1q u1ra ur5abs ura8d ur5ah u6rak ur3alt u6rana u6r5ans +u8rap ur5a6ri u8ratt u1re ur3eig ur8gri u1ri ur5ins 3urlau urmen6 +ur8nan u1ro 3ursac ur8sau ur8sei ur4sk 3urtei u1ru uru5i6 uru6r u1ry +ur2za \n{ur6z"a} \n{ur5"a6m} \n{u5r"o} \n{u1r"u} \n{ur"uck3} u1sa +usa4gi u2s1ar u2s1au u8schec usch5wi u2s1ei use8kel u8sl u4st3a4b +us3tau u3s4ter u2s1uf u8surn ut1ac u1tal uta8m u1tan ut1ar u1tas ut1au +u1te u8teic u4tent u8terf u6terin u4t3hei ut5ho ut1hu u1ti utine5 +uti6q u1to uto5c u1tr ut1sa ut1s6p ut6stro u1tu utz5w u1u u1v uve5n +\n{uve3r4"a} u1w u1xe u5ya uy5e6 u1yi u2z1eh u8zerh \n{u5"o} u\3e6n +\c{u\9e6n} u\3en5e \c{u\9en5e} 8vanb 6vang 6varb var8d va6t5a va8tei +va2t1r 2v1b 6v5c 6vd 1ve 6ve5g6 ver1 ver5b verb8l ve2re2 verg8 ve2ru8 +ve1s ve2s3p ve3xe 2v1f 2v1g 6v5h vi6el vie6w5 vi1g4 vi8leh vil6le. +8vint vi1ru vi1tr 2v1k 2v1l 2v1m 4v5n 8vo8f voi6le vol8lend vol8li +v2or1 vo2re vo8rin vo2ro 2v1p 8vra v6re 2v1s 2v1t 2v1v 4v3w 2v1z +waffe8 wa6g5n 1wah wah8n wa5la wal8din wal6ta wan4dr 5ware wa8ru +war4za 1was w5c w1d 5wech we6fl 1weg we8geng weg5h weg3l we2g1r +weh6r5er 5weise weit3r wel2t welt3r we6rat 8werc 5werdu wer4fl 5werk. +wer4ka wer8ku wer4ta wer8term we2sp we8stend we6steu we8str +\n{we8st"o} wet8ta wich6s5t 1wid wi2dr wiede4 wieder5 wik6 wim6ma +win4d3r 5wirt wisch5l 1wj 6wk 2w1l 8w1n wo1c woche6 wol6f wor6t5r 6ws2 +w1sk 6w5t 5wunde. wun6gr wu1sc wu2t1 6w5w wy5a \n{w"arme5} \n{w"a1sc} +1xag x1ak x3a4men 8xamt x1an 8x1b x1c 1xe. x3e4g 1xen xe1ro x1erz +1xes 8xf x1g 8x1h 1xi 8xid xi8so 4xiste x1k 6x1l x1m 8xn 1xo 8x5o6d +8x3p2 x1r x1s6 8x1t x6tak x8terf x2t1h 1xu xu1e x5ul 6x3w x1z 5ya. +y5an. y5ank y1b y1c y6cha y4chia y1d yen6n y5ern y1g y5h y5in y1j +y1k2 y1lak yl1al yla8m y5lax y1le y1lo y5lu y8mn ym1p2 y3mu y1na yno2d +yn1t y1on. y1o4p y5ou ypo1 y1pr y8ps y1r yri3e yr1r2 y1s ys5iat ys8ty +y1t y3w y1z \n{y"a8m} z5a6b zab5l 8za6d 1zah za5is 4z3ak 6z1am 5zange. +8zanl 2z1ara 6z5as z5auf 3zaun 2z1b 6z1c 6z1d 1ze ze4dik 4z3eff 8zein +zei4ta zei8ters ze6la ze8lec zel8th 4zemp 6z5engel zen8zin \n{8zerg"a} +zer8i ze1ro zers8 zerta8 zer8tab zer8tag 8zerz ze8ste zeu6gr 2z1ex +2z1f8 z1g 4z1h 1zi zi1en zi5es. 4z3imp zi1na 6z5inf 6z5inni zin6s5er +8zinsuf zist5r zi5th zi1tr 6z1j 2z1k 2z1l 2z1m 6z1n 1zo zo6gl 4z3oh +zo1on zor6na8 4z1p z5q 6z1r 2z1s8 2z1t z4t3end z4t3hei z8thi 1zu zu3al +zu1b4 zu1f2 6z5uhr zun2a 8zunem zunf8 8zungl zu1o zup8fi zu1s8 zu1z +2z1v zw8 z1wal 5zweck zwei3s z1wel z1wer z6werg 8z5wes 1zwi zwi1s +6z1wo 1zy 2z1z zz8a zzi1s \n{1z"a} \n{1z"o} \n{6z"ol.} \n{z"o1le} +\n{1z"u} \n{2z1"u2b} \n{"a1a6} \n{"ab1l} \n{"a1che} \n{"a3chi} +\n{"ach8sc} \n{"ach8sp} \n{"a5chu} \n{"ack5a} \n{"ad1a} \n{"ad5era} +\n{"a6d5ia} \n{"a1e} \n{"a5fa} \n{"af1l} \n{"aft6s} \n{"ag1h} +\n{"ag3le} \n{"a6g5nan} \n{"ag5str} \n{"a1he} \n{"a1hi} \n{"ah1le} +\n{"ah5ne} \n{1"ahnl} \n{"ah1re} \n{"ah5ri} \n{"ah1ru} \n{"a1hu} +\n{"ah1w} \n{6"ai} \n{"a1isc} \n{"a6ische} \n{"a5ism} \n{"a5j} +\n{"a1k} \n{"al1c} \n{"a1le} \n{"a8lei} \n{"al6schl} \n{"ami1e} +\n{"am8n} \n{"am8s} \n{"a5na} \n{5"anderu} \n{"ane5i8} \n{"ang3l} +\n{"ank5l} \n{"a1no} \n{"an6s5c} \n{"a1pa} \n{"ap6s5c} \n{3"aq} +\n{"ar1c} \n{"a1re} \n{"are8m} \n{5"argern} \n{"ar6gl} \n{"a1ri} +\n{3"armel} \n{"a1ro} \n{"art6s5} \n{"a1ru} \n{3"arztl} \n{"a5r"o} +\n{"a6s5chen} \n{"asen8s} \n{"as1th} \n{"ata8b} \n{"a1te} \n{"ateri4} +\n{"ater5it} \n{"a6thy} \n{"a1ti} \n{3"atk} \n{"a1to} \n{"at8schl} +\n{"ats1p} \n{"a5tu} \n{"aub1l} \n{"au1e} \n{1"aug} \n{"au8ga} +\n{"au5i} \n{"a1um.} \n{"a1us.} \n{1"au\3} \n{\c{1"au\9}} \n{"a1z} +\n{"o1b} \n{"o1che} \n{"o5chi} \n{"och8stei} \n{"och8str} \n{"ocht6} +\n{5"o6dem} \n{5"offn} \n{"o1he} \n{"oh1l8} \n{"oh1re} \n{"o1hu} +\n{"o1is} \n{"o1ke} \n{1"o2ko} \n{1"ol.} \n{"ol6k5l} \n{"ol8pl} +\n{"o1mu} \n{"o5na} \n{"onig6s3} \n{"o1no} \n{"o5o6t} \n{"opf3l} +\n{"op6s5c} \n{"o1re} \n{"or8gli} \n{"o1ri} \n{"or8tr} \n{"o1ru} +\n{5"osterr} \n{"o1te} \n{"o5th} \n{"o1ti} \n{"o1tu} \n{"o1v} \n{"o1w} +\n{"owe8} \n{"o2z} \n{"ub6e2} \n{3"u4ber1} \n{"ub1l} \n{"ub1r} +\n{5"u2bu} \n{"u1che} \n{"u1chi} \n{"u8ch3l} \n{"uch6s5c} \n{"u8ck} +\n{"uck1a} \n{"uck5ers} \n{"ud1a2} \n{"u6deu} \n{"udi8t} \n{"u2d1o4} +\n{"ud5s6} \n{"uge4l5a} \n{"ug1l} \n{"uh5a} \n{"u1he} \n{"u8heh} +\n{"u6h5erk} \n{"uh1le} \n{"uh1re} \n{"uh1ru} \n{"u1hu} \n{"uh1w} +\n{"u3k} \n{"u1le} \n{"ul4l5a} \n{"ul8lo} \n{"ul4ps} \n{"ul6s5c} +\n{"u1lu} \n{"un8da} \n{"un8fei} \n{"unk5l} \n{"un8za} \n{"un6zw} +\n{"u5pi} \n{"u1re} \n{"u8rei} \n{"ur8fl} \n{"ur8fr} \n{"ur8geng} +\n{"u1ri} \n{"u1ro} \n{"ur8sta} \n{"ur8ster} \n{"u1ru} \n{"use8n} +\n{"u8sta} \n{"u8stes} \n{"u6s5tete} \n{"u3ta} \n{"u1te} \n{"u1ti} +\n{"ut8tr} \n{"u1tu} \n{"ut8zei} \n{"u1v} \31a8 \c{\91a8} 5\3a. +\c{5\9a.} \38as \c{\98as} \31b8 \c{\91b8} \31c \c{\91c} \31d \c{\91d} +1\3e \c{1\9e} \35ec \c{\95ec} 8\3e8g \c{8\9e8g} 8\3e8h \c{8\9e8h} +2\31ei \c{2\91ei} 8\3em \c{8\9em} \31f8 \c{\91f8} \31g \c{\91g} \31h +\c{\91h} 1\3i \c{1\9i} \31k \c{\91k} \31l \c{\91l} \31m \c{\91m} +\3mana8 \c{\9mana8} \31n \c{\91n} \31o \c{\91o} \31p8 \c{\91p8} \35q +\c{\95q} \31r \c{\91r} \31s2 \c{\91s2} \3st8 \c{\9st8} \31ta \c{\91ta} +\31te \c{\91te} \3t3hei \c{\9t3hei} \31ti \c{\91ti} \35to \c{\95to} +\31tr \c{\91tr} 1\3u8 \c{1\9u8} 6\35um \c{6\95um} \31v \c{\91v} \31w +\c{\91w} \31z \c{\91z} +}% +\endgroup +\relax\endinput +% +% ----------------------------------------------------------------- +% +% =============== Additional Documentation =============== +% +% +% Older Versions of German Hyphenation Patterns: +% ---------------------------------------------- +% +% All older versions of `ghyphen.tex' distributed as +% +% ghyphen.tex/germhyph.tex as of 1986/11/01 +% ghyphen.min/ghyphen.max as of 1988/10/10 +% ghyphen3.tex as of 1990/09/27 & 1991/02/13 +% ghyph31.tex as of 1994/02/13 +% +% are out of date and it is recommended to replace them +% with the new version `dehypht.tex' as of 1999/03/03. +% +% If you are using `ghyphen.min' (a minor version of `ghyphen') +% because of limited trie memory space, try this version and if +% the space is exceeded get a newer TeX implementation with +% larger or configurable trie memory sizes. +% +% +% +% Trie Memory Requirements/Space for Hyphenation Patterns: +% -------------------------------------------------------- +% +% To load this set of german hyphenation patterns the parameters +% of TeX has to have at least these values: +% +% TeX 3.x: +% IniTeX: trie_size >= 9733 trie_op_size >= 207 +% VirTeX: trie_size >= 8375 trie_op_size >= 207 +% +% TeX 2.x: +% IniTeX: trie_size >= 8675 trie_op_size >= 198 +% VirTeX: trie_size >= 7560 trie_op_size >= 198 +% +% If you want to load more than one set of hyphenation patterns +% (in TeX 3.x), the parameters have to be set to a value larger +% than or equal to the sum of all required values for each set. +% +% +% Setting Trie Memory Parameters: +% ------------------------------- +% +% Some implementations allow the user to change the default value +% of a set of the internal TeX parameters including the trie memory +% size parameter specifying the used memory for the hyphenation +% patterns. +% +% Web2c 7.x (Source), teTeX 0.9 (Unix, Amiga), fpTeX (Win32) +% and newer: +% The used memory size of the true is usually set high enough. +% If needed set the size of the trie using the keyword `trie_size' +% in the configuration file `texmf/web2c/texmf.cnf'. For details +% see the included documentation. +% +% emTeX (OS/2, MS-DOS, Windows 3.x/9x/NT): +% You can set the used memory size of the trie using the +% `-mt' option on the command line or in the +% TEXOPTIONS environment variable. +% +% PasTeX (Amiga): +% The values for the parameters can be set using the keywords +% `triesize', `itriesize' and `trieopsize' in the configuration +% file. +% +% others (binaries only): +% See the documentation of the implementation if it is possible +% and how to change these values without recompilation. +% +% others (with sources) +% If the trie memory is too small, you have to recompile TeX +% using larger values for `trie_size' and `trie_op_size'. +% Modify the change file `tex.ch' and recompile TeX. +% For details see the documentation included in the sources. +% +% +% +% Necessary Settings in TeX macro files: +% -------------------------------------- +% +% \lefthyphenmin, \righthyphenmin: +% You can set both parameters to 2. +% +% \lccode : +% To get correct hyphenation points within words containing +% umlauts or \ss, it's necessary to assign values > 0 to the +% appropriate \lccode positions. +% +% These changes are _not_ done when reading this file and have to +% be included in the language switching mechanism as is done in, +% for example, `german.sty' (\lccode change for ^^Y = \ss in OT1, +% \left-/\righthyphenmin settings). +% +% +%% \CharacterTable +%% {Upper-case \A\B\C\D\E\F\G\H\I\J\K\L\M\N\O\P\Q\R\S\T\U\V\W\X\Y\Z +%% Lower-case \a\b\c\d\e\f\g\h\i\j\k\l\m\n\o\p\q\r\s\t\u\v\w\x\y\z +%% Digits \0\1\2\3\4\5\6\7\8\9 +%% Exclamation \! Double quote \" Hash (number) \# +%% Dollar \$ Percent \% Ampersand \& +%% Acute accent \' Left paren \( Right paren \) +%% Asterisk \* Plus \+ Comma \, +%% Minus \- Point \. Solidus \/ +%% Colon \: Semicolon \; Less than \< +%% Equals \= Greater than \> Question mark \? +%% Commercial at \@ Left bracket \[ Backslash \\ +%% Right bracket \] Circumflex \^ Underscore \_ +%% Grave accent \` Left brace \{ Vertical bar \| +%% Right brace \} Tilde \~} +%% +\endinput +%% +%% End of file `dehypht.tex'. diff --git a/src/bootsupport/modules/textutil/eshyph_vo.tex b/src/bootsupport/modules/textutil/eshyph_vo.tex new file mode 100644 index 0000000..e15bdc3 --- /dev/null +++ b/src/bootsupport/modules/textutil/eshyph_vo.tex @@ -0,0 +1,1104 @@ +.\'a2 +.\'aa2 +.\'ae2 +.\'ai2 +.\'ao2 +.\'au2 +.\'e2 +.\'ea2 +.\'ee2 +.\'ei2 +.\'eo2 +.\'eu2 +.\'i2 +.\'ia2 +.\'ie2 +.\'ii2 +.\'io2 +.\'iu2 +.\'o2 +.\'oa2 +.\'oe2 +.\'oi2 +.\'oo2 +.\'ou2 +.\'u2 +.\'ua2 +.\'ue2 +.\'ui2 +.\'uo2 +.\'uu2 +.a2 +.a\'a2 +.a\'e2 +.a\'i2 +.a\'o2 +.a\'u2 +.aa2 +.ae2 +.ai2 +.ao2 +.au2 +.e2 +.e\'a2 +.e\'e2 +.e\'i2 +.e\'o2 +.e\'u2 +.ea2 +.ee2 +.ei2 +.eo2 +.eu2 +.i2 +.i\'a2 +.i\'e2 +.i\'i2 +.i\'o2 +.i\'u2 +.ia2 +.ie2 +.ii2 +.io2 +.iu2 +.o2 +.o\'a2 +.o\'e2 +.o\'i2 +.o\'o2 +.o\'u2 +.oa2 +.oe2 +.oi2 +.oo2 +.ou2 +.u2 +.u\'a2 +.u\'e2 +.u\'i2 +.u\'o2 +.u\'u2 +.ua2 +.ue2 +.ui2 +.uo2 +.uu2 +2\'a. +2\'aa. +2\'ae. +2\'ai. +2\'ao. +2\'au. +2\'e. +2\'ea. +2\'ee. +2\'ei. +2\'eo. +2\'eu. +2\'i. +2\'ia. +2\'ie. +2\'ii. +2\'io. +2\'iu. +2\'o. +2\'oa. +2\'oe. +2\'oi. +2\'oo. +2\'ou. +2\'u. +2\'ua. +2\'ue. +2\'ui. +2\'uo. +2\'uu. +2\~n1\~n +2\~n1b +2\~n1c +2\~n1d +2\~n1f +2\~n1g +2\~n1h +2\~n1j +2\~n1k +2\~n1m +2\~n1n +2\~n1p +2\~n1q +2\~n1s +2\~n1t +2\~n1v +2\~n1w +2\~n1x +2\~n1y +2\~n1z +2a. +2a\'a. +2a\'e. +2a\'i. +2a\'o. +2a\'u. +2aa. +2ae. +2ai. +2ao. +2au. +2b1\~n +2b1b +2b1c +2b1d +2b1f +2b1g +2b1h +2b1j +2b1k +2b1m +2b1n +2b1p +2b1q +2b1s +2b1t +2b1v +2b1w +2b1x +2b1y +2b1z +2c1\~n +2c1b +2c1c +2c1d +2c1f +2c1g +2c1j +2c1k +2c1m +2c1n +2c1p +2c1q +2c1s +2c1t +2c1v +2c1w +2c1x +2c1y +2c1z +2d1\~n +2d1b +2d1c +2d1d +2d1f +2d1g +2d1h +2d1j +2d1k +2d1m +2d1n +2d1p +2d1q +2d1s +2d1t +2d1v +2d1w +2d1x +2d1y +2d1z +2e. +2e\'a. +2e\'e. +2e\'i. +2e\'o. +2e\'u. +2ea. +2ee. +2ei. +2eo. +2eu. +2f1\~n +2f1b +2f1c +2f1d +2f1f +2f1g +2f1h +2f1j +2f1k +2f1m +2f1n +2f1p +2f1q +2f1s +2f1t +2f1v +2f1w +2f1x +2f1y +2f1z +2g1\~n +2g1b +2g1c +2g1d +2g1f +2g1g +2g1h +2g1j +2g1k +2g1m +2g1n +2g1p +2g1q +2g1s +2g1t +2g1v +2g1w +2g1x +2g1y +2g1z +2h1\~n +2h1b +2h1c +2h1d +2h1f +2h1g +2h1h +2h1j +2h1k +2h1m +2h1n +2h1p +2h1q +2h1s +2h1t +2h1v +2h1w +2h1x +2h1y +2h1z +2i. +2i\'a. +2i\'e. +2i\'i. +2i\'o. +2i\'u. +2ia. +2ie. +2ii. +2io. +2iu. +2j1\~n +2j1b +2j1c +2j1d +2j1f +2j1g +2j1h +2j1j +2j1k +2j1m +2j1n +2j1p +2j1q +2j1s +2j1t +2j1v +2j1w +2j1x +2j1y +2j1z +2k1\~n +2k1b +2k1c +2k1d +2k1f +2k1g +2k1h +2k1j +2k1k +2k1m +2k1n +2k1p +2k1q +2k1s +2k1t +2k1v +2k1w +2k1x +2k1y +2k1z +2l1\~n +2l1b +2l1c +2l1d +2l1f +2l1g +2l1h +2l1j +2l1k +2l1m +2l1n +2l1p +2l1q +2l1s +2l1t +2l1v +2l1w +2l1x +2l1y +2l1z +2m1\~n +2m1b +2m1c +2m1d +2m1f +2m1g +2m1h +2m1j +2m1k +2m1l +2m1m +2m1n +2m1p +2m1q +2m1r +2m1s +2m1t +2m1v +2m1w +2m1x +2m1y +2m1z +2n1\~n +2n1b +2n1c +2n1d +2n1f +2n1g +2n1h +2n1j +2n1k +2n1l +2n1m +2n1n +2n1p +2n1q +2n1r +2n1s +2n1t +2n1v +2n1w +2n1x +2n1y +2n1z +2o. +2o\'a. +2o\'e. +2o\'i. +2o\'o. +2o\'u. +2oa. +2oe. +2oi. +2oo. +2ou. +2p1\~n +2p1b +2p1c +2p1d +2p1f +2p1g +2p1h +2p1j +2p1k +2p1m +2p1n +2p1p +2p1q +2p1s +2p1t +2p1v +2p1w +2p1x +2p1y +2p1z +2q1\~n +2q1b +2q1c +2q1d +2q1f +2q1g +2q1h +2q1j +2q1k +2q1m +2q1n +2q1p +2q1q +2q1s +2q1t +2q1v +2q1w +2q1x +2q1y +2q1z +2r1\~n +2r1b +2r1c +2r1d +2r1f +2r1g +2r1h +2r1j +2r1k +2r1m +2r1n +2r1p +2r1q +2r1s +2r1t +2r1v +2r1w +2r1x +2r1y +2r1z +2s1\~n +2s1b +2s1c +2s1d +2s1f +2s1g +2s1h +2s1j +2s1k +2s1m +2s1n +2s1p +2s1q +2s1s +2s1t +2s1v +2s1w +2s1x +2s1y +2s1z +2t1\~n +2t1b +2t1c +2t1d +2t1f +2t1g +2t1h +2t1j +2t1k +2t1m +2t1n +2t1p +2t1q +2t1s +2t1t +2t1v +2t1w +2t1x +2t1y +2t1z +2u. +2u\'a. +2u\'e. +2u\'i. +2u\'o. +2u\'u. +2ua. +2ue. +2ui. +2uo. +2uu. +2v1\~n +2v1b +2v1c +2v1d +2v1f +2v1g +2v1h +2v1j +2v1k +2v1m +2v1n +2v1p +2v1q +2v1s +2v1t +2v1v +2v1w +2v1x +2v1y +2v1z +2w1\~n +2w1b +2w1c +2w1d +2w1f +2w1g +2w1h +2w1j +2w1k +2w1m +2w1n +2w1p +2w1q +2w1s +2w1t +2w1v +2w1w +2w1x +2w1y +2w1z +2x1\~n +2x1b +2x1c +2x1d +2x1f +2x1g +2x1h +2x1j +2x1k +2x1m +2x1n +2x1p +2x1q +2x1s +2x1t +2x1v +2x1w +2x1x +2x1y +2x1z +2y1\~n +2y1b +2y1c +2y1d +2y1f +2y1g +2y1h +2y1j +2y1k +2y1m +2y1n +2y1p +2y1q +2y1s +2y1t +2y1v +2y1w +2y1x +2y1y +2y1z +2z1\~n +2z1b +2z1c +2z1d +2z1f +2z1g +2z1h +2z1j +2z1k +2z1m +2z1n +2z1p +2z1q +2z1s +2z1t +2z1v +2z1w +2z1x +2z1y +2z1z +\'a1\'i +\'a1\'u +\'a1\~n +\'a1a +\'a1b +\'a1c +\'a1d +\'a1e +\'a1f +\'a1g +\'a1h +\'a1j +\'a1k +\'a1l +\'a1m +\'a1n +\'a1o +\'a1p +\'a1q +\'a1r +\'a1s +\'a1t +\'a1v +\'a1w +\'a1x +\'a1y +\'a1z +\'a2\~n. +\'a2b. +\'a2c. +\'a2d. +\'a2f. +\'a2g. +\'a2h. +\'a2j. +\'a2k. +\'a2l. +\'a2m. +\'a2n. +\'a2p. +\'a2q. +\'a2r. +\'a2s. +\'a2t. +\'a2v. +\'a2w. +\'a2x. +\'a2y. +\'a2z. +\'e1\'i +\'e1\'u +\'e1\~n +\'e1a +\'e1b +\'e1c +\'e1d +\'e1e +\'e1f +\'e1g +\'e1h +\'e1j +\'e1k +\'e1l +\'e1m +\'e1n +\'e1o +\'e1p +\'e1q +\'e1r +\'e1s +\'e1t +\'e1v +\'e1w +\'e1x +\'e1y +\'e1z +\'e2\~n. +\'e2b. +\'e2c. +\'e2d. +\'e2f. +\'e2g. +\'e2h. +\'e2j. +\'e2k. +\'e2l. +\'e2m. +\'e2n. +\'e2p. +\'e2q. +\'e2r. +\'e2s. +\'e2t. +\'e2v. +\'e2w. +\'e2x. +\'e2y. +\'e2z. +\'i1\'a +\'i1\'e +\'i1\'o +\'i1\~n +\'i1a +\'i1b +\'i1c +\'i1d +\'i1e +\'i1f +\'i1g +\'i1h +\'i1j +\'i1k +\'i1l +\'i1m +\'i1n +\'i1o +\'i1p +\'i1q +\'i1r +\'i1s +\'i1t +\'i1v +\'i1w +\'i1x +\'i1y +\'i1z +\'i2\~n. +\'i2b. +\'i2c. +\'i2d. +\'i2f. +\'i2g. +\'i2h. +\'i2j. +\'i2k. +\'i2l. +\'i2m. +\'i2n. +\'i2p. +\'i2q. +\'i2r. +\'i2s. +\'i2t. +\'i2v. +\'i2w. +\'i2x. +\'i2y. +\'i2z. +\'o1\'i +\'o1\'u +\'o1\~n +\'o1a +\'o1b +\'o1c +\'o1d +\'o1e +\'o1f +\'o1g +\'o1h +\'o1j +\'o1k +\'o1l +\'o1m +\'o1n +\'o1o +\'o1p +\'o1q +\'o1r +\'o1s +\'o1t +\'o1v +\'o1w +\'o1x +\'o1y +\'o1z +\'o2\~n. +\'o2b. +\'o2c. +\'o2d. +\'o2f. +\'o2g. +\'o2h. +\'o2j. +\'o2k. +\'o2l. +\'o2m. +\'o2n. +\'o2p. +\'o2q. +\'o2r. +\'o2s. +\'o2t. +\'o2v. +\'o2w. +\'o2x. +\'o2y. +\'o2z. +\'u1\'a +\'u1\'e +\'u1\'o +\'u1\~n +\'u1a +\'u1b +\'u1c +\'u1d +\'u1e +\'u1f +\'u1g +\'u1h +\'u1j +\'u1k +\'u1l +\'u1m +\'u1n +\'u1o +\'u1p +\'u1q +\'u1r +\'u1s +\'u1t +\'u1v +\'u1w +\'u1x +\'u1y +\'u1z +\'u2\~n. +\'u2b. +\'u2c. +\'u2d. +\'u2f. +\'u2g. +\'u2h. +\'u2j. +\'u2k. +\'u2l. +\'u2m. +\'u2n. +\'u2p. +\'u2q. +\'u2r. +\'u2s. +\'u2t. +\'u2v. +\'u2w. +\'u2x. +\'u2y. +\'u2z. +a1\'a +a1\'e +a1\'i +a1\'o +a1\'u +a1\~n +a1a +a1b +a1c +a1d +a1e +a1f +a1g +a1h +a1j +a1k +a1l +a1m +a1n +a1o +a1p +a1q +a1r +a1s +a1t +a1v +a1w +a1x +a1y +a1z +a2\~n. +a2b. +a2c. +a2d. +a2f. +a2g. +a2h. +a2j. +a2k. +a2l. +a2m. +a2n. +a2p. +a2q. +a2r. +a2s. +a2t. +a2v. +a2w. +a2x. +a2y. +a2z. +e1\'a +e1\'e +e1\'i +e1\'o +e1\'u +e1\~n +e1a +e1b +e1c +e1d +e1e +e1f +e1g +e1h +e1j +e1k +e1l +e1m +e1n +e1o +e1p +e1q +e1r +e1s +e1t +e1v +e1w +e1x +e1y +e1z +e2\~n. +e2b. +e2c. +e2d. +e2f. +e2g. +e2h. +e2j. +e2k. +e2l. +e2m. +e2n. +e2p. +e2q. +e2r. +e2s. +e2t. +e2v. +e2w. +e2x. +e2y. +e2z. +i1\~n +i1b +i1c +i1d +i1f +i1g +i1h +i1j +i1k +i1l +i1m +i1n +i1p +i1q +i1r +i1s +i1t +i1v +i1w +i1x +i1y +i1z +i2\~n. +i2b. +i2c. +i2d. +i2f. +i2g. +i2h. +i2j. +i2k. +i2l. +i2m. +i2n. +i2p. +i2q. +i2r. +i2s. +i2t. +i2v. +i2w. +i2x. +i2y. +i2z. +o1\'a +o1\'e +o1\'i +o1\'o +o1\'u +o1\~n +o1a +o1b +o1c +o1d +o1e +o1f +o1g +o1h +o1j +o1k +o1l +o1m +o1n +o1o +o1p +o1q +o1r +o1s +o1t +o1v +o1w +o1x +o1y +o1z +o2\~n. +o2b. +o2c. +o2d. +o2f. +o2g. +o2h. +o2j. +o2k. +o2l. +o2m. +o2n. +o2p. +o2q. +o2r. +o2s. +o2t. +o2v. +o2w. +o2x. +o2y. +o2z. +u1\~n +u1b +u1c +u1d +u1f +u1g +u1h +u1j +u1k +u1l +u1m +u1n +u1p +u1q +u1r +u1s +u1t +u1v +u1w +u1x +u1y +u1z +u2\~n. +u2b. +u2c. +u2d. +u2f. +u2g. +u2h. +u2j. +u2k. +u2l. +u2m. +u2n. +u2p. +u2q. +u2r. +u2s. +u2t. +u2v. +u2w. +u2x. +u2y. +u2z. diff --git a/src/bootsupport/modules/textutil/expander-1.3.1.tm b/src/bootsupport/modules/textutil/expander-1.3.1.tm new file mode 100644 index 0000000..9ce76d8 --- /dev/null +++ b/src/bootsupport/modules/textutil/expander-1.3.1.tm @@ -0,0 +1,1122 @@ +#--------------------------------------------------------------------- +# TITLE: +# expander.tcl +# +# AUTHOR: +# Will Duquette +# +# DESCRIPTION: +# +# An expander is an object that takes as input text with embedded +# Tcl code and returns text with the embedded code expanded. The +# text can be provided all at once or incrementally. +# +# See expander.[e]html for usage info. +# Also expander.n +# +# LICENSE: +# Copyright (C) 2001 by William H. Duquette. See expander_license.txt, +# distributed with this file, for license information. +# +# CHANGE LOG: +# +# 10/31/01: V0.9 code is complete. +# 11/23/01: Added "evalcmd"; V1.0 code is complete. + +# Provide the package. + +# Create the package's namespace. + +namespace eval ::textutil { + namespace eval expander { + # All indices are prefixed by "$exp-". + # + # lb The left bracket sequence + # rb The right bracket sequence + # errmode How to handle macro errors: + # nothing, macro, error, fail. + # evalcmd The evaluation command. + # textcmd The plain text processing command. + # level The context level + # output-$level The accumulated text at this context level. + # name-$level The tag name of this context level + # data-$level-$var A variable of this context level + + variable Info + + # In methods, the current object: + variable This "" + + # Export public commands + namespace export expander + } + + #namespace import expander::* + namespace export expander + + proc expander {name} {uplevel ::textutil::expander::expander [list $name]} +} + +#--------------------------------------------------------------------- +# FUNCTION: +# expander name +# +# INPUTS: +# name A proc name for the new object. If not +# fully-qualified, it is assumed to be relative +# to the caller's namespace. +# +# RETURNS: +# nothing +# +# DESCRIPTION: +# Creates a new expander object. + +proc ::textutil::expander::expander {name} { + variable Info + + # FIRST, qualify the name. + if {![string match "::*" $name]} { + # Get caller's namespace; append :: if not global namespace. + set ns [uplevel 1 namespace current] + if {"::" != $ns} { + append ns "::" + } + + set name "$ns$name" + } + + # NEXT, Check the name + if {"" != [info commands $name]} { + return -code error "command name \"$name\" already exists" + } + + # NEXT, Create the object. + proc $name {method args} [format { + if {[catch {::textutil::expander::Methods %s $method $args} result]} { + return -code error $result + } else { + return $result + } + } $name] + + # NEXT, Initialize the object + Op_reset $name + + return $name +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Methods name method argList +# +# INPUTS: +# name The object's fully qualified procedure name. +# This argument is provided by the object command +# itself. +# method The method to call. +# argList Arguments for the specific method. +# +# RETURNS: +# Depends on the method +# +# DESCRIPTION: +# Handles all method dispatch for a expander object. +# The expander's object command merely passes its arguments to +# this function, which dispatches the arguments to the +# appropriate method procedure. If the method raises an error, +# the method procedure's name in the error message is replaced +# by the object and method names. + +proc ::textutil::expander::Methods {name method argList} { + variable Info + variable This + + switch -exact -- $method { + expand - + lb - + rb - + setbrackets - + errmode - + evalcmd - + textcmd - + cpush - + ctopandclear - + cis - + cname - + cset - + cget - + cvar - + cpop - + cappend - + where - + reset { + # FIRST, execute the method, first setting This to the object + # name; then, after the method has been called, restore the + # old object name. + set oldThis $This + set This $name + + set retval [catch "Op_$method $name $argList" result] + + set This $oldThis + + # NEXT, handle the result based on the retval. + if {$retval} { + regsub -- "Op_$method" $result "$name $method" result + return -code error $result + } else { + return $result + } + } + default { + return -code error "\"$name $method\" is not defined" + } + } +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Get key +# +# INPUTS: +# key A key into the Info array, excluding the +# object name. E.g., "lb" +# +# RETURNS: +# The value from the array +# +# DESCRIPTION: +# Gets the value of an entry from Info for This. + +proc ::textutil::expander::Get {key} { + variable Info + variable This + + return $Info($This-$key) +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Set key value +# +# INPUTS: +# key A key into the Info array, excluding the +# object name. E.g., "lb" +# +# value A Tcl value +# +# RETURNS: +# The value +# +# DESCRIPTION: +# Sets the value of an entry in Info for This. + +proc ::textutil::expander::Set {key value} { + variable Info + variable This + + return [set Info($This-$key) $value] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Var key +# +# INPUTS: +# key A key into the Info array, excluding the +# object name. E.g., "lb" +# +# RETURNS: +# The full variable name, suitable for setting or lappending + +proc ::textutil::expander::Var {key} { + variable Info + variable This + + return ::textutil::expander::Info($This-$key) +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Contains list value +# +# INPUTS: +# list any list +# value any value +# +# RETURNS: +# TRUE if the list contains the value, and false otherwise. + +proc ::textutil::expander::Contains {list value} { + if {[lsearch -exact $list $value] == -1} { + return 0 + } else { + return 1 + } +} + + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_lb ?newbracket? +# +# INPUTS: +# newbracket If given, the new bracket token. +# +# RETURNS: +# The current left bracket +# +# DESCRIPTION: +# Returns the current left bracket token. + +proc ::textutil::expander::Op_lb {name {newbracket ""}} { + if {[string length $newbracket] != 0} { + Set lb $newbracket + } + return [Get lb] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_rb ?newbracket? +# +# INPUTS: +# newbracket If given, the new bracket token. +# +# RETURNS: +# The current left bracket +# +# DESCRIPTION: +# Returns the current left bracket token. + +proc ::textutil::expander::Op_rb {name {newbracket ""}} { + if {[string length $newbracket] != 0} { + Set rb $newbracket + } + return [Get rb] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_setbrackets lbrack rbrack +# +# INPUTS: +# lbrack The new left bracket +# rbrack The new right bracket +# +# RETURNS: +# nothing +# +# DESCRIPTION: +# Sets the brackets as a pair. + +proc ::textutil::expander::Op_setbrackets {name lbrack rbrack} { + Set lb $lbrack + Set rb $rbrack + return +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_errmode ?newErrmode? +# +# INPUTS: +# newErrmode If given, the new error mode. +# +# RETURNS: +# The current error mode +# +# DESCRIPTION: +# Returns the current error mode. + +proc ::textutil::expander::Op_errmode {name {newErrmode ""}} { + if {[string length $newErrmode] != 0} { + if {![Contains "macro nothing error fail" $newErrmode]} { + error "$name errmode: Invalid error mode: $newErrmode" + } + + Set errmode $newErrmode + } + return [Get errmode] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_evalcmd ?newEvalCmd? +# +# INPUTS: +# newEvalCmd If given, the new eval command. +# +# RETURNS: +# The current eval command +# +# DESCRIPTION: +# Returns the current eval command. This is the command used to +# evaluate macros; it defaults to "uplevel #0". + +proc ::textutil::expander::Op_evalcmd {name {newEvalCmd ""}} { + if {[string length $newEvalCmd] != 0} { + Set evalcmd $newEvalCmd + } + return [Get evalcmd] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_textcmd ?newTextCmd? +# +# INPUTS: +# newTextCmd If given, the new text command. +# +# RETURNS: +# The current text command +# +# DESCRIPTION: +# Returns the current text command. This is the command used to +# process plain text. It defaults to {}, meaning identity. + +proc ::textutil::expander::Op_textcmd {name args} { + switch -exact [llength $args] { + 0 {} + 1 {Set textcmd [lindex $args 0]} + default { + return -code error "wrong#args for textcmd: name ?newTextcmd?" + } + } + return [Get textcmd] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_reset +# +# INPUTS: +# none +# +# RETURNS: +# nothing +# +# DESCRIPTION: +# Resets all object values, as though it were brand new. + +proc ::textutil::expander::Op_reset {name} { + variable Info + + if {[info exists Info($name-lb)]} { + foreach elt [array names Info "$name-*"] { + unset Info($elt) + } + } + + set Info($name-lb) "\[" + set Info($name-rb) "\]" + set Info($name-errmode) "fail" + set Info($name-evalcmd) "uplevel #0" + set Info($name-textcmd) "" + set Info($name-level) 0 + set Info($name-output-0) "" + set Info($name-name-0) ":0" + + return +} + +#------------------------------------------------------------------------- +# Context: Every expansion takes place in its own context; however, +# a macro can push a new context, causing the text it returns and all +# subsequent text to be saved separately. Later, a matching macro can +# pop the context, acquiring all text saved since the first command, +# and use that in its own output. + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_cpush cname +# +# INPUTS: +# cname The context name +# +# RETURNS: +# nothing +# +# DESCRIPTION: +# Pushes an empty macro context onto the stack. All expanded text +# will be added to this context until it is popped. + +proc ::textutil::expander::Op_cpush {name cname} { + # FRINK: nocheck + incr [Var level] + # FRINK: nocheck + set [Var output-[Get level]] {} + # FRINK: nocheck + set [Var name-[Get level]] $cname + + # The first level is init'd elsewhere (Op_expand) + if {[set [Var level]] < 2} return + + # Initialize the location information, inherit from the outer + # context. + + LocInit $cname + catch {LocSet $cname [LocGet $name]} + return +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_cis cname +# +# INPUTS: +# cname A context name +# +# RETURNS: +# true or false +# +# DESCRIPTION: +# Returns true if the current context has the specified name, and +# false otherwise. + +proc ::textutil::expander::Op_cis {name cname} { + return [expr {[string compare $cname [Op_cname $name]] == 0}] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_cname +# +# INPUTS: +# none +# +# RETURNS: +# The context name +# +# DESCRIPTION: +# Returns the name of the current context. + +proc ::textutil::expander::Op_cname {name} { + return [Get name-[Get level]] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_cset varname value +# +# INPUTS: +# varname The name of a context variable +# value The new value for the context variable +# +# RETURNS: +# The value +# +# DESCRIPTION: +# Sets a variable in the current context. + +proc ::textutil::expander::Op_cset {name varname value} { + Set data-[Get level]-$varname $value +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_cget varname +# +# INPUTS: +# varname The name of a context variable +# +# RETURNS: +# The value +# +# DESCRIPTION: +# Returns the value of a context variable. It's an error if +# the variable doesn't exist. + +proc ::textutil::expander::Op_cget {name varname} { + if {![info exists [Var data-[Get level]-$varname]]} { + error "$name cget: $varname doesn't exist in this context ([Get level])" + } + return [Get data-[Get level]-$varname] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_cvar varname +# +# INPUTS: +# varname The name of a context variable +# +# RETURNS: +# The index to the variable +# +# DESCRIPTION: +# Returns the index to a context variable, for use with set, +# lappend, etc. + +proc ::textutil::expander::Op_cvar {name varname} { + if {![info exists [Var data-[Get level]-$varname]]} { + error "$name cvar: $varname doesn't exist in this context" + } + + return [Var data-[Get level]-$varname] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_cpop cname +# +# INPUTS: +# cname The expected context name. +# +# RETURNS: +# The accumulated output in this context +# +# DESCRIPTION: +# Returns the accumulated output for the current context, first +# popping the context from the stack. The expected context name +# must match the real name, or an error occurs. + +proc ::textutil::expander::Op_cpop {name cname} { + variable Info + + if {[Get level] == 0} { + error "$name cpop underflow on '$cname'" + } + + if {[string compare [Op_cname $name] $cname] != 0} { + error "$name cpop context mismatch: expected [Op_cname $name], got $cname" + } + + set result [Get output-[Get level]] + # FRINK: nocheck + set [Var output-[Get level]] "" + # FRINK: nocheck + set [Var name-[Get level]] "" + + foreach elt [array names "Info data-[Get level]-*"] { + unset Info($elt) + } + + # FRINK: nocheck + incr [Var level] -1 + return $result +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_ctopandclear +# +# INPUTS: +# None. +# +# RETURNS: +# The accumulated output in the topmost context, clears the context, +# but does not pop it. +# +# DESCRIPTION: +# Returns the accumulated output for the current context, first +# popping the context from the stack. The expected context name +# must match the real name, or an error occurs. + +proc ::textutil::expander::Op_ctopandclear {name} { + variable Info + + if {[Get level] == 0} { + error "$name cpop underflow on '[Op_cname $name]'" + } + + set result [Get output-[Get level]] + Set output-[Get level] "" + return $result +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_cappend text +# +# INPUTS: +# text Text to add to the output +# +# RETURNS: +# The accumulated output +# +# DESCRIPTION: +# Appends the text to the accumulated output in the current context. + +proc ::textutil::expander::Op_cappend {name text} { + # FRINK: nocheck + append [Var output-[Get level]] $text +} + +#------------------------------------------------------------------------- +# Macro-expansion: The following code is the heart of the module. +# Given a text string, and the current variable settings, this code +# returns an expanded string, with all macros replaced. + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_expand inputString ?brackets? +# +# INPUTS: +# inputString The text to expand. +# brackets A list of two bracket tokens. +# +# RETURNS: +# The expanded text. +# +# DESCRIPTION: +# Finds all embedded macros in the input string, and expands them. +# If ?brackets? is given, it must be list of length 2, containing +# replacement left and right macro brackets; otherwise the default +# brackets are used. + +proc ::textutil::expander::Op_expand {name inputString {brackets ""}} { + # FIRST, push a new context onto the stack, and save the current + # brackets. + + Op_cpush $name expand + Op_cset $name lb [Get lb] + Op_cset $name rb [Get rb] + + # Keep position information in context variables as well. + # Line we are in, counting from 1; column we are at, + # counting from 0, and index of character we are at, + # counting from 0. Tabs counts as '1' when computing + # the column. + + LocInit $name + + # SF Tcllib Bug #530056. + set start_level [Get level] ; # remember this for check at end + + # NEXT, use the user's brackets, if given. + if {[llength $brackets] == 2} { + Set lb [lindex $brackets 0] + Set rb [lindex $brackets 1] + } + + # NEXT, loop over the string, finding and expanding macros. + while {[string length $inputString] > 0} { + set plainText [ExtractToToken inputString [Get lb] exclude] + + # FIRST, If there was plain text, append it to the output, and + # continue. + if {$plainText != ""} { + set input $plainText + set tc [Get textcmd] + if {[string length $tc] > 0} { + lappend tc $plainText + + if {![catch "[Get evalcmd] [list $tc]" result]} { + set plainText $result + } else { + HandleError $name {plain text} $tc $result + } + } + Op_cappend $name $plainText + LocUpdate $name $input + + if {[string length $inputString] == 0} { + break + } + } + + # NEXT, A macro is the next thing; process it. + if {[catch {GetMacro inputString} macro]} { + # SF tcllib bug 781973 ... Do not throw a regular + # error. Use HandleError to give the user control of the + # situation, via the defined error mode. The continue + # intercepts if the user allows the expansion to run on, + # yet we must not try to run the non-existing macro. + + HandleError $name {reading macro} $inputString $macro + continue + } + + # Expand the macro, and output the result, or + # handle an error. + if {![catch "[Get evalcmd] [list $macro]" result]} { + Op_cappend $name $result + + # We have to advance the location by the length of the + # macro, plus the two brackets. They were stripped by + # GetMacro, so we have to add them here again to make + # computation correct. + + LocUpdate $name [Get lb]${macro}[Get rb] + continue + } + + HandleError $name macro $macro $result + } + + # SF Tcllib Bug #530056. + if {[Get level] > $start_level} { + # The user macros pushed additional contexts, but forgot to + # pop them all. The main work here is to place all the still + # open contexts into the error message, and to produce + # syntactically correct english. + + set c [list] + set n [expr {[Get level] - $start_level}] + if {$n == 1} { + set ctx context + set verb was + } else { + set ctx contexts + set verb were + } + for {incr n -1} {$n >= 0} {incr n -1} { + lappend c [Get name-[expr {[Get level]-$n}]] + } + return -code error \ + "The following $ctx pushed by the macros $verb not popped: [join $c ,]." + } elseif {[Get level] < $start_level} { + set n [expr {$start_level - [Get level]}] + if {$n == 1} { + set ctx context + } else { + set ctx contexts + } + return -code error \ + "The macros popped $n more $ctx than they had pushed." + } + + Op_lb $name [Op_cget $name lb] + Op_rb $name [Op_cget $name rb] + + return [Op_cpop $name expand] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_where +# +# INPUTS: +# None. +# +# RETURNS: +# The current location in the input. +# +# DESCRIPTION: +# Retrieves the current location the expander +# is at during processing. + +proc ::textutil::expander::Op_where {name} { + return [LocGet $name] +} + +#--------------------------------------------------------------------- +# FUNCTION +# HandleError name title command errmsg +# +# INPUTS: +# name The name of the expander object in question. +# title A title text +# command The command which caused the error. +# errmsg The error message to report +# +# RETURNS: +# Nothing +# +# DESCRIPTIONS +# Is executed when an error in a macro or the plain text handler +# occurs. Generates an error message according to the current +# error mode. + +proc ::textutil::expander::HandleError {name title command errmsg} { + switch [Get errmode] { + nothing { } + macro { + # The location is irrelevant here. + Op_cappend $name "[Get lb]$command[Get rb]" + } + error { + foreach {ch line col} [LocGet $name] break + set display [DisplayOf $command] + + Op_cappend $name "\n=================================\n" + Op_cappend $name "*** Error in $title at line $line, column $col:\n" + Op_cappend $name "*** [Get lb]$display[Get rb]\n--> $errmsg\n" + Op_cappend $name "=================================\n" + } + fail { + foreach {ch line col} [LocGet $name] break + set display [DisplayOf $command] + + return -code error "Error in $title at line $line,\ + column $col:\n[Get lb]$display[Get rb]\n-->\ + $errmsg" + } + default { + return -code error "Unknown error mode: [Get errmode]" + } + } +} + +#--------------------------------------------------------------------- +# FUNCTION: +# ExtractToToken string token mode +# +# INPUTS: +# string The text to process. +# token The token to look for +# mode include or exclude +# +# RETURNS: +# The extracted text +# +# DESCRIPTION: +# Extract text from a string, up to or including a particular +# token. Remove the extracted text from the string. +# mode determines whether the found token is removed; +# it should be "include" or "exclude". The string is +# modified in place, and the extracted text is returned. + +proc ::textutil::expander::ExtractToToken {string token mode} { + upvar $string theString + + # First, determine the offset + switch $mode { + include { set offset [expr {[string length $token] - 1}] } + exclude { set offset -1 } + default { error "::expander::ExtractToToken: unknown mode $mode" } + } + + # Next, find the first occurrence of the token. + set tokenPos [string first $token $theString] + + # Next, return the entire string if it wasn't found, or just + # the part upto or including the character. + if {$tokenPos == -1} { + set theText $theString + set theString "" + } else { + set newEnd [expr {$tokenPos + $offset}] + set newBegin [expr {$newEnd + 1}] + set theText [string range $theString 0 $newEnd] + set theString [string range $theString $newBegin end] + } + + return $theText +} + +#--------------------------------------------------------------------- +# FUNCTION: +# GetMacro string +# +# INPUTS: +# string The text to process. +# +# RETURNS: +# The macro, stripped of its brackets. +# +# DESCRIPTION: + +proc ::textutil::expander::GetMacro {string} { + upvar $string theString + + # FIRST, it's an error if the string doesn't begin with a + # bracket. + if {[string first [Get lb] $theString] != 0} { + error "::expander::GetMacro: assertion failure, next text isn't a command! '$theString'" + } + + # NEXT, extract a full macro + set macro [ExtractToToken theString [Get lb] include] + while {[string length $theString] > 0} { + append macro [ExtractToToken theString [Get rb] include] + + # Verify that the command really ends with the [rb] characters, + # whatever they are. If not, break because of unexpected + # end of file. + if {![IsBracketed $macro]} { + break; + } + + set strippedMacro [StripBrackets $macro] + + if {[info complete "puts \[$strippedMacro\]"]} { + return $strippedMacro + } + } + + if {[string length $macro] > 40} { + set macro "[string range $macro 0 39]...\n" + } + error "Unexpected EOF in macro:\n$macro" +} + +# Strip left and right bracket tokens from the ends of a macro, +# provided that it's properly bracketed. +proc ::textutil::expander::StripBrackets {macro} { + set llen [string length [Get lb]] + set rlen [string length [Get rb]] + set tlen [string length $macro] + + return [string range $macro $llen [expr {$tlen - $rlen - 1}]] +} + +# Return 1 if the macro is properly bracketed, and 0 otherwise. +proc ::textutil::expander::IsBracketed {macro} { + set llen [string length [Get lb]] + set rlen [string length [Get rb]] + set tlen [string length $macro] + + set leftEnd [string range $macro 0 [expr {$llen - 1}]] + set rightEnd [string range $macro [expr {$tlen - $rlen}] end] + + if {$leftEnd != [Get lb]} { + return 0 + } elseif {$rightEnd != [Get rb]} { + return 0 + } else { + return 1 + } +} + +#--------------------------------------------------------------------- +# FUNCTION: +# LocInit name +# +# INPUTS: +# name The expander object to use. +# +# RETURNS: +# No result. +# +# DESCRIPTION: +# A convenience wrapper around LocSet. Initializes the location +# to the start of the input (char 0, line 1, column 0). + +proc ::textutil::expander::LocInit {name} { + LocSet $name {0 1 0} + return +} + +#--------------------------------------------------------------------- +# FUNCTION: +# LocSet name loc +# +# INPUTS: +# name The expander object to use. +# loc Location, list containing character position, +# line number and column, in this order. +# +# RETURNS: +# No result. +# +# DESCRIPTION: +# Sets the current location in the expander to 'loc'. + +proc ::textutil::expander::LocSet {name loc} { + foreach {ch line col} $loc break + Op_cset $name char $ch + Op_cset $name line $line + Op_cset $name col $col + return +} + +#--------------------------------------------------------------------- +# FUNCTION: +# LocGet name +# +# INPUTS: +# name The expander object to use. +# +# RETURNS: +# A list containing the current character position, line number +# and column, in this order. +# +# DESCRIPTION: +# Returns the current location as stored in the expander. + +proc ::textutil::expander::LocGet {name} { + list [Op_cget $name char] [Op_cget $name line] [Op_cget $name col] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# LocUpdate name text +# +# INPUTS: +# name The expander object to use. +# text The text to process. +# +# RETURNS: +# No result. +# +# DESCRIPTION: +# Takes the current location as stored in the expander, computes +# a new location based on the string (its length and contents +# (number of lines)), and makes that new location the current +# location. + +proc ::textutil::expander::LocUpdate {name text} { + foreach {ch line col} [LocGet $name] break + set numchars [string length $text] + #8.4+ set numlines [regexp -all "\n" $text] + set numlines [expr {[llength [split $text \n]]-1}] + + incr ch $numchars + incr line $numlines + if {$numlines} { + set col [expr {$numchars - [string last \n $text] - 1}] + } else { + incr col $numchars + } + + LocSet $name [list $ch $line $col] + return +} + +#--------------------------------------------------------------------- +# FUNCTION: +# LocRange name text +# +# INPUTS: +# name The expander object to use. +# text The text to process. +# +# RETURNS: +# A text range description, compatible with the 'location' data +# used in the tcl debugger/checker. +# +# DESCRIPTION: +# Takes the current location as stored in the expander object +# and the length of the text to generate a character range. + +proc ::textutil::expander::LocRange {name text} { + # Note that the structure is compatible with + # the ranges uses by tcl debugger and checker. + # {line {charpos length}} + + foreach {ch line col} [LocGet $name] break + return [list $line [list $ch [string length $text]]] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# DisplayOf text +# +# INPUTS: +# text The text to process. +# +# RETURNS: +# The text, cut down to at most 30 bytes. +# +# DESCRIPTION: +# Cuts the incoming text down to contain no more than 30 +# characters of the input. Adds an ellipsis (...) if characters +# were actually removed from the input. + +proc ::textutil::expander::DisplayOf {text} { + set ellip "" + while {[string bytelength $text] > 30} { + set ellip ... + set text [string range $text 0 end-1] + } + set display $text$ellip +} + +#--------------------------------------------------------------------- +# Provide the package only if the code above was read and executed +# without error. + +package provide textutil::expander 1.3.1 diff --git a/src/bootsupport/modules/textutil/ithyph.tex b/src/bootsupport/modules/textutil/ithyph.tex new file mode 100644 index 0000000..755e108 --- /dev/null +++ b/src/bootsupport/modules/textutil/ithyph.tex @@ -0,0 +1,223 @@ + +%%%%%%%%%%%%%%%%%%%% file ithyph.tex + +%%%%%%%%%%%%%%%%%%%%%%%%%%% file ithyph.tex %%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% +% Prepared by Claudio Beccari e-mail beccari@polito.it +% +% Dipartimento di Elettronica +% Politecnico di Torino +% Corso Duca degli Abruzzi, 24 +% 10129 TORINO +% +% Copyright 1998, 2001 Claudio Beccari +% +% This program can be redistributed and/or modified under the terms +% of the LaTeX Project Public License Distributed from CTAN +% archives in directory macros/latex/base/lppl.txt; either +% version 1 of the License, or any later version. +% +% \versionnumber{4.8d} \versiondate{2001/11/21} +% +% These hyphenation patterns for the Italian language are supposed to comply +% with the Reccomendation UNI 6461 on hyphenation issued by the Italian +% Standards Institution (Ente Nazionale di Unificazione UNI). No guarantee +% or declaration of fitness to any particular purpose is given and any +% liability is disclaimed. +% +% See comments and loading instructions at the end of the file after the +% \endinput line +% +{\lccode`\'=`\' % Apostrophe has its own lccode so that it is treated + % as a letter + %>> 1998/04/14 inserted grouping + % +%\lccode23=23 % Compound word mark is a letter in encoding T1 +%\def\W{^^W} % ^^W =\char23 = \char"17 =\char'27 +% +\patterns{ +.a3p2n % After the Garzanti dictionary: a-pnea, a-pnoi-co,... +.anti1 .anti3m2n +.bio1 +.ca4p3s +.circu2m1 +.di2s3cine +%.e2x +.fran2k3 +.free3 +.narco1 +.opto1 +.orto3p2 +.para1 +.poli3p2 +.pre1 +.p2s +%.ri1a2 .ri1e2 .re1i2 .ri1o2 .ri1u2 +.sha2re3 +.tran2s3c .tran2s3d .tran2s3f .tran2s3l .tran2s3n .tran2s3p .tran2s3r .tran2s3t +.su2b3lu .su2b3r +.wa2g3n +.wel2t1 +a1ia a1ie a1io a1iu a1uo a1ya 2at. +e1iu e2w +o1ia o1ie o1io o1iu +%u1u +% +%1\W0a2 1\W0e2 1\W0i2 1\W0o2 1\W0u2 +'2 +1b 2bb 2bc 2bd 2bf 2bm 2bn 2bp 2bs 2bt 2bv + b2l b2r 2b. 2b'. 2b'' +1c 2cb 2cc 2cd 2cf 2ck 2cm 2cn 2cq 2cs 2ct 2cz + 2chh c2h 2chb ch2r 2chn c2l c2r 2c. 2c'. 2c'' .c2 +1d 2db 2dd 2dg 2dl 2dm 2dn 2dp d2r 2ds 2dt 2dv 2dw + 2d. 2d'. 2d'' .d2 +1f 2fb 2fg 2ff 2fn f2l f2r 2fs 2ft 2f. 2f'. 2f'' +1g 2gb 2gd 2gf 2gg g2h g2l 2gm g2n 2gp g2r 2gs 2gt + 2gv 2gw 2gz 2gh2t 2g. 2g'. 2g'' +1h 2hb 2hd 2hh hi3p2n h2l 2hm 2hn 2hr 2hv 2h. 2h'. 2h'' +1j 2j. 2j'. 2j'' +1k 2kg 2kf k2h 2kk k2l 2km k2r 2ks 2kt 2k. 2k'. 2k'' +1l 2lb 2lc 2ld 2l3f2 2lg l2h 2lk 2ll 2lm 2ln 2lp + 2lq 2lr 2ls 2lt 2lv 2lw 2lz 2l. 2l'. 2l'' +1m 2mb 2mc 2mf 2ml 2mm 2mn 2mp 2mq 2mr 2ms 2mt 2mv 2mw + 2m. 2m'. 2m'' +1n 2nb 2nc 2nd 2nf 2ng 2nk 2nl 2nm 2nn 2np 2nq 2nr + 2ns 2nt 2nv 2nz n2g3n 2nheit. 2n. 2n' 2n'' +1p 2pd p2h p2l 2pn 3p2ne 2pp p2r 2ps 3p2sic 2pt 2pz 2p. 2p'. 2p'' +1q 2qq 2q. 2q'. 2q'' +1r 2rb 2rc 2rd 2rf r2h 2rg 2rk 2rl 2rm 2rn 2rp + 2rq 2rr 2rs 2rt rt2s3 2rv 2rx 2rw 2rz 2r. 2r'. 2r'' +1s2 2shm 2s3s s4s3m 2s3p2n 2stb 2stc 2std 2stf 2stg 2stm 2stn + 2stp 2sts 2stt 2stv 2sz 4s. 4s'. 4s'' +1t 2tb 2tc 2td 2tf 2tg t2h t2l 2tm 2tn 2tp t2r 2ts + 3t2sch 2tt 2tv 2tw t2z 2tzk 2tzs 2t. 2t'. 2t'' +1v 2vc v2l v2r 2vv 2v. 2v'. 2v'' +1w w2h wa2r 2w1y 2w. 2w'. 2w'' +1x 2xt 2xw 2x. 2x'. 2x'' +y1ou y1i +1z 2zb 2zd 2zl 2zn 2zp 2zt 2zs 2zv 2zz 2z. 2z'. 2z'' .z2 +}} % Pattern end + +\endinput + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Information %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + LOADING THESE PATTERNS + +These patterns, as well as those for any other language, do not become +effective until they are loaded in a special form into a format file; this +task is performed by the TeX initializer; any TeX system has its own +initializer with its special way of being activated. Before loading these +patterns, then, it is necessary to read very carefully the instructions that +come with your TeX system. + +Here I describe how to load the patterns with the freeware TeX system named +MiKTeX version 2.x for Windows 9x, NT, 2000, XP; with minor changes the +whole procedure is applicable with other TeX systems, but the details must +be deduced from your TeX system documentation at the section/chapter "How to +build or to rebuild a format file". + +With MikTeX: + +a) copy this file and replace the existing file ithyph.tex in the directory + \texmf\tex\generic\hyphen if the existing one has an older version date + and number. +b) select Start|Programs|MiKTeX|MiKTeX options. +c) in the Language tab add a check mark to the line concerning the Italian + language. +d) in the Geneal tab click "Update format files". +e) That's all! + +For the activation of these patterns with the specific Italian typesetting +features, use the babel package as this: + +\documentclass{article} % Or whatever other class +\usepackage[italian]{babel} +... +\begin{document} +... +\end{document} + + + ON ITALIAN HYPHENATION + +I have been working on patterns for the Italian language since 1987; in 1992 +I published + +C. Beccari, "Computer aided hyphenation for Italian and Modern + Latin", TUG vol. 13, n. 1, pp. 23-33 (1992) + +which contained a set of patterns that allowed hyphenation for both Italian +and Latin; a slightly modified version of the patterns published in the +above paper is contained in LAHYPH.TEX available on the CTAN archives. + +From the above patterns I extracted the minimum set necessary for +hyphenating Italian that was made available on the CTAN archives with the +name ITHYPH.tex the version number 3.5 on the 16th of August 1994. + +The original pattern set required 37 ops; being interested in a local +version of TeX/LaTeX capable of dealing with half a dozen languages, I +wanted to reduce memory occupation and therefore the number of ops. + +Th new version (4.0 released in 1996) of ITHYPH.TEX is much simpler than +version 3.5 and requires just 29 ops while it retains all the power of +version 3.5; it contains many more new patterns that allow to hyphenate +unusual words that generally have a root borrowed from a foreign language. +Updated versions 4.x contain minor additions and the number of ops is +increased to 30 (version 4.7 of 1998/06/01). + +This new pattern set has been tested with the same set of difficult Italian +words that was used to test version 3.5 and it yields the same results (a +part a minor change that was deliberately introduced so as to reduce the +typographical hyphenation with hyathi, since hyphenated hyathi are not +appreciated by Italian readers). A new enlarged word set for testing +purposes gets correct hyphen points that were missed or wrongly placed with +version 3.5, although no error had been reported, because such words are of +very specialized nature and are seldom used. + +As the previous version, this new set of patterns does not contain any +accented character so that the hyphenation algorithm behaves properly in +both cases, that is with cm and with dc/ec fonts. With LaTeXe terminology +the difference is between OT1 and T1 encodings; with the former encoding +fonts do not contain accented characters, while with the latter accented +characters are present and sequences such as \`a map directly to slot "E0 +that contains "agrave". + +Of course if you use dc/ec fonts (or any other real or virtual font with T1 +encoding) you get the full power of the hyphenation algorithm, while if you +use cm fonts (or any other real or virtual font with OT1 encoding) you miss +some possible break points; this is not a big inconvenience in Italian +because: + +1) The Regulation UNI 6015 on accents specifies that compulsory accents + appear only on the ending vowel of oxitone words; this means that it is + almost indifferent to have or to miss the dc/ec fonts because the only + difference consists in how TeX evaluates the end of the word; in practice + if you have these special facilities you get "qua-li-t\`a", while if you + miss them, you get "qua-lit\`a" (assuming that \righthyphenmin > 1). + +2) Optional accents are so rare in Italian, that if you absolutely want to + use them in those rare instances, and you miss the T1 encoding + facilities, you should also provide explicit discretionary hyphens as in + "s\'e\-gui\-to". + +There is no explicit hyphenation exception list because these patterns +proved to hyphenate correctly a very large set of words suitably chosen in +order to test them in the most heavy circumstances; these patterns were used +in the preparation of a number of books and no errors were discovered. + +Nevertheless if you frequently use technical terms that you want hyphenated +differently from what is normally done (for example if you prefer +etymological hyphenation of prefixed and/or suffixed words) you should +insert a specific hyphenation list in the preamble of your document, for +example: + +\hyphenation{su-per-in-dut-to-re su-per-in-dut-to-ri} + +Should you find any word that gets hyphenated in a wrong way, please, AFTER +CHECKING ON A RELIABLE MODERN DICTIONARY, report to the author, preferably +by e-mail. + + + Happy multilingual typesetting ! diff --git a/src/bootsupport/modules/textutil/patch-0.1.tm b/src/bootsupport/modules/textutil/patch-0.1.tm new file mode 100644 index 0000000..cf68959 --- /dev/null +++ b/src/bootsupport/modules/textutil/patch-0.1.tm @@ -0,0 +1,180 @@ +# patch.tcl -- +# +# Application of a diff -ruN patch to a directory tree. +# +# Copyright (c) 2019 Christian Gollwitzer +# with tweaks by Andreas Kupries +# - Factored patch parsing into a helper +# - Replaced `puts` with report callback. + +package require Tcl 8.5 +package provide textutil::patch 0.1 + +# # ## ### ##### ######## ############# ##################### + +namespace eval ::textutil::patch { + namespace export apply + namespace ensemble create +} + +# # ## ### ##### ######## ############# ##################### + +proc ::textutil::patch::apply {dir striplevel patch reportcmd} { + set patchdict [Parse $dir $striplevel $patch] + + # Apply, now that we have parsed the patch. + dict for {fn hunks} $patchdict { + Report apply $fn + if {[catch {open $fn} fd]} { + set orig {} + } else { + set orig [split [read $fd] \n] + } + close $fd + + set patched $orig + + set fail false + set already_applied false + set hunknr 1 + foreach hunk $hunks { + dict with hunk { + set oldend [expr {$oldstart+[llength $oldcode]-1}] + set newend [expr {$newstart+[llength $newcode]-1}] + # check if the hunk matches + set origcode [lrange $orig $oldstart $oldend] + if {$origcode ne $oldcode} { + set fail true + # check if the patch is already applied + set origcode_applied [lrange $orig $newstart $newend] + if {$origcode_applied eq $newcode} { + set already_applied true + Report fail-already $fn $hunknr + } else { + Report fail $fn $hunknr $oldcode $origcode + } + break + } + # apply patch + set patched [list \ + {*}[lrange $patched 0 $newstart-1] \ + {*}$newcode \ + {*}[lrange $orig $oldend+1 end]] + } + incr hunknr + } + + if {!$fail} { + # success - write the result back + set fd [open $fn w] + puts -nonewline $fd [join $patched \n] + close $fd + } + } + + return +} + +# # ## ### ##### ######## ############# ##################### + +proc ::textutil::patch::Report args { + upvar 1 reportcmd reportcmd + uplevel #0 [list {*}$reportcmd {*}$args] + ## + # apply $fname + # fail-already $fname $hunkno + # fail $fname $hunkno $expected $seen + ## +} + +proc ::textutil::patch::Parse {dir striplevel patch} { + set patchlines [split $patch \n] + set inhunk false + set oldcode {} + set newcode {} + set n [llength $patchlines] + + set patchdict {} + for {set lineidx 0} {$lineidx < $n} {incr lineidx} { + set line [lindex $patchlines $lineidx] + if {[string match ---* $line]} { + # a diff block starts. Current line should be + # --- oldfile date time TZ + # Next line should be + # +++ newfile date time TZ + set in $line + incr lineidx + set out [lindex $patchlines $lineidx] + + if {![string match ---* $in] || ![string match +++* $out]} { + #puts $in + #puts $out + return -code error "Patch not in unified diff format, line $lineidx $in $out" + } + + # the quoting is compatible with list + lassign $in -> oldfile + lassign $out -> newfile + + set fntopatch [file join $dir {*}[lrange [file split $oldfile] $striplevel end]] + set inhunk false + #puts "Found diffline for $fntopatch" + continue + } + + # state machine for parsing the hunks + set typechar [string index $line 0] + set codeline [string range $line 1 end] + switch $typechar { + @ { + if {![regexp {@@\s+\-(\d+),(\d+)\s+\+(\d+),(\d+)\s+@@} $line \ + -> oldstart oldlen newstart newlen]} { + return code -error "Erroneous hunk in line $lindeidx, $line" + } + # adjust line numbers for 0-based indexing + incr oldstart -1 + incr newstart -1 + #puts "New hunk" + set newcode {} + set oldcode {} + set inhunk true + } + - { # line only in old code + if {$inhunk} { + lappend oldcode $codeline + } + } + + { # line only in new code + if {$inhunk} { + lappend newcode $codeline + } + } + " " { # common line + if {$inhunk} { + lappend oldcode $codeline + lappend newcode $codeline + } + } + default { + # puts "Junk: $codeline"; + continue + } + } + # test if the hunk is complete + if {[llength $oldcode]==$oldlen && [llength $newcode]==$newlen} { + set hunk [dict create \ + oldcode $oldcode \ + newcode $newcode \ + oldstart $oldstart \ + newstart $newstart] + #puts "hunk complete: $hunk" + set inhunk false + dict lappend patchdict $fntopatch $hunk + } + } + + return $patchdict +} + +# # ## ### ##### ######## ############# ##################### +return diff --git a/src/bootsupport/modules/textutil/repeat-0.7.tm b/src/bootsupport/modules/textutil/repeat-0.7.tm new file mode 100644 index 0000000..24f8693 --- /dev/null +++ b/src/bootsupport/modules/textutil/repeat-0.7.tm @@ -0,0 +1,91 @@ +# repeat.tcl -- +# +# Emulation of string repeat for older +# revisions of Tcl. +# +# Copyright (c) 2000 by Ajuba Solutions. +# Copyright (c) 2001-2006 by Andreas Kupries +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: repeat.tcl,v 1.1 2006/04/21 04:42:28 andreas_kupries Exp $ + +# ### ### ### ######### ######### ######### +## Requirements + +package require Tcl 8.2 + +namespace eval ::textutil::repeat {} + +# ### ### ### ######### ######### ######### + +namespace eval ::textutil::repeat { + variable HaveBuiltin [expr {![catch {string repeat a 1}]}] +} + +if {0} { + # Problems with the deactivated code: + # - Linear in 'num'. + # - Tests for 'string repeat' in every call! + # (Ok, just the variable, still a test every call) + # - Fails for 'num == 0' because of undefined 'str'. + + proc textutil::repeat::StrRepeat { char num } { + variable HaveBuiltin + if { $HaveBuiltin == 0 } then { + for { set i 0 } { $i < $num } { incr i } { + append str $char + } + } else { + set str [ string repeat $char $num ] + } + return $str + } +} + +if {$::textutil::repeat::HaveBuiltin} { + proc ::textutil::repeat::strRepeat {char num} { + return [string repeat $char $num] + } + + proc ::textutil::repeat::blank {n} { + return [string repeat " " $n] + } +} else { + proc ::textutil::repeat::strRepeat {char num} { + if {$num <= 0} { + # No replication required + return "" + } elseif {$num == 1} { + # Quick exit for recursion + return $char + } elseif {$num == 2} { + # Another quick exit for recursion + return $char$char + } elseif {0 == ($num % 2)} { + # Halving the problem results in O (log n) complexity. + set result [strRepeat $char [expr {$num / 2}]] + return "$result$result" + } else { + # Uneven length, reduce problem by one + return "$char[strRepeat $char [incr num -1]]" + } + } + + proc ::textutil::repeat::blank {n} { + return [strRepeat " " $n] + } +} + +# ### ### ### ######### ######### ######### +## Data structures + +namespace eval ::textutil::repeat { + namespace export strRepeat blank +} + +# ### ### ### ######### ######### ######### +## Ready + +package provide textutil::repeat 0.7 diff --git a/src/bootsupport/modules/textutil/split-0.8.tm b/src/bootsupport/modules/textutil/split-0.8.tm new file mode 100644 index 0000000..18ee13b --- /dev/null +++ b/src/bootsupport/modules/textutil/split-0.8.tm @@ -0,0 +1,176 @@ +# split.tcl -- +# +# Various ways of splitting a string. +# +# Copyright (c) 2000 by Ajuba Solutions. +# Copyright (c) 2000 by Eric Melski +# Copyright (c) 2001 by Reinhard Max +# Copyright (c) 2003 by Pat Thoyts +# Copyright (c) 2001-2006 by Andreas Kupries +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: split.tcl,v 1.7 2006/04/21 04:42:28 andreas_kupries Exp $ + +# ### ### ### ######### ######### ######### +## Requirements + +package require Tcl 8.2 + +namespace eval ::textutil::split {} + +######################################################################## +# This one was written by Bob Techentin (RWT in Tcl'ers Wiki): +# http://www.techentin.net +# mailto:techentin.robert@mayo.edu +# +# Later, he send me an email stated that I can use it anywhere, because +# no copyright was added, so the code is defacto in the public domain. +# +# You can found it in the Tcl'ers Wiki here: +# http://mini.net/cgi-bin/wikit/460.html +# +# Bob wrote: +# If you need to split string into list using some more complicated rule +# than builtin split command allows, use following function. It mimics +# Perl split operator which allows regexp as element separator, but, +# like builtin split, it expects string to split as first arg and regexp +# as second (optional) By default, it splits by any amount of whitespace. +# Note that if you add parenthesis into regexp, parenthesed part of separator +# would be added into list as additional element. Just like in Perl. -- cary +# +# Speed improvement by Reinhard Max: +# Instead of repeatedly copying around the not yet matched part of the +# string, I use [regexp]'s -start option to restrict the match to that +# part. This reduces the complexity from something like O(n^1.5) to +# O(n). My test case for that was: +# +# foreach i {1 10 100 1000 10000} { +# set s [string repeat x $i] +# puts [time {splitx $s .}] +# } +# + +if {[package vsatisfies [package provide Tcl] 8.3]} { + + proc ::textutil::split::splitx {str {regexp {[\t \r\n]+}}} { + # Bugfix 476988 + if {[string length $str] == 0} { + return {} + } + if {[string length $regexp] == 0} { + return [::split $str ""] + } + if {[regexp $regexp {}]} { + return -code error \ + "splitting on regexp \"$regexp\" would cause infinite loop" + } + + set list {} + set start 0 + while {[regexp -start $start -indices -- $regexp $str match submatch]} { + foreach {subStart subEnd} $submatch break + foreach {matchStart matchEnd} $match break + incr matchStart -1 + incr matchEnd + lappend list [string range $str $start $matchStart] + if {$subStart >= $start} { + lappend list [string range $str $subStart $subEnd] + } + set start $matchEnd + } + lappend list [string range $str $start end] + return $list + } + +} else { + # For tcl <= 8.2 we do not have regexp -start... + proc ::textutil::split::splitx [list str [list regexp "\[\t \r\n\]+"]] { + + if {[string length $str] == 0} { + return {} + } + if {[string length $regexp] == 0} { + return [::split $str {}] + } + if {[regexp $regexp {}]} { + return -code error \ + "splitting on regexp \"$regexp\" would cause infinite loop" + } + + set list {} + while {[regexp -indices -- $regexp $str match submatch]} { + lappend list [string range $str 0 [expr {[lindex $match 0] -1}]] + if {[lindex $submatch 0] >= 0} { + lappend list [string range $str [lindex $submatch 0] \ + [lindex $submatch 1]] + } + set str [string range $str [expr {[lindex $match 1]+1}] end] + } + lappend list $str + return $list + } + +} + +# +# splitn -- +# +# splitn splits the string $str into chunks of length $len. These +# chunks are returned as a list. +# +# If $str really contains a ByteArray object (as retrieved from binary +# encoded channels) splitn must honor this by splitting the string +# into chunks of $len bytes. +# +# It is an error to call splitn with a nonpositive $len. +# +# If splitn is called with an empty string, it returns the empty list. +# +# If the length of $str is not an entire multiple of the chunk length, +# the last chunk in the generated list will be shorter than $len. +# +# The implementation presented here was given by Bryan Oakley, as +# part of a ``contest'' I staged on c.l.t in July 2004. I selected +# this version, as it does not rely on runtime generated code, is +# very fast for chunk size one, not too bad in all the other cases, +# and uses [split] or [string range] which have been around for quite +# some time. +# +# -- Robert Suetterlin (robert@mpe.mpg.de) +# +proc ::textutil::split::splitn {str {len 1}} { + + if {$len <= 0} { + return -code error "len must be > 0" + } + + if {$len == 1} { + return [split $str {}] + } + + set result [list] + set max [string length $str] + set i 0 + set j [expr {$len -1}] + while {$i < $max} { + lappend result [string range $str $i $j] + incr i $len + incr j $len + } + + return $result +} + +# ### ### ### ######### ######### ######### +## Data structures + +namespace eval ::textutil::split { + namespace export splitx splitn +} + +# ### ### ### ######### ######### ######### +## Ready + +package provide textutil::split 0.8 diff --git a/src/bootsupport/modules/textutil/string-0.8.tm b/src/bootsupport/modules/textutil/string-0.8.tm new file mode 100644 index 0000000..f1ad5a4 --- /dev/null +++ b/src/bootsupport/modules/textutil/string-0.8.tm @@ -0,0 +1,144 @@ +# string.tcl -- +# +# Utilities for manipulating strings, words, single lines, +# paragraphs, ... +# +# Copyright (c) 2000 by Ajuba Solutions. +# Copyright (c) 2000 by Eric Melski +# Copyright (c) 2002 by Joe English +# Copyright (c) 2001-2014 by Andreas Kupries +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: string.tcl,v 1.2 2008/03/22 16:03:11 mic42 Exp $ + +# ### ### ### ######### ######### ######### +## Requirements + +package require Tcl 8.2 + +namespace eval ::textutil::string {} + +# ### ### ### ######### ######### ######### +## API implementation + +# @c Removes the last character from the given . +# +# @a string: The string to manipulate. +# +# @r The without its last character. +# +# @i chopping + +proc ::textutil::string::chop {string} { + return [string range $string 0 [expr {[string length $string]-2}]] +} + +# @c Removes the first character from the given . +# @c Convenience procedure. +# +# @a string: string to manipulate. +# +# @r The without its first character. +# +# @i tail + +proc ::textutil::string::tail {string} { + return [string range $string 1 end] +} + +# @c Capitalizes first character of the given . +# @c Complementary procedure to

. +# +# @a string: string to manipulate. +# +# @r The with its first character capitalized. +# +# @i capitalize + +proc ::textutil::string::cap {string} { + return [string toupper [string index $string 0]][string range $string 1 end] +} + +# @c unCapitalizes first character of the given . +# @c Complementary procedure to

. +# +# @a string: string to manipulate. +# +# @r The with its first character uncapitalized. +# +# @i uncapitalize + +proc ::textutil::string::uncap {string} { + return [string tolower [string index $string 0]][string range $string 1 end] +} + +# @c Capitalizes first character of each word of the given . +# +# @a sentence: string to manipulate. +# +# @r The with the first character of each word capitalized. +# +# @i capitalize + +proc ::textutil::string::capEachWord {sentence} { + regsub -all {\S+} [string map {\\ \\\\ \$ \\$} $sentence] {[string toupper [string index & 0]][string range & 1 end]} cmd + return [subst -nobackslashes -novariables $cmd] +} + +# Compute the longest string which is common to all strings given to +# the command, and at the beginning of said strings, i.e. a prefix. If +# only one argument is specified it is treated as a list of the +# strings to look at. If more than one argument is specified these +# arguments are the strings to be looked at. If only one string is +# given, in either form, the string is returned, as it is its own +# longest common prefix. + +proc ::textutil::string::longestCommonPrefix {args} { + return [longestCommonPrefixList $args] +} + +proc ::textutil::string::longestCommonPrefixList {list} { + if {[llength $list] <= 1} { + return [lindex $list 0] + } + + set list [lsort $list] + set min [lindex $list 0] + set max [lindex $list end] + + # Min and max are the two strings which are most different. If + # they have a common prefix, it will also be the common prefix for + # all of them. + + # Fast bailouts for common cases. + + set n [string length $min] + if {$n == 0} {return ""} + if {0 == [string compare $min $max]} {return $min} + + set prefix "" + set i 0 + while {[string index $min $i] == [string index $max $i]} { + append prefix [string index $min $i] + if {[incr i] > $n} {break} + } + set prefix +} + +# ### ### ### ######### ######### ######### +## Data structures + +namespace eval ::textutil::string { + # Export the imported commands + + namespace export chop tail cap uncap capEachWord + namespace export longestCommonPrefix + namespace export longestCommonPrefixList +} + +# ### ### ### ######### ######### ######### +## Ready + +package provide textutil::string 0.8 diff --git a/src/bootsupport/modules/textutil/tabify-0.7.tm b/src/bootsupport/modules/textutil/tabify-0.7.tm new file mode 100644 index 0000000..543b96c --- /dev/null +++ b/src/bootsupport/modules/textutil/tabify-0.7.tm @@ -0,0 +1,289 @@ +# +# As the author of the procs 'tabify2' and 'untabify2' I suggest that the +# comments explaining their behaviour be kept in this file. +# 1) Beginners in any programming language (I am new to Tcl so I know what I +# am talking about) can profit enormously from studying 'correct' code. +# Of course comments will help a lot in this regard. +# 2) Many problems newbies face can be solved by directing them towards +# available libraries - after all, libraries have been written to solve +# recurring problems. Then they can just use them, or have a closer look +# to see and to discover how things are done the 'Tcl way'. +# 3) And if ever a proc from a library should be less than perfect, having +# comments explaining the behaviour of the code will surely help. +# +# This said, I will welcome any error reports or suggestions for improvements +# (especially on the 'doing things the Tcl way' aspect). +# +# Use of these sources is licensed under the same conditions as is Tcl. +# +# June 2001, Helmut Giese (hgiese@ratiosoft.com) +# +# ---------------------------------------------------------------------------- +# +# The original procs 'tabify' and 'untabify' each work with complete blocks +# of $num spaces ('num' holding the tab size). While this is certainly useful +# in some circumstances, it does not reflect the way an editor works: +# Counting columns from 1, assuming a tab size of 8 and entering '12345' +# followed by a tab, you expect to advance to column 9. Your editor might +# put a tab into the file or 3 spaces, depending on its configuration. +# Now, on 'tabifying' you will expect to see those 3 spaces converted to a +# tab (and on the other hand expect the tab *at this position* to be +# converted to 3 spaces). +# +# This behaviour is mimicked by the new procs 'tabify2' and 'untabify2'. +# Both have one feature in common: They accept multi-line strings (a whole +# file if you want to) but in order to make life simpler for the programmer, +# they split the incoming string into individual lines and hand each line to +# a proc that does the real work. +# +# One design decision worth mentioning here: +# A single space is never converted to a tab even if its position would +# allow to do so. +# Single spaces occur very often, say in arithmetic expressions like +# [expr (($a + $b) * $c) < $d]. If we didn't follow the above rule we might +# need to replace one or more of them to tabs. However if the tab size gets +# changed, this expression would be formatted quite differently - which is +# probably not a good idea. +# +# 'untabifying' on the other hand might need to replace a tab with a single +# space: If the current position requires it, what else to do? +# As a consequence those two procs are unsymmetric in this aspect, but I +# couldn't think of a better solution. Could you? +# +# ---------------------------------------------------------------------------- +# + +# ### ### ### ######### ######### ######### +## Requirements + +package require Tcl 8.2 +package require textutil::repeat + +namespace eval ::textutil::tabify {} + +# ### ### ### ######### ######### ######### +## API implementation + +namespace eval ::textutil::tabify { + namespace import -force ::textutil::repeat::strRepeat +} + +proc ::textutil::tabify::tabify { string { num 8 } } { + return [string map [list [MakeTabStr $num] \t] $string] +} + +proc ::textutil::tabify::untabify { string { num 8 } } { + return [string map [list \t [MakeTabStr $num]] $string] +} + +proc ::textutil::tabify::MakeTabStr { num } { + variable TabStr + variable TabLen + + if { $TabLen != $num } then { + set TabLen $num + set TabStr [strRepeat " " $num] + } + + return $TabStr +} + +# ---------------------------------------------------------------------------- +# +# tabifyLine: Works on a single line of text, replacing 'spaces at correct +# positions' with tabs. $num is the requested tab size. +# Returns the (possibly modified) line. +# +# 'spaces at correct positions': Only spaces which 'fill the space' between +# an arbitrary position and the next tab stop can be replaced. +# Example: With tab size 8, spaces at positions 11 - 13 will *not* be replaced, +# because an expansion of a tab at position 11 will jump up to 16. +# See also the comment at the beginning of this file why single spaces are +# *never* replaced by a tab. +# +# The proc works backwards, from the end of the string up to the beginning: +# - Set the position to start the search from ('lastPos') to 'end'. +# - Find the last occurrence of ' ' in 'line' with respect to 'lastPos' +# ('currPos' below). This is a candidate for replacement. +# - Find to 'currPos' the following tab stop using the expression +# set nextTab [expr ($currPos + $num) - ($currPos % $num)] +# and get the previous tab stop as well (this will be the starting +# point for the next iteration). +# - The ' ' at 'currPos' is only a candidate for replacement if +# 1) it is just one position before a tab stop *and* +# 2) there is at least one space at its left (see comment above on not +# touching an isolated space). +# Continue, if any of these conditions is not met. +# - Determine where to put the tab (that is: how many spaces to replace?) +# by stepping up to the beginning until +# -- you hit a non-space or +# -- you are at the previous tab position +# - Do the replacement and continue. +# +# This algorithm only works, if $line does not contain tabs. Otherwise our +# interpretation of any position beyond the tab will be wrong. (Imagine you +# find a ' ' at position 4 in $line. If you got 3 leading tabs, your *real* +# position might be 25 (tab size of 8). Since in real life some strings might +# already contain tabs, we test for it (and eventually call untabifyLine). +# + +proc ::textutil::tabify::tabifyLine { line num } { + if { [string first \t $line] != -1 } { + # assure array 'Spaces' is set up 'comme il faut' + checkArr $num + # remove existing tabs + set line [untabifyLine $line $num] + } + + set lastPos end + + while { $lastPos > 0 } { + set currPos [string last " " $line $lastPos] + if { $currPos == -1 } { + # no more spaces + break; + } + + set nextTab [expr {($currPos + $num) - ($currPos % $num)}] + set prevTab [expr {$nextTab - $num}] + + # prepare for next round: continue at 'previous tab stop - 1' + set lastPos [expr {$prevTab - 1}] + + if { ($currPos + 1) != $nextTab } { + continue ;# crit. (1) + } + + if { [string index $line [expr {$currPos - 1}]] != " " } { + continue ;# crit. (2) + } + + # now step backwards while there are spaces + for {set pos [expr {$currPos - 2}]} {$pos >= $prevTab} {incr pos -1} { + if { [string index $line $pos] != " " } { + break; + } + } + + # ... and replace them + set line [string replace $line [expr {$pos + 1}] $currPos \t] + } + return $line +} + +# +# Helper proc for 'untabifyLine': Checks if all needed elements of array +# 'Spaces' exist and creates the missing ones if needed. +# + +proc ::textutil::tabify::checkArr { num } { + variable TabLen2 + variable Spaces + + if { $num > $TabLen2 } { + for { set i [expr {$TabLen2 + 1}] } { $i <= $num } { incr i } { + set Spaces($i) [strRepeat " " $i] + } + set TabLen2 $num + } +} + + +# untabifyLine: Works on a single line of text, replacing tabs with enough +# spaces to get to the next tab position. +# Returns the (possibly modified) line. +# +# The procedure is straight forward: +# - Find the next tab. +# - Calculate the next tab position following it. +# - Delete the tab and insert as many spaces as needed to get there. +# + +proc ::textutil::tabify::untabifyLine { line num } { + variable Spaces + + set currPos 0 + while { 1 } { + set currPos [string first \t $line $currPos] + if { $currPos == -1 } { + # no more tabs + break + } + + # how far is the next tab position ? + set dist [expr {$num - ($currPos % $num)}] + # replace '\t' at $currPos with $dist spaces + set line [string replace $line $currPos $currPos $Spaces($dist)] + + # set up for next round (not absolutely necessary but maybe a trifle + # more efficient) + incr currPos $dist + } + return $line +} + +# tabify2: Replace all 'appropriate' spaces as discussed above with tabs. +# 'string' might hold any number of lines, 'num' is the requested tab size. +# Returns (possibly modified) 'string'. +# +proc ::textutil::tabify::tabify2 { string { num 8 } } { + + # split string into individual lines + set inLst [split $string \n] + + # now work on each line + set outLst [list] + foreach line $inLst { + lappend outLst [tabifyLine $line $num] + } + + # return all as one string + return [join $outLst \n] +} + + +# untabify2: Replace all tabs with the appropriate number of spaces. +# 'string' might hold any number of lines, 'num' is the requested tab size. +# Returns (possibly modified) 'string'. +# +proc ::textutil::tabify::untabify2 { string { num 8 } } { + + # assure array 'Spaces' is set up 'comme il faut' + checkArr $num + + set inLst [split $string \n] + + set outLst [list] + foreach line $inLst { + lappend outLst [untabifyLine $line $num] + } + + return [join $outLst \n] +} + + + +# ### ### ### ######### ######### ######### +## Data structures + +namespace eval ::textutil::tabify { + variable TabLen 8 + variable TabStr [strRepeat " " $TabLen] + + namespace export tabify untabify tabify2 untabify2 + + # The proc 'untabify2' uses the following variables for efficiency. + # Since a tab can be replaced by one up to 'tab size' spaces, it is handy + # to have the appropriate 'space strings' available. This is the use of + # the array 'Spaces', where 'Spaces(n)' contains just 'n' spaces. + # The variable 'TabLen2' remembers the biggest tab size used. + + variable TabLen2 0 + variable Spaces + array set Spaces {0 ""} +} + +# ### ### ### ######### ######### ######### +## Ready + +package provide textutil::tabify 0.7 diff --git a/src/bootsupport/modules/textutil/trim-0.7.tm b/src/bootsupport/modules/textutil/trim-0.7.tm new file mode 100644 index 0000000..4aab076 --- /dev/null +++ b/src/bootsupport/modules/textutil/trim-0.7.tm @@ -0,0 +1,112 @@ +# trim.tcl -- +# +# Various ways of trimming a string. +# +# Copyright (c) 2000 by Ajuba Solutions. +# Copyright (c) 2000 by Eric Melski +# Copyright (c) 2001-2006 by Andreas Kupries +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: trim.tcl,v 1.5 2006/04/21 04:42:28 andreas_kupries Exp $ + +# ### ### ### ######### ######### ######### +## Requirements + +package require Tcl 8.2 + +namespace eval ::textutil::trim {} + +# ### ### ### ######### ######### ######### +## API implementation + +proc ::textutil::trim::trimleft {text {trim "[ \t]+"}} { + regsub -line -all -- [MakeStr $trim left] $text {} text + return $text +} + +proc ::textutil::trim::trimright {text {trim "[ \t]+"}} { + regsub -line -all -- [MakeStr $trim right] $text {} text + return $text +} + +proc ::textutil::trim::trim {text {trim "[ \t]+"}} { + regsub -line -all -- [MakeStr $trim left] $text {} text + regsub -line -all -- [MakeStr $trim right] $text {} text + return $text +} + + + +# @c Strips from , if found at its start. +# +# @a text: The string to check for . +# @a prefix: The string to remove from . +# +# @r The , but without . +# +# @i remove, prefix + +proc ::textutil::trim::trimPrefix {text prefix} { + if {[string first $prefix $text] == 0} { + return [string range $text [string length $prefix] end] + } else { + return $text + } +} + + +# @c Removes the Heading Empty Lines of . +# +# @a text: The text block to manipulate. +# +# @r The , but without heading empty lines. +# +# @i remove, empty lines + +proc ::textutil::trim::trimEmptyHeading {text} { + regsub -- "^(\[ \t\]*\n)*" $text {} text + return $text +} + +# ### ### ### ######### ######### ######### +## Helper commands. Internal + +proc ::textutil::trim::MakeStr { string pos } { + variable StrU + variable StrR + variable StrL + + if { "$string" != "$StrU" } { + set StrU $string + set StrR "(${StrU})\$" + set StrL "^(${StrU})" + } + if { "$pos" == "left" } { + return $StrL + } + if { "$pos" == "right" } { + return $StrR + } + + return -code error "Panic, illegal position key \"$pos\"" +} + +# ### ### ### ######### ######### ######### +## Data structures + +namespace eval ::textutil::trim { + variable StrU "\[ \t\]+" + variable StrR "(${StrU})\$" + variable StrL "^(${StrU})" + + namespace export \ + trim trimright trimleft \ + trimPrefix trimEmptyHeading +} + +# ### ### ### ######### ######### ######### +## Ready + +package provide textutil::trim 0.7 diff --git a/src/bootsupport/modules/textutil/wcswidth-35.1.tm b/src/bootsupport/modules/textutil/wcswidth-35.1.tm new file mode 100644 index 0000000..080a881 --- /dev/null +++ b/src/bootsupport/modules/textutil/wcswidth-35.1.tm @@ -0,0 +1,772 @@ +### +# This file is automatically generated by the build/build.tcl file +# based on information in the following database: +# http://www.unicode.org/Public/UCD/latest/ucd/EastAsianWidth.txt +# +# (This is the 35th edition, thus version 35 for our package) +# +# Author: Sean Woods +### +package provide textutil::wcswidth 35.1 +proc ::textutil::wcswidth_type char { + if {$char == 161} { return A } + if {$char == 164} { return A } + if {$char == 167} { return A } + if {$char == 168} { return A } + if {$char == 170} { return A } + if {$char == 173} { return A } + if {$char == 174} { return A } + if {$char == 176} { return A } + if {$char == 177} { return A } + if {$char >= 178 && $char <= 179 } { return A } + if {$char == 180} { return A } + if {$char >= 182 && $char <= 183 } { return A } + if {$char == 184} { return A } + if {$char == 185} { return A } + if {$char == 186} { return A } + if {$char >= 188 && $char <= 190 } { return A } + if {$char == 191} { return A } + if {$char == 198} { return A } + if {$char == 208} { return A } + if {$char == 215} { return A } + if {$char == 216} { return A } + if {$char >= 222 && $char <= 225 } { return A } + if {$char == 230} { return A } + if {$char >= 232 && $char <= 234 } { return A } + if {$char >= 236 && $char <= 237 } { return A } + if {$char == 240} { return A } + if {$char >= 242 && $char <= 243 } { return A } + if {$char == 247} { return A } + if {$char >= 248 && $char <= 250 } { return A } + if {$char == 252} { return A } + if {$char == 254} { return A } + if {$char == 257} { return A } + if {$char == 273} { return A } + if {$char == 275} { return A } + if {$char == 283} { return A } + if {$char >= 294 && $char <= 295 } { return A } + if {$char == 299} { return A } + if {$char >= 305 && $char <= 307 } { return A } + if {$char == 312} { return A } + if {$char >= 319 && $char <= 322 } { return A } + if {$char == 324} { return A } + if {$char >= 328 && $char <= 331 } { return A } + if {$char == 333} { return A } + if {$char >= 338 && $char <= 339 } { return A } + if {$char >= 358 && $char <= 359 } { return A } + if {$char == 363} { return A } + if {$char == 462} { return A } + if {$char == 464} { return A } + if {$char == 466} { return A } + if {$char == 468} { return A } + if {$char == 470} { return A } + if {$char == 472} { return A } + if {$char == 474} { return A } + if {$char == 476} { return A } + if {$char == 593} { return A } + if {$char == 609} { return A } + if {$char == 708} { return A } + if {$char == 711} { return A } + if {$char >= 713 && $char <= 715 } { return A } + if {$char == 717} { return A } + if {$char == 720} { return A } + if {$char >= 728 && $char <= 731 } { return A } + if {$char == 733} { return A } + if {$char == 735} { return A } + if {$char >= 768 && $char <= 879 } { return A } + if {$char >= 913 && $char <= 929 } { return A } + if {$char >= 931 && $char <= 937 } { return A } + if {$char >= 945 && $char <= 961 } { return A } + if {$char >= 963 && $char <= 969 } { return A } + if {$char == 1025} { return A } + if {$char >= 1040 && $char <= 1103 } { return A } + if {$char == 1105} { return A } + if {$char >= 4352 && $char <= 4447 } { return W } + if {$char == 8208} { return A } + if {$char >= 8211 && $char <= 8213 } { return A } + if {$char == 8214} { return A } + if {$char == 8216} { return A } + if {$char == 8217} { return A } + if {$char == 8220} { return A } + if {$char == 8221} { return A } + if {$char >= 8224 && $char <= 8226 } { return A } + if {$char >= 8228 && $char <= 8231 } { return A } + if {$char == 8240} { return A } + if {$char >= 8242 && $char <= 8243 } { return A } + if {$char == 8245} { return A } + if {$char == 8251} { return A } + if {$char == 8254} { return A } + if {$char == 8308} { return A } + if {$char == 8319} { return A } + if {$char >= 8321 && $char <= 8324 } { return A } + if {$char == 8361} { return H } + if {$char == 8364} { return A } + if {$char == 8451} { return A } + if {$char == 8453} { return A } + if {$char == 8457} { return A } + if {$char == 8467} { return A } + if {$char == 8470} { return A } + if {$char >= 8481 && $char <= 8482 } { return A } + if {$char == 8486} { return A } + if {$char == 8491} { return A } + if {$char >= 8531 && $char <= 8532 } { return A } + if {$char >= 8539 && $char <= 8542 } { return A } + if {$char >= 8544 && $char <= 8555 } { return A } + if {$char >= 8560 && $char <= 8569 } { return A } + if {$char == 8585} { return A } + if {$char >= 8592 && $char <= 8596 } { return A } + if {$char >= 8597 && $char <= 8601 } { return A } + if {$char >= 8632 && $char <= 8633 } { return A } + if {$char == 8658} { return A } + if {$char == 8660} { return A } + if {$char == 8679} { return A } + if {$char == 8704} { return A } + if {$char >= 8706 && $char <= 8707 } { return A } + if {$char >= 8711 && $char <= 8712 } { return A } + if {$char == 8715} { return A } + if {$char == 8719} { return A } + if {$char == 8721} { return A } + if {$char == 8725} { return A } + if {$char == 8730} { return A } + if {$char >= 8733 && $char <= 8736 } { return A } + if {$char == 8739} { return A } + if {$char == 8741} { return A } + if {$char >= 8743 && $char <= 8748 } { return A } + if {$char == 8750} { return A } + if {$char >= 8756 && $char <= 8759 } { return A } + if {$char >= 8764 && $char <= 8765 } { return A } + if {$char == 8776} { return A } + if {$char == 8780} { return A } + if {$char == 8786} { return A } + if {$char >= 8800 && $char <= 8801 } { return A } + if {$char >= 8804 && $char <= 8807 } { return A } + if {$char >= 8810 && $char <= 8811 } { return A } + if {$char >= 8814 && $char <= 8815 } { return A } + if {$char >= 8834 && $char <= 8835 } { return A } + if {$char >= 8838 && $char <= 8839 } { return A } + if {$char == 8853} { return A } + if {$char == 8857} { return A } + if {$char == 8869} { return A } + if {$char == 8895} { return A } + if {$char == 8978} { return A } + if {$char >= 8986 && $char <= 8987 } { return W } + if {$char == 9001} { return W } + if {$char == 9002} { return W } + if {$char >= 9193 && $char <= 9196 } { return W } + if {$char == 9200} { return W } + if {$char == 9203} { return W } + if {$char >= 9312 && $char <= 9371 } { return A } + if {$char >= 9372 && $char <= 9449 } { return A } + if {$char >= 9451 && $char <= 9471 } { return A } + if {$char >= 9472 && $char <= 9547 } { return A } + if {$char >= 9552 && $char <= 9587 } { return A } + if {$char >= 9600 && $char <= 9615 } { return A } + if {$char >= 9618 && $char <= 9621 } { return A } + if {$char >= 9632 && $char <= 9633 } { return A } + if {$char >= 9635 && $char <= 9641 } { return A } + if {$char >= 9650 && $char <= 9651 } { return A } + if {$char == 9654} { return A } + if {$char == 9655} { return A } + if {$char >= 9660 && $char <= 9661 } { return A } + if {$char == 9664} { return A } + if {$char == 9665} { return A } + if {$char >= 9670 && $char <= 9672 } { return A } + if {$char == 9675} { return A } + if {$char >= 9678 && $char <= 9681 } { return A } + if {$char >= 9698 && $char <= 9701 } { return A } + if {$char == 9711} { return A } + if {$char >= 9725 && $char <= 9726 } { return W } + if {$char >= 9733 && $char <= 9734 } { return A } + if {$char == 9737} { return A } + if {$char >= 9742 && $char <= 9743 } { return A } + if {$char >= 9748 && $char <= 9749 } { return W } + if {$char == 9756} { return A } + if {$char == 9758} { return A } + if {$char == 9792} { return A } + if {$char == 9794} { return A } + if {$char >= 9800 && $char <= 9811 } { return W } + if {$char >= 9824 && $char <= 9825 } { return A } + if {$char >= 9827 && $char <= 9829 } { return A } + if {$char >= 9831 && $char <= 9834 } { return A } + if {$char >= 9836 && $char <= 9837 } { return A } + if {$char == 9839} { return A } + if {$char == 9855} { return W } + if {$char == 9875} { return W } + if {$char >= 9886 && $char <= 9887 } { return A } + if {$char == 9889} { return W } + if {$char >= 9898 && $char <= 9899 } { return W } + if {$char >= 9917 && $char <= 9918 } { return W } + if {$char == 9919} { return A } + if {$char >= 9924 && $char <= 9925 } { return W } + if {$char >= 9926 && $char <= 9933 } { return A } + if {$char == 9934} { return W } + if {$char >= 9935 && $char <= 9939 } { return A } + if {$char == 9940} { return W } + if {$char >= 9941 && $char <= 9953 } { return A } + if {$char == 9955} { return A } + if {$char >= 9960 && $char <= 9961 } { return A } + if {$char == 9962} { return W } + if {$char >= 9963 && $char <= 9969 } { return A } + if {$char >= 9970 && $char <= 9971 } { return W } + if {$char == 9972} { return A } + if {$char == 9973} { return W } + if {$char >= 9974 && $char <= 9977 } { return A } + if {$char == 9978} { return W } + if {$char >= 9979 && $char <= 9980 } { return A } + if {$char == 9981} { return W } + if {$char >= 9982 && $char <= 9983 } { return A } + if {$char == 9989} { return W } + if {$char >= 9994 && $char <= 9995 } { return W } + if {$char == 10024} { return W } + if {$char == 10045} { return A } + if {$char == 10060} { return W } + if {$char == 10062} { return W } + if {$char >= 10067 && $char <= 10069 } { return W } + if {$char == 10071} { return W } + if {$char >= 10102 && $char <= 10111 } { return A } + if {$char >= 10133 && $char <= 10135 } { return W } + if {$char == 10160} { return W } + if {$char == 10175} { return W } + if {$char >= 11035 && $char <= 11036 } { return W } + if {$char == 11088} { return W } + if {$char == 11093} { return W } + if {$char >= 11094 && $char <= 11097 } { return A } + if {$char >= 11904 && $char <= 11929 } { return W } + if {$char >= 11931 && $char <= 12019 } { return W } + if {$char >= 12032 && $char <= 12245 } { return W } + if {$char >= 12272 && $char <= 12283 } { return W } + if {$char == 12288} { return F } + if {$char >= 12289 && $char <= 12291 } { return W } + if {$char == 12292} { return W } + if {$char == 12293} { return W } + if {$char == 12294} { return W } + if {$char == 12295} { return W } + if {$char == 12296} { return W } + if {$char == 12297} { return W } + if {$char == 12298} { return W } + if {$char == 12299} { return W } + if {$char == 12300} { return W } + if {$char == 12301} { return W } + if {$char == 12302} { return W } + if {$char == 12303} { return W } + if {$char == 12304} { return W } + if {$char == 12305} { return W } + if {$char >= 12306 && $char <= 12307 } { return W } + if {$char == 12308} { return W } + if {$char == 12309} { return W } + if {$char == 12310} { return W } + if {$char == 12311} { return W } + if {$char == 12312} { return W } + if {$char == 12313} { return W } + if {$char == 12314} { return W } + if {$char == 12315} { return W } + if {$char == 12316} { return W } + if {$char == 12317} { return W } + if {$char >= 12318 && $char <= 12319 } { return W } + if {$char == 12320} { return W } + if {$char >= 12321 && $char <= 12329 } { return W } + if {$char >= 12330 && $char <= 12333 } { return W } + if {$char >= 12334 && $char <= 12335 } { return W } + if {$char == 12336} { return W } + if {$char >= 12337 && $char <= 12341 } { return W } + if {$char >= 12342 && $char <= 12343 } { return W } + if {$char >= 12344 && $char <= 12346 } { return W } + if {$char == 12347} { return W } + if {$char == 12348} { return W } + if {$char == 12349} { return W } + if {$char == 12350} { return W } + if {$char >= 12353 && $char <= 12438 } { return W } + if {$char >= 12441 && $char <= 12442 } { return W } + if {$char >= 12443 && $char <= 12444 } { return W } + if {$char >= 12445 && $char <= 12446 } { return W } + if {$char == 12447} { return W } + if {$char == 12448} { return W } + if {$char >= 12449 && $char <= 12538 } { return W } + if {$char == 12539} { return W } + if {$char >= 12540 && $char <= 12542 } { return W } + if {$char == 12543} { return W } + if {$char >= 12549 && $char <= 12591 } { return W } + if {$char >= 12593 && $char <= 12686 } { return W } + if {$char >= 12688 && $char <= 12689 } { return W } + if {$char >= 12690 && $char <= 12693 } { return W } + if {$char >= 12694 && $char <= 12703 } { return W } + if {$char >= 12704 && $char <= 12730 } { return W } + if {$char >= 12736 && $char <= 12771 } { return W } + if {$char >= 12784 && $char <= 12799 } { return W } + if {$char >= 12800 && $char <= 12830 } { return W } + if {$char >= 12832 && $char <= 12841 } { return W } + if {$char >= 12842 && $char <= 12871 } { return W } + if {$char >= 12872 && $char <= 12879 } { return A } + if {$char == 12880} { return W } + if {$char >= 12881 && $char <= 12895 } { return W } + if {$char >= 12896 && $char <= 12927 } { return W } + if {$char >= 12928 && $char <= 12937 } { return W } + if {$char >= 12938 && $char <= 12976 } { return W } + if {$char >= 12977 && $char <= 12991 } { return W } + if {$char >= 12992 && $char <= 13054 } { return W } + if {$char >= 13056 && $char <= 13311 } { return W } + if {$char >= 13312 && $char <= 19893 } { return W } + if {$char >= 19894 && $char <= 19903 } { return W } + if {$char >= 19968 && $char <= 40943 } { return W } + if {$char >= 40944 && $char <= 40959 } { return W } + if {$char >= 40960 && $char <= 40980 } { return W } + if {$char == 40981} { return W } + if {$char >= 40982 && $char <= 42124 } { return W } + if {$char >= 42128 && $char <= 42182 } { return W } + if {$char >= 43360 && $char <= 43388 } { return W } + if {$char >= 44032 && $char <= 55203 } { return W } + if {$char >= 57344 && $char <= 63743 } { return A } + if {$char >= 63744 && $char <= 64109 } { return W } + if {$char >= 64110 && $char <= 64111 } { return W } + if {$char >= 64112 && $char <= 64217 } { return W } + if {$char >= 64218 && $char <= 64255 } { return W } + if {$char >= 65024 && $char <= 65039 } { return A } + if {$char >= 65040 && $char <= 65046 } { return W } + if {$char == 65047} { return W } + if {$char == 65048} { return W } + if {$char == 65049} { return W } + if {$char == 65072} { return W } + if {$char >= 65073 && $char <= 65074 } { return W } + if {$char >= 65075 && $char <= 65076 } { return W } + if {$char == 65077} { return W } + if {$char == 65078} { return W } + if {$char == 65079} { return W } + if {$char == 65080} { return W } + if {$char == 65081} { return W } + if {$char == 65082} { return W } + if {$char == 65083} { return W } + if {$char == 65084} { return W } + if {$char == 65085} { return W } + if {$char == 65086} { return W } + if {$char == 65087} { return W } + if {$char == 65088} { return W } + if {$char == 65089} { return W } + if {$char == 65090} { return W } + if {$char == 65091} { return W } + if {$char == 65092} { return W } + if {$char >= 65093 && $char <= 65094 } { return W } + if {$char == 65095} { return W } + if {$char == 65096} { return W } + if {$char >= 65097 && $char <= 65100 } { return W } + if {$char >= 65101 && $char <= 65103 } { return W } + if {$char >= 65104 && $char <= 65106 } { return W } + if {$char >= 65108 && $char <= 65111 } { return W } + if {$char == 65112} { return W } + if {$char == 65113} { return W } + if {$char == 65114} { return W } + if {$char == 65115} { return W } + if {$char == 65116} { return W } + if {$char == 65117} { return W } + if {$char == 65118} { return W } + if {$char >= 65119 && $char <= 65121 } { return W } + if {$char == 65122} { return W } + if {$char == 65123} { return W } + if {$char >= 65124 && $char <= 65126 } { return W } + if {$char == 65128} { return W } + if {$char == 65129} { return W } + if {$char >= 65130 && $char <= 65131 } { return W } + if {$char >= 65281 && $char <= 65283 } { return F } + if {$char == 65284} { return F } + if {$char >= 65285 && $char <= 65287 } { return F } + if {$char == 65288} { return F } + if {$char == 65289} { return F } + if {$char == 65290} { return F } + if {$char == 65291} { return F } + if {$char == 65292} { return F } + if {$char == 65293} { return F } + if {$char >= 65294 && $char <= 65295 } { return F } + if {$char >= 65296 && $char <= 65305 } { return F } + if {$char >= 65306 && $char <= 65307 } { return F } + if {$char >= 65308 && $char <= 65310 } { return F } + if {$char >= 65311 && $char <= 65312 } { return F } + if {$char >= 65313 && $char <= 65338 } { return F } + if {$char == 65339} { return F } + if {$char == 65340} { return F } + if {$char == 65341} { return F } + if {$char == 65342} { return F } + if {$char == 65343} { return F } + if {$char == 65344} { return F } + if {$char >= 65345 && $char <= 65370 } { return F } + if {$char == 65371} { return F } + if {$char == 65372} { return F } + if {$char == 65373} { return F } + if {$char == 65374} { return F } + if {$char == 65375} { return F } + if {$char == 65376} { return F } + if {$char == 65377} { return H } + if {$char == 65378} { return H } + if {$char == 65379} { return H } + if {$char >= 65380 && $char <= 65381 } { return H } + if {$char >= 65382 && $char <= 65391 } { return H } + if {$char == 65392} { return H } + if {$char >= 65393 && $char <= 65437 } { return H } + if {$char >= 65438 && $char <= 65439 } { return H } + if {$char >= 65440 && $char <= 65470 } { return H } + if {$char >= 65474 && $char <= 65479 } { return H } + if {$char >= 65482 && $char <= 65487 } { return H } + if {$char >= 65490 && $char <= 65495 } { return H } + if {$char >= 65498 && $char <= 65500 } { return H } + if {$char >= 65504 && $char <= 65505 } { return F } + if {$char == 65506} { return F } + if {$char == 65507} { return F } + if {$char == 65508} { return F } + if {$char >= 65509 && $char <= 65510 } { return F } + if {$char == 65512} { return H } + if {$char >= 65513 && $char <= 65516 } { return H } + if {$char >= 65517 && $char <= 65518 } { return H } + if {$char == 65533} { return A } + if {$char >= 94176 && $char <= 94177 } { return W } + if {$char >= 94208 && $char <= 100337 } { return W } + if {$char >= 100352 && $char <= 101106 } { return W } + if {$char >= 110592 && $char <= 110847 } { return W } + if {$char >= 110848 && $char <= 110878 } { return W } + if {$char >= 110960 && $char <= 111355 } { return W } + if {$char == 126980} { return W } + if {$char == 127183} { return W } + if {$char >= 127232 && $char <= 127242 } { return A } + if {$char >= 127248 && $char <= 127277 } { return A } + if {$char >= 127280 && $char <= 127337 } { return A } + if {$char >= 127344 && $char <= 127373 } { return A } + if {$char == 127374} { return W } + if {$char >= 127375 && $char <= 127376 } { return A } + if {$char >= 127377 && $char <= 127386 } { return W } + if {$char >= 127387 && $char <= 127404 } { return A } + if {$char >= 127488 && $char <= 127490 } { return W } + if {$char >= 127504 && $char <= 127547 } { return W } + if {$char >= 127552 && $char <= 127560 } { return W } + if {$char >= 127568 && $char <= 127569 } { return W } + if {$char >= 127584 && $char <= 127589 } { return W } + if {$char >= 127744 && $char <= 127776 } { return W } + if {$char >= 127789 && $char <= 127797 } { return W } + if {$char >= 127799 && $char <= 127868 } { return W } + if {$char >= 127870 && $char <= 127891 } { return W } + if {$char >= 127904 && $char <= 127946 } { return W } + if {$char >= 127951 && $char <= 127955 } { return W } + if {$char >= 127968 && $char <= 127984 } { return W } + if {$char == 127988} { return W } + if {$char >= 127992 && $char <= 127994 } { return W } + if {$char >= 127995 && $char <= 127999 } { return W } + if {$char >= 128000 && $char <= 128062 } { return W } + if {$char == 128064} { return W } + if {$char >= 128066 && $char <= 128252 } { return W } + if {$char >= 128255 && $char <= 128317 } { return W } + if {$char >= 128331 && $char <= 128334 } { return W } + if {$char >= 128336 && $char <= 128359 } { return W } + if {$char == 128378} { return W } + if {$char >= 128405 && $char <= 128406 } { return W } + if {$char == 128420} { return W } + if {$char >= 128507 && $char <= 128511 } { return W } + if {$char >= 128512 && $char <= 128591 } { return W } + if {$char >= 128640 && $char <= 128709 } { return W } + if {$char == 128716} { return W } + if {$char >= 128720 && $char <= 128722 } { return W } + if {$char >= 128747 && $char <= 128748 } { return W } + if {$char >= 128756 && $char <= 128761 } { return W } + if {$char >= 129296 && $char <= 129342 } { return W } + if {$char >= 129344 && $char <= 129392 } { return W } + if {$char >= 129395 && $char <= 129398 } { return W } + if {$char == 129402} { return W } + if {$char >= 129404 && $char <= 129442 } { return W } + if {$char >= 129456 && $char <= 129465 } { return W } + if {$char >= 129472 && $char <= 129474 } { return W } + if {$char >= 129488 && $char <= 129535 } { return W } + if {$char >= 131072 && $char <= 173782 } { return W } + if {$char >= 173783 && $char <= 173823 } { return W } + if {$char >= 173824 && $char <= 177972 } { return W } + if {$char >= 177973 && $char <= 177983 } { return W } + if {$char >= 177984 && $char <= 178205 } { return W } + if {$char >= 178206 && $char <= 178207 } { return W } + if {$char >= 178208 && $char <= 183969 } { return W } + if {$char >= 183970 && $char <= 183983 } { return W } + if {$char >= 183984 && $char <= 191456 } { return W } + if {$char >= 191457 && $char <= 194559 } { return W } + if {$char >= 194560 && $char <= 195101 } { return W } + if {$char >= 195102 && $char <= 195103 } { return W } + if {$char >= 195104 && $char <= 196605 } { return W } + if {$char >= 196608 && $char <= 262141 } { return W } + if {$char >= 917760 && $char <= 917999 } { return A } + if {$char >= 983040 && $char <= 1048573 } { return A } + if {$char >= 1048576 && $char <= 1114109 } { return A } + return N +} +proc ::textutil::wcswidth_char char { + if {$char >= 4352 && $char <= 4447 } { return 2 } + if {$char >= 8986 && $char <= 8987 } { return 2 } + if {$char == 9001} { return 2 } + if {$char == 9002} { return 2 } + if {$char >= 9193 && $char <= 9196 } { return 2 } + if {$char == 9200} { return 2 } + if {$char == 9203} { return 2 } + if {$char >= 9725 && $char <= 9726 } { return 2 } + if {$char >= 9748 && $char <= 9749 } { return 2 } + if {$char >= 9800 && $char <= 9811 } { return 2 } + if {$char == 9855} { return 2 } + if {$char == 9875} { return 2 } + if {$char == 9889} { return 2 } + if {$char >= 9898 && $char <= 9899 } { return 2 } + if {$char >= 9917 && $char <= 9918 } { return 2 } + if {$char >= 9924 && $char <= 9925 } { return 2 } + if {$char == 9934} { return 2 } + if {$char == 9940} { return 2 } + if {$char == 9962} { return 2 } + if {$char >= 9970 && $char <= 9971 } { return 2 } + if {$char == 9973} { return 2 } + if {$char == 9978} { return 2 } + if {$char == 9981} { return 2 } + if {$char == 9989} { return 2 } + if {$char >= 9994 && $char <= 9995 } { return 2 } + if {$char == 10024} { return 2 } + if {$char == 10060} { return 2 } + if {$char == 10062} { return 2 } + if {$char >= 10067 && $char <= 10069 } { return 2 } + if {$char == 10071} { return 2 } + if {$char >= 10133 && $char <= 10135 } { return 2 } + if {$char == 10160} { return 2 } + if {$char == 10175} { return 2 } + if {$char >= 11035 && $char <= 11036 } { return 2 } + if {$char == 11088} { return 2 } + if {$char == 11093} { return 2 } + if {$char >= 11904 && $char <= 11929 } { return 2 } + if {$char >= 11931 && $char <= 12019 } { return 2 } + if {$char >= 12032 && $char <= 12245 } { return 2 } + if {$char >= 12272 && $char <= 12283 } { return 2 } + if {$char == 12288} { return 2 } + if {$char >= 12289 && $char <= 12291 } { return 2 } + if {$char == 12292} { return 2 } + if {$char == 12293} { return 2 } + if {$char == 12294} { return 2 } + if {$char == 12295} { return 2 } + if {$char == 12296} { return 2 } + if {$char == 12297} { return 2 } + if {$char == 12298} { return 2 } + if {$char == 12299} { return 2 } + if {$char == 12300} { return 2 } + if {$char == 12301} { return 2 } + if {$char == 12302} { return 2 } + if {$char == 12303} { return 2 } + if {$char == 12304} { return 2 } + if {$char == 12305} { return 2 } + if {$char >= 12306 && $char <= 12307 } { return 2 } + if {$char == 12308} { return 2 } + if {$char == 12309} { return 2 } + if {$char == 12310} { return 2 } + if {$char == 12311} { return 2 } + if {$char == 12312} { return 2 } + if {$char == 12313} { return 2 } + if {$char == 12314} { return 2 } + if {$char == 12315} { return 2 } + if {$char == 12316} { return 2 } + if {$char == 12317} { return 2 } + if {$char >= 12318 && $char <= 12319 } { return 2 } + if {$char == 12320} { return 2 } + if {$char >= 12321 && $char <= 12329 } { return 2 } + if {$char >= 12330 && $char <= 12333 } { return 2 } + if {$char >= 12334 && $char <= 12335 } { return 2 } + if {$char == 12336} { return 2 } + if {$char >= 12337 && $char <= 12341 } { return 2 } + if {$char >= 12342 && $char <= 12343 } { return 2 } + if {$char >= 12344 && $char <= 12346 } { return 2 } + if {$char == 12347} { return 2 } + if {$char == 12348} { return 2 } + if {$char == 12349} { return 2 } + if {$char == 12350} { return 2 } + if {$char >= 12353 && $char <= 12438 } { return 2 } + if {$char >= 12441 && $char <= 12442 } { return 2 } + if {$char >= 12443 && $char <= 12444 } { return 2 } + if {$char >= 12445 && $char <= 12446 } { return 2 } + if {$char == 12447} { return 2 } + if {$char == 12448} { return 2 } + if {$char >= 12449 && $char <= 12538 } { return 2 } + if {$char == 12539} { return 2 } + if {$char >= 12540 && $char <= 12542 } { return 2 } + if {$char == 12543} { return 2 } + if {$char >= 12549 && $char <= 12591 } { return 2 } + if {$char >= 12593 && $char <= 12686 } { return 2 } + if {$char >= 12688 && $char <= 12689 } { return 2 } + if {$char >= 12690 && $char <= 12693 } { return 2 } + if {$char >= 12694 && $char <= 12703 } { return 2 } + if {$char >= 12704 && $char <= 12730 } { return 2 } + if {$char >= 12736 && $char <= 12771 } { return 2 } + if {$char >= 12784 && $char <= 12799 } { return 2 } + if {$char >= 12800 && $char <= 12830 } { return 2 } + if {$char >= 12832 && $char <= 12841 } { return 2 } + if {$char >= 12842 && $char <= 12871 } { return 2 } + if {$char == 12880} { return 2 } + if {$char >= 12881 && $char <= 12895 } { return 2 } + if {$char >= 12896 && $char <= 12927 } { return 2 } + if {$char >= 12928 && $char <= 12937 } { return 2 } + if {$char >= 12938 && $char <= 12976 } { return 2 } + if {$char >= 12977 && $char <= 12991 } { return 2 } + if {$char >= 12992 && $char <= 13054 } { return 2 } + if {$char >= 13056 && $char <= 13311 } { return 2 } + if {$char >= 13312 && $char <= 19893 } { return 2 } + if {$char >= 19894 && $char <= 19903 } { return 2 } + if {$char >= 19968 && $char <= 40943 } { return 2 } + if {$char >= 40944 && $char <= 40959 } { return 2 } + if {$char >= 40960 && $char <= 40980 } { return 2 } + if {$char == 40981} { return 2 } + if {$char >= 40982 && $char <= 42124 } { return 2 } + if {$char >= 42128 && $char <= 42182 } { return 2 } + if {$char >= 43360 && $char <= 43388 } { return 2 } + if {$char >= 44032 && $char <= 55203 } { return 2 } + if {$char >= 63744 && $char <= 64109 } { return 2 } + if {$char >= 64110 && $char <= 64111 } { return 2 } + if {$char >= 64112 && $char <= 64217 } { return 2 } + if {$char >= 64218 && $char <= 64255 } { return 2 } + if {$char >= 65040 && $char <= 65046 } { return 2 } + if {$char == 65047} { return 2 } + if {$char == 65048} { return 2 } + if {$char == 65049} { return 2 } + if {$char == 65072} { return 2 } + if {$char >= 65073 && $char <= 65074 } { return 2 } + if {$char >= 65075 && $char <= 65076 } { return 2 } + if {$char == 65077} { return 2 } + if {$char == 65078} { return 2 } + if {$char == 65079} { return 2 } + if {$char == 65080} { return 2 } + if {$char == 65081} { return 2 } + if {$char == 65082} { return 2 } + if {$char == 65083} { return 2 } + if {$char == 65084} { return 2 } + if {$char == 65085} { return 2 } + if {$char == 65086} { return 2 } + if {$char == 65087} { return 2 } + if {$char == 65088} { return 2 } + if {$char == 65089} { return 2 } + if {$char == 65090} { return 2 } + if {$char == 65091} { return 2 } + if {$char == 65092} { return 2 } + if {$char >= 65093 && $char <= 65094 } { return 2 } + if {$char == 65095} { return 2 } + if {$char == 65096} { return 2 } + if {$char >= 65097 && $char <= 65100 } { return 2 } + if {$char >= 65101 && $char <= 65103 } { return 2 } + if {$char >= 65104 && $char <= 65106 } { return 2 } + if {$char >= 65108 && $char <= 65111 } { return 2 } + if {$char == 65112} { return 2 } + if {$char == 65113} { return 2 } + if {$char == 65114} { return 2 } + if {$char == 65115} { return 2 } + if {$char == 65116} { return 2 } + if {$char == 65117} { return 2 } + if {$char == 65118} { return 2 } + if {$char >= 65119 && $char <= 65121 } { return 2 } + if {$char == 65122} { return 2 } + if {$char == 65123} { return 2 } + if {$char >= 65124 && $char <= 65126 } { return 2 } + if {$char == 65128} { return 2 } + if {$char == 65129} { return 2 } + if {$char >= 65130 && $char <= 65131 } { return 2 } + if {$char >= 65281 && $char <= 65283 } { return 2 } + if {$char == 65284} { return 2 } + if {$char >= 65285 && $char <= 65287 } { return 2 } + if {$char == 65288} { return 2 } + if {$char == 65289} { return 2 } + if {$char == 65290} { return 2 } + if {$char == 65291} { return 2 } + if {$char == 65292} { return 2 } + if {$char == 65293} { return 2 } + if {$char >= 65294 && $char <= 65295 } { return 2 } + if {$char >= 65296 && $char <= 65305 } { return 2 } + if {$char >= 65306 && $char <= 65307 } { return 2 } + if {$char >= 65308 && $char <= 65310 } { return 2 } + if {$char >= 65311 && $char <= 65312 } { return 2 } + if {$char >= 65313 && $char <= 65338 } { return 2 } + if {$char == 65339} { return 2 } + if {$char == 65340} { return 2 } + if {$char == 65341} { return 2 } + if {$char == 65342} { return 2 } + if {$char == 65343} { return 2 } + if {$char == 65344} { return 2 } + if {$char >= 65345 && $char <= 65370 } { return 2 } + if {$char == 65371} { return 2 } + if {$char == 65372} { return 2 } + if {$char == 65373} { return 2 } + if {$char == 65374} { return 2 } + if {$char == 65375} { return 2 } + if {$char == 65376} { return 2 } + if {$char >= 65504 && $char <= 65505 } { return 2 } + if {$char == 65506} { return 2 } + if {$char == 65507} { return 2 } + if {$char == 65508} { return 2 } + if {$char >= 65509 && $char <= 65510 } { return 2 } + if {$char >= 94176 && $char <= 94177 } { return 2 } + if {$char >= 94208 && $char <= 100337 } { return 2 } + if {$char >= 100352 && $char <= 101106 } { return 2 } + if {$char >= 110592 && $char <= 110847 } { return 2 } + if {$char >= 110848 && $char <= 110878 } { return 2 } + if {$char >= 110960 && $char <= 111355 } { return 2 } + if {$char == 126980} { return 2 } + if {$char == 127183} { return 2 } + if {$char == 127374} { return 2 } + if {$char >= 127377 && $char <= 127386 } { return 2 } + if {$char >= 127488 && $char <= 127490 } { return 2 } + if {$char >= 127504 && $char <= 127547 } { return 2 } + if {$char >= 127552 && $char <= 127560 } { return 2 } + if {$char >= 127568 && $char <= 127569 } { return 2 } + if {$char >= 127584 && $char <= 127589 } { return 2 } + if {$char >= 127744 && $char <= 127776 } { return 2 } + if {$char >= 127789 && $char <= 127797 } { return 2 } + if {$char >= 127799 && $char <= 127868 } { return 2 } + if {$char >= 127870 && $char <= 127891 } { return 2 } + if {$char >= 127904 && $char <= 127946 } { return 2 } + if {$char >= 127951 && $char <= 127955 } { return 2 } + if {$char >= 127968 && $char <= 127984 } { return 2 } + if {$char == 127988} { return 2 } + if {$char >= 127992 && $char <= 127994 } { return 2 } + if {$char >= 127995 && $char <= 127999 } { return 2 } + if {$char >= 128000 && $char <= 128062 } { return 2 } + if {$char == 128064} { return 2 } + if {$char >= 128066 && $char <= 128252 } { return 2 } + if {$char >= 128255 && $char <= 128317 } { return 2 } + if {$char >= 128331 && $char <= 128334 } { return 2 } + if {$char >= 128336 && $char <= 128359 } { return 2 } + if {$char == 128378} { return 2 } + if {$char >= 128405 && $char <= 128406 } { return 2 } + if {$char == 128420} { return 2 } + if {$char >= 128507 && $char <= 128511 } { return 2 } + if {$char >= 128512 && $char <= 128591 } { return 2 } + if {$char >= 128640 && $char <= 128709 } { return 2 } + if {$char == 128716} { return 2 } + if {$char >= 128720 && $char <= 128722 } { return 2 } + if {$char >= 128747 && $char <= 128748 } { return 2 } + if {$char >= 128756 && $char <= 128761 } { return 2 } + if {$char >= 129296 && $char <= 129342 } { return 2 } + if {$char >= 129344 && $char <= 129392 } { return 2 } + if {$char >= 129395 && $char <= 129398 } { return 2 } + if {$char == 129402} { return 2 } + if {$char >= 129404 && $char <= 129442 } { return 2 } + if {$char >= 129456 && $char <= 129465 } { return 2 } + if {$char >= 129472 && $char <= 129474 } { return 2 } + if {$char >= 129488 && $char <= 129535 } { return 2 } + if {$char >= 131072 && $char <= 173782 } { return 2 } + if {$char >= 173783 && $char <= 173823 } { return 2 } + if {$char >= 173824 && $char <= 177972 } { return 2 } + if {$char >= 177973 && $char <= 177983 } { return 2 } + if {$char >= 177984 && $char <= 178205 } { return 2 } + if {$char >= 178206 && $char <= 178207 } { return 2 } + if {$char >= 178208 && $char <= 183969 } { return 2 } + if {$char >= 183970 && $char <= 183983 } { return 2 } + if {$char >= 183984 && $char <= 191456 } { return 2 } + if {$char >= 191457 && $char <= 194559 } { return 2 } + if {$char >= 194560 && $char <= 195101 } { return 2 } + if {$char >= 195102 && $char <= 195103 } { return 2 } + if {$char >= 195104 && $char <= 196605 } { return 2 } + if {$char >= 196608 && $char <= 262141 } { return 2 } + return 1 +} + +proc ::textutil::wcswidth {string} { + set width 0 + set len [string length $string] + foreach c [split $string {}] { + scan $c %c char + set n [::textutil::wcswidth_char $char] + if {$n < 0} { + return -1 + } + incr width $n + } + return $width +} + diff --git a/src/doc/_module_punk_cap-0.1.0.tm.man b/src/doc/_module_punk_cap-0.1.0.tm.man new file mode 100644 index 0000000..8d2e71b --- /dev/null +++ b/src/doc/_module_punk_cap-0.1.0.tm.man @@ -0,0 +1,140 @@ +[comment {--- punk::docgen generated from inline doctools comments ---}] +[comment {--- punk::docgen DO NOT EDIT DOCS HERE UNLESS YOU REMOVE THESE COMMENT LINES ---}] +[comment {--- punk::docgen overwrites this file ---}] +[manpage_begin punk::cap 0 0.1.0] +[copyright "2023 JMNoble - BSD licensed"] +[titledesc {capability provider and handler plugin system}] +[moddesc {punk capabilities plugin system}] +[require punk::cap] +[description] +[section Overview] +[para]punk::cap provides management of named capabilities and the provider packages and handler packages that implement a pluggable capability. +[subsection Concepts] +[para]A [term capability] may be something like providing a folder of files, or just a data dictionary, and/or an API + +[para][term {capability handler}] - a package/namespace which may provide validation and standardised ways of looking up provider data + registered (or not) using register_capabilityname + +[para][term {capability provider}] - a package which registers as providing one or more capablities. +[para]registered using register_package +the capabilitylist is a list of 2-element lists where the first element is the capabilityname and the second element is a (possibly empty) dict of data relevant to that capability +A capabilityname may appear multiple times. ie a package may register that it provides the capability with multiple datasets. +[section API] +[subsection {Namespace punk::cap::class}] +[para] class definitions +[list_begin itemized] [comment {- punk::cap::class groupings -}] + [item] + [para] [emph {handler_classes}] + [list_begin enumerated] +[enum] [emph {CLASS interface_caphandler.registry}] +[list_begin definitions] +[call class::[class interface_caphandler.registry] [method pkg_register] [arg pkg] [arg capname] [arg capdict] [arg fullcapabilitylist]] +handler may override and return 0 (indicating don't register)e.g if pkg capdict data wasn't valid +overridden handler must be able to handle multiple calls for same pkg - but it may return 1 or 0 as it wishes. +[call class::[class interface_caphandler.registry] [method pkg_unregister] [arg pkg]] +[list_end] +[enum] [emph {CLASS interface_caphandler.sysapi}] +[list_begin definitions] +[list_end] + [list_end] [comment {- end enumeration handler classes -}] + [item] + [para] [emph {provider_classes}] + [list_begin enumerated] + [enum] [emph {CLASS interface_cappprovider.registration}] + Your provider package will need to instantiate this object under a sub-namespace called [namespace capsystem] within your package namespace. + [para]If your package namespace is mypackages::providerpkg then the object command would be at mypackages::providerpkg::capsystem::capprovider.registration + [para]Example code for your provider package to evaluate within its namespace: + [example { +namespace eval capsystem { + if {[info commands capprovider.registration] eq ""} { + punk::cap::class::interface_capprovider.registration create capprovider.registration + oo::objdefine capprovider.registration { + method get_declarations {} { + set decls [list] + lappend decls [list punk.templates {relpath ../templates}] + lappend decls [list another_capability_name {somekey blah key2 etc}] + return $decls + } + } + } +} +}] +[para] The above example declares that your package can be registered as a provider for the capabilities named 'punk.templates' and 'another_capability_name' + [list_begin definitions] +[call class::[class interface_capprovider.registration] [method get_declarations]] +[para] This method must be overridden by your provider using oo::objdefine cappprovider.registration as in the example above. + There must be at least one 2-element list in the result for the provider to be registerable. +[para]The first element of the list is the capabilityname - which can be custom to your provider/handler packages - or a well-known name that other authors may use/implement. +[para]The second element is a dictionary of keys specific to the capability being implemented. It may be empty if the any potential capability handlers for the named capability don't require registration data. + [list_end] + [enum] [emph {CLASS interface_capprovider.provider}] + [para] Your provider package will need to instantiate this directly under it's own namespace with the command name of [emph {provider}] + [example { + namespace eval mypackages::providerpkg { + punk::cap::class::interface_capprovider.provider create provider mypackages::providerpkg + } + }] + [list_begin definitions] +[call class::[class interface_capprovider.provider] [method constructor] [arg providerpkg]] +[comment {- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---}] +[call class::[class interface_capprovider.provider] [method register] [opt capabilityname_glob]] + +[para]This is the mechanism by which a user of your provider package will register your package as a provider of the capability named. + +[para]A user of your provider may elect to register all your declared capabilities: +[example { + package require mypackages::providerpkg + mypackages::providerpkg::provider register * +}] +[para] Or a specific capability may be registered: +[example { + package require mypackages::providerpkg + mypackages::providerpkg::provider register another_capability_name +}] + +[comment {- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---}] +[call class::[class interface_capprovider.provider] [method capabilities]] +[para] return a list of capabilities supported by this provider package + [list_end] [comment {- end class definitions -}] + [list_end] [comment {- end enumeration provider_classes }] +[list_end] [comment {- end itemized list punk::cap::class groupings -}] +[subsection {Namespace punk::cap}] +[para] Main punk::cap API for client programs interested in using capability handler packages and associated (registered) provider packages +[list_begin definitions] + [call [fun capability_exists] [arg capname]] + Return a boolean indicating if the named capability exists (0|1) + [call [fun capability_has_handler] [arg capname]] +Return a boolean indicating if the named capability has a handler package installed (0|1) + [call [fun capability_get_handler] [arg capname]] +Return the base namespace of the active handler package for the named capability. +[para] The base namespace for a handler will always be the package name, but prefixed with :: +[list_end] [comment {- end definitions for namespace punk::cap -}] +[subsection {Namespace punk::cap::advanced}] +[para] punk::cap::advanced API. Functions here are generally not the preferred way to interact with punk::cap. +[para] In some cases they may allow interaction in less safe ways or may allow use of features that are unavailable in the base namespace. +[para] Some functions are here because they are only marginally or rarely useful, and they are here to keep the base API simple. +[list_begin definitions] + [call advanced::[fun promote_provider] [arg pkg]] +[para]Move the named provider package to the preferred end of the list (tail). +[para]The active handler may or may not utilise this for preferencing. See documentation for the specific handler package to confirm. +[para] +[para] promote/demote doesn't always make a lot of sense .. should preferably be configurable per capapbility for multicap provider pkgs +[para]The idea is to provide a crude way to preference/depreference packages independently of order the packages were loaded +e.g a caller or cap-handler can ascribe some meaning to the order of the 'providers' key returned from punk::cap::capabilities +[para]The order of providers will be the order the packages were loaded & registered +[para]the naming: "promote vs demote" operates on a latest-package-in-list has higher preference assumption (matching last pkg loaded) +[para]Each capability handler could and should implement specific preferencing methods within its own API if finer control needed. +In some cases the preference/loading order may be inapplicable/irrelevant to a particular capability anyway. +[para]As this is just a basic mechanism, which can't support independent per-cap preferencing for multi-cap packages - + it only allows putting the pkgs to the head or tail of the lists. +[para]Whether particular caps or users of caps do anything with this ordering is dependent on the cap-handler and/or calling code. + [call advanced::[fun demote_provider] [arg pkg]] +[para]Move the named provider package to the preferred end of the list (tail). +[para]The active handler may or may not utilise this for preferencing. See documentation for the specific handler package to confirm. +[list_end] +[section Internal] +[subsection {Namespace punk::cap::capsystem}] +[para] Internal functions used to communicate between punk::cap and capability handlers +[list_begin definitions] +[list_end] +[manpage_end] diff --git a/src/doc/_module_punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0.1.0.tm.man b/src/doc/_module_punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0.1.0.tm.man new file mode 100644 index 0000000..e987243 --- /dev/null +++ b/src/doc/_module_punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0.1.0.tm.man @@ -0,0 +1,23 @@ +[comment {--- punk::docgen generated from inline doctools comments ---}] +[comment {--- punk::docgen DO NOT EDIT DOCS HERE UNLESS YOU REMOVE THESE COMMENT LINES ---}] +[comment {--- punk::docgen overwrites this file ---}] +[manpage_begin punk::cap 0 0.1.0] +[copyright "2023 JMNoble - BSD licensed"] +[titledesc {Module API}] +[moddesc {punk capabilities plugin system}] +[require punk::cap] +[description] +[list_begin definitions] +[call [class interface_caphandler.registry] [method pkg_register] [arg pkg] [arg capname] [arg capdict] [arg fullcapabilitylist]] +handler may override and return 0 (indicating don't register)e.g if pkg capdict data wasn't valid +overridden handler must be able to handle multiple calls for same pkg - but it may return 1 or 0 as it wishes. +[call [class interface_caphandler.registry] [method pkg_unregister] [arg pkg]] +[call [class interface_capprovider.registration] [method pkg_unregister] [arg pkg]] +[call [class interface_capprovider.provider] [method register] [opt capabilityname_glob]] +[call [class interface_capprovider.provider] [method capabilities]] + [call [fun exists] [arg capname]] + Return a boolean indicating if the named capability exists (0|1) + [call [fun has_handler] [arg capname]] + Return a boolean indicating if the named capability has a handler package installed (0|1) +[list_end] +[manpage_end] diff --git a/src/doc/_module_punk_mix_templates_modules_template_module-0.0.1.tm.man b/src/doc/_module_punk_mix_templates_modules_template_module-0.0.1.tm.man new file mode 100644 index 0000000..25a6300 --- /dev/null +++ b/src/doc/_module_punk_mix_templates_modules_template_module-0.0.1.tm.man @@ -0,0 +1,11 @@ +[comment {--- punk::docgen generated from inline doctools comments ---}] +[comment {--- punk::docgen DO NOT EDIT DOCS HERE UNLESS YOU REMOVE THESE COMMENT LINES ---}] +[manpage_begin %pkg% 0 999999.0a1.0] +[copyright "%year%"] +[titledesc {Module API}] +[moddesc {-}] +[require %pkg%] +[description] +[list_begin definitions] +[list_end] +[manpage_end] diff --git a/src/docgen/punk_cap-0.1.0.tm.man b/src/docgen/punk_cap-0.1.0.tm.man new file mode 100644 index 0000000..8d2e71b --- /dev/null +++ b/src/docgen/punk_cap-0.1.0.tm.man @@ -0,0 +1,140 @@ +[comment {--- punk::docgen generated from inline doctools comments ---}] +[comment {--- punk::docgen DO NOT EDIT DOCS HERE UNLESS YOU REMOVE THESE COMMENT LINES ---}] +[comment {--- punk::docgen overwrites this file ---}] +[manpage_begin punk::cap 0 0.1.0] +[copyright "2023 JMNoble - BSD licensed"] +[titledesc {capability provider and handler plugin system}] +[moddesc {punk capabilities plugin system}] +[require punk::cap] +[description] +[section Overview] +[para]punk::cap provides management of named capabilities and the provider packages and handler packages that implement a pluggable capability. +[subsection Concepts] +[para]A [term capability] may be something like providing a folder of files, or just a data dictionary, and/or an API + +[para][term {capability handler}] - a package/namespace which may provide validation and standardised ways of looking up provider data + registered (or not) using register_capabilityname + +[para][term {capability provider}] - a package which registers as providing one or more capablities. +[para]registered using register_package +the capabilitylist is a list of 2-element lists where the first element is the capabilityname and the second element is a (possibly empty) dict of data relevant to that capability +A capabilityname may appear multiple times. ie a package may register that it provides the capability with multiple datasets. +[section API] +[subsection {Namespace punk::cap::class}] +[para] class definitions +[list_begin itemized] [comment {- punk::cap::class groupings -}] + [item] + [para] [emph {handler_classes}] + [list_begin enumerated] +[enum] [emph {CLASS interface_caphandler.registry}] +[list_begin definitions] +[call class::[class interface_caphandler.registry] [method pkg_register] [arg pkg] [arg capname] [arg capdict] [arg fullcapabilitylist]] +handler may override and return 0 (indicating don't register)e.g if pkg capdict data wasn't valid +overridden handler must be able to handle multiple calls for same pkg - but it may return 1 or 0 as it wishes. +[call class::[class interface_caphandler.registry] [method pkg_unregister] [arg pkg]] +[list_end] +[enum] [emph {CLASS interface_caphandler.sysapi}] +[list_begin definitions] +[list_end] + [list_end] [comment {- end enumeration handler classes -}] + [item] + [para] [emph {provider_classes}] + [list_begin enumerated] + [enum] [emph {CLASS interface_cappprovider.registration}] + Your provider package will need to instantiate this object under a sub-namespace called [namespace capsystem] within your package namespace. + [para]If your package namespace is mypackages::providerpkg then the object command would be at mypackages::providerpkg::capsystem::capprovider.registration + [para]Example code for your provider package to evaluate within its namespace: + [example { +namespace eval capsystem { + if {[info commands capprovider.registration] eq ""} { + punk::cap::class::interface_capprovider.registration create capprovider.registration + oo::objdefine capprovider.registration { + method get_declarations {} { + set decls [list] + lappend decls [list punk.templates {relpath ../templates}] + lappend decls [list another_capability_name {somekey blah key2 etc}] + return $decls + } + } + } +} +}] +[para] The above example declares that your package can be registered as a provider for the capabilities named 'punk.templates' and 'another_capability_name' + [list_begin definitions] +[call class::[class interface_capprovider.registration] [method get_declarations]] +[para] This method must be overridden by your provider using oo::objdefine cappprovider.registration as in the example above. + There must be at least one 2-element list in the result for the provider to be registerable. +[para]The first element of the list is the capabilityname - which can be custom to your provider/handler packages - or a well-known name that other authors may use/implement. +[para]The second element is a dictionary of keys specific to the capability being implemented. It may be empty if the any potential capability handlers for the named capability don't require registration data. + [list_end] + [enum] [emph {CLASS interface_capprovider.provider}] + [para] Your provider package will need to instantiate this directly under it's own namespace with the command name of [emph {provider}] + [example { + namespace eval mypackages::providerpkg { + punk::cap::class::interface_capprovider.provider create provider mypackages::providerpkg + } + }] + [list_begin definitions] +[call class::[class interface_capprovider.provider] [method constructor] [arg providerpkg]] +[comment {- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---}] +[call class::[class interface_capprovider.provider] [method register] [opt capabilityname_glob]] + +[para]This is the mechanism by which a user of your provider package will register your package as a provider of the capability named. + +[para]A user of your provider may elect to register all your declared capabilities: +[example { + package require mypackages::providerpkg + mypackages::providerpkg::provider register * +}] +[para] Or a specific capability may be registered: +[example { + package require mypackages::providerpkg + mypackages::providerpkg::provider register another_capability_name +}] + +[comment {- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---}] +[call class::[class interface_capprovider.provider] [method capabilities]] +[para] return a list of capabilities supported by this provider package + [list_end] [comment {- end class definitions -}] + [list_end] [comment {- end enumeration provider_classes }] +[list_end] [comment {- end itemized list punk::cap::class groupings -}] +[subsection {Namespace punk::cap}] +[para] Main punk::cap API for client programs interested in using capability handler packages and associated (registered) provider packages +[list_begin definitions] + [call [fun capability_exists] [arg capname]] + Return a boolean indicating if the named capability exists (0|1) + [call [fun capability_has_handler] [arg capname]] +Return a boolean indicating if the named capability has a handler package installed (0|1) + [call [fun capability_get_handler] [arg capname]] +Return the base namespace of the active handler package for the named capability. +[para] The base namespace for a handler will always be the package name, but prefixed with :: +[list_end] [comment {- end definitions for namespace punk::cap -}] +[subsection {Namespace punk::cap::advanced}] +[para] punk::cap::advanced API. Functions here are generally not the preferred way to interact with punk::cap. +[para] In some cases they may allow interaction in less safe ways or may allow use of features that are unavailable in the base namespace. +[para] Some functions are here because they are only marginally or rarely useful, and they are here to keep the base API simple. +[list_begin definitions] + [call advanced::[fun promote_provider] [arg pkg]] +[para]Move the named provider package to the preferred end of the list (tail). +[para]The active handler may or may not utilise this for preferencing. See documentation for the specific handler package to confirm. +[para] +[para] promote/demote doesn't always make a lot of sense .. should preferably be configurable per capapbility for multicap provider pkgs +[para]The idea is to provide a crude way to preference/depreference packages independently of order the packages were loaded +e.g a caller or cap-handler can ascribe some meaning to the order of the 'providers' key returned from punk::cap::capabilities +[para]The order of providers will be the order the packages were loaded & registered +[para]the naming: "promote vs demote" operates on a latest-package-in-list has higher preference assumption (matching last pkg loaded) +[para]Each capability handler could and should implement specific preferencing methods within its own API if finer control needed. +In some cases the preference/loading order may be inapplicable/irrelevant to a particular capability anyway. +[para]As this is just a basic mechanism, which can't support independent per-cap preferencing for multi-cap packages - + it only allows putting the pkgs to the head or tail of the lists. +[para]Whether particular caps or users of caps do anything with this ordering is dependent on the cap-handler and/or calling code. + [call advanced::[fun demote_provider] [arg pkg]] +[para]Move the named provider package to the preferred end of the list (tail). +[para]The active handler may or may not utilise this for preferencing. See documentation for the specific handler package to confirm. +[list_end] +[section Internal] +[subsection {Namespace punk::cap::capsystem}] +[para] Internal functions used to communicate between punk::cap and capability handlers +[list_begin definitions] +[list_end] +[manpage_end] diff --git a/src/docgen/punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0.1.0.tm.man b/src/docgen/punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0.1.0.tm.man new file mode 100644 index 0000000..e987243 --- /dev/null +++ b/src/docgen/punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0.1.0.tm.man @@ -0,0 +1,23 @@ +[comment {--- punk::docgen generated from inline doctools comments ---}] +[comment {--- punk::docgen DO NOT EDIT DOCS HERE UNLESS YOU REMOVE THESE COMMENT LINES ---}] +[comment {--- punk::docgen overwrites this file ---}] +[manpage_begin punk::cap 0 0.1.0] +[copyright "2023 JMNoble - BSD licensed"] +[titledesc {Module API}] +[moddesc {punk capabilities plugin system}] +[require punk::cap] +[description] +[list_begin definitions] +[call [class interface_caphandler.registry] [method pkg_register] [arg pkg] [arg capname] [arg capdict] [arg fullcapabilitylist]] +handler may override and return 0 (indicating don't register)e.g if pkg capdict data wasn't valid +overridden handler must be able to handle multiple calls for same pkg - but it may return 1 or 0 as it wishes. +[call [class interface_caphandler.registry] [method pkg_unregister] [arg pkg]] +[call [class interface_capprovider.registration] [method pkg_unregister] [arg pkg]] +[call [class interface_capprovider.provider] [method register] [opt capabilityname_glob]] +[call [class interface_capprovider.provider] [method capabilities]] + [call [fun exists] [arg capname]] + Return a boolean indicating if the named capability exists (0|1) + [call [fun has_handler] [arg capname]] + Return a boolean indicating if the named capability has a handler package installed (0|1) +[list_end] +[manpage_end] diff --git a/src/docgen/punk_mix_templates_modules_template_module-0.0.1.tm.man b/src/docgen/punk_mix_templates_modules_template_module-0.0.1.tm.man new file mode 100644 index 0000000..725f05a --- /dev/null +++ b/src/docgen/punk_mix_templates_modules_template_module-0.0.1.tm.man @@ -0,0 +1,40 @@ +[comment {--- punk::docgen generated from inline doctools comments ---}] +[comment {--- punk::docgen DO NOT EDIT DOCS HERE UNLESS YOU REMOVE THESE COMMENT LINES ---}] +[comment {--- punk::docgen overwrites this file ---}] +[manpage_begin %pkg% 0 999999.0a1.0] +[copyright "%year%"] +[titledesc {Module API}] +[moddesc {-}] +[require %pkg%] +[description] + ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +[section Overview] +[para] overview of %pkg% +[subsection Concepts] +[para] - +[subsection dependencies] +[para] packages used by %pkg% +[list_begin itemized] +[item] [package Tcl 8.6] +[list_end] +[section API] +[subsection {Namespace %pkg%::class}] +[para] class definitions +[list_begin enumerated] +[enum] [emph {CLASS interface_sample1}] +[list_begin definitions] +[call class::[class interface_sample1] [method test] [arg arg1]] +[para] test method +[list_end] [comment {-- end definitions interface_sample1}] +[list_end] [comment {--- end class enumeration ---}] +[subsection {Namespace %pkg%}] +[para] Core API functions for %pkg% +[list_begin definitions] +[subsection {Namespace %pkg%::lib}] +[para] Secondary functions that are part of the API +[list_begin definitions] +[list_end] [comment {--- end definitions namespace %pkg%::lib ---}] +[section Internal] +[subsection {Namespace %pkg%::system}] +[para] Internal functions that are not part of the API +[manpage_end] diff --git a/src/embedded/man/files/_module_punk_cap-0.1.0.tm.n b/src/embedded/man/files/_module_punk_cap-0.1.0.tm.n new file mode 100644 index 0000000..9743ff9 --- /dev/null +++ b/src/embedded/man/files/_module_punk_cap-0.1.0.tm.n @@ -0,0 +1,489 @@ +'\" +'\" Generated from file '_module_punk_cap-0\&.1\&.0\&.tm\&.man' by tcllib/doctools with format 'nroff' +'\" Copyright (c) 2023 JMNoble - BSD licensed +'\" +.TH "punk::cap" 0 0\&.1\&.0 doc "punk capabilities plugin system" +.\" The -*- nroff -*- definitions below are for supplemental macros used +.\" in Tcl/Tk manual entries. +.\" +.\" .AP type name in/out ?indent? +.\" Start paragraph describing an argument to a library procedure. +.\" type is type of argument (int, etc.), in/out is either "in", "out", +.\" or "in/out" to describe whether procedure reads or modifies arg, +.\" and indent is equivalent to second arg of .IP (shouldn't ever be +.\" needed; use .AS below instead) +.\" +.\" .AS ?type? ?name? +.\" Give maximum sizes of arguments for setting tab stops. Type and +.\" name are examples of largest possible arguments that will be passed +.\" to .AP later. If args are omitted, default tab stops are used. +.\" +.\" .BS +.\" Start box enclosure. From here until next .BE, everything will be +.\" enclosed in one large box. +.\" +.\" .BE +.\" End of box enclosure. +.\" +.\" .CS +.\" Begin code excerpt. +.\" +.\" .CE +.\" End code excerpt. +.\" +.\" .VS ?version? ?br? +.\" Begin vertical sidebar, for use in marking newly-changed parts +.\" of man pages. The first argument is ignored and used for recording +.\" the version when the .VS was added, so that the sidebars can be +.\" found and removed when they reach a certain age. If another argument +.\" is present, then a line break is forced before starting the sidebar. +.\" +.\" .VE +.\" End of vertical sidebar. +.\" +.\" .DS +.\" Begin an indented unfilled display. +.\" +.\" .DE +.\" End of indented unfilled display. +.\" +.\" .SO ?manpage? +.\" Start of list of standard options for a Tk widget. The manpage +.\" argument defines where to look up the standard options; if +.\" omitted, defaults to "options". The options follow on successive +.\" lines, in three columns separated by tabs. +.\" +.\" .SE +.\" End of list of standard options for a Tk widget. +.\" +.\" .OP cmdName dbName dbClass +.\" Start of description of a specific option. cmdName gives the +.\" option's name as specified in the class command, dbName gives +.\" the option's name in the option database, and dbClass gives +.\" the option's class in the option database. +.\" +.\" .UL arg1 arg2 +.\" Print arg1 underlined, then print arg2 normally. +.\" +.\" .QW arg1 ?arg2? +.\" Print arg1 in quotes, then arg2 normally (for trailing punctuation). +.\" +.\" .PQ arg1 ?arg2? +.\" Print an open parenthesis, arg1 in quotes, then arg2 normally +.\" (for trailing punctuation) and then a closing parenthesis. +.\" +.\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages. +.if t .wh -1.3i ^B +.nr ^l \n(.l +.ad b +.\" # Start an argument description +.de AP +.ie !"\\$4"" .TP \\$4 +.el \{\ +. ie !"\\$2"" .TP \\n()Cu +. el .TP 15 +.\} +.ta \\n()Au \\n()Bu +.ie !"\\$3"" \{\ +\&\\$1 \\fI\\$2\\fP (\\$3) +.\".b +.\} +.el \{\ +.br +.ie !"\\$2"" \{\ +\&\\$1 \\fI\\$2\\fP +.\} +.el \{\ +\&\\fI\\$1\\fP +.\} +.\} +.. +.\" # define tabbing values for .AP +.de AS +.nr )A 10n +.if !"\\$1"" .nr )A \\w'\\$1'u+3n +.nr )B \\n()Au+15n +.\" +.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n +.nr )C \\n()Bu+\\w'(in/out)'u+2n +.. +.AS Tcl_Interp Tcl_CreateInterp in/out +.\" # BS - start boxed text +.\" # ^y = starting y location +.\" # ^b = 1 +.de BS +.br +.mk ^y +.nr ^b 1u +.if n .nf +.if n .ti 0 +.if n \l'\\n(.lu\(ul' +.if n .fi +.. +.\" # BE - end boxed text (draw box now) +.de BE +.nf +.ti 0 +.mk ^t +.ie n \l'\\n(^lu\(ul' +.el \{\ +.\" Draw four-sided box normally, but don't draw top of +.\" box if the box started on an earlier page. +.ie !\\n(^b-1 \{\ +\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.el \}\ +\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.\} +.fi +.br +.nr ^b 0 +.. +.\" # VS - start vertical sidebar +.\" # ^Y = starting y location +.\" # ^v = 1 (for troff; for nroff this doesn't matter) +.de VS +.if !"\\$2"" .br +.mk ^Y +.ie n 'mc \s12\(br\s0 +.el .nr ^v 1u +.. +.\" # VE - end of vertical sidebar +.de VE +.ie n 'mc +.el \{\ +.ev 2 +.nf +.ti 0 +.mk ^t +\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n' +.sp -1 +.fi +.ev +.\} +.nr ^v 0 +.. +.\" # Special macro to handle page bottom: finish off current +.\" # box/sidebar if in box/sidebar mode, then invoked standard +.\" # page bottom macro. +.de ^B +.ev 2 +'ti 0 +'nf +.mk ^t +.if \\n(^b \{\ +.\" Draw three-sided box if this is the box's first page, +.\" draw two sides but no top otherwise. +.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.\} +.if \\n(^v \{\ +.nr ^x \\n(^tu+1v-\\n(^Yu +\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c +.\} +.bp +'fi +.ev +.if \\n(^b \{\ +.mk ^y +.nr ^b 2 +.\} +.if \\n(^v \{\ +.mk ^Y +.\} +.. +.\" # DS - begin display +.de DS +.RS +.nf +.sp +.. +.\" # DE - end display +.de DE +.fi +.RE +.sp +.. +.\" # SO - start of list of standard options +.de SO +'ie '\\$1'' .ds So \\fBoptions\\fR +'el .ds So \\fB\\$1\\fR +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 5.5c 11c +.ft B +.. +.\" # SE - end of list of standard options +.de SE +.fi +.ft R +.LP +See the \\*(So manual entry for details on the standard options. +.. +.\" # OP - start of full description for a single option +.de OP +.LP +.nf +.ta 4c +Command-Line Name: \\fB\\$1\\fR +Database Name: \\fB\\$2\\fR +Database Class: \\fB\\$3\\fR +.fi +.IP +.. +.\" # CS - begin code excerpt +.de CS +.RS +.nf +.ta .25i .5i .75i 1i +.. +.\" # CE - end code excerpt +.de CE +.fi +.RE +.. +.\" # UL - underline word +.de UL +\\$1\l'|0\(ul'\\$2 +.. +.\" # QW - apply quotation marks to word +.de QW +.ie '\\*(lq'"' ``\\$1''\\$2 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\$2 +.. +.\" # PQ - apply parens and quotation marks to word +.de PQ +.ie '\\*(lq'"' (``\\$1''\\$2)\\$3 +.\"" fix emacs highlighting +.el (\\*(lq\\$1\\*(rq\\$2)\\$3 +.. +.\" # QR - quoted range +.de QR +.ie '\\*(lq'"' ``\\$1''\\-``\\$2''\\$3 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\-\\*(lq\\$2\\*(rq\\$3 +.. +.\" # MT - "empty" string +.de MT +.QW "" +.. +.BS +.SH NAME +punk::cap \- capability provider and handler plugin system +.SH SYNOPSIS +package require \fBpunk::cap \fR +.sp +class::\fBinterface_caphandler\&.registry\fR \fBpkg_register\fR \fIpkg\fR \fIcapname\fR \fIcapdict\fR \fIfullcapabilitylist\fR +.sp +class::\fBinterface_caphandler\&.registry\fR \fBpkg_unregister\fR \fIpkg\fR +.sp +class::\fBinterface_capprovider\&.registration\fR \fBget_declarations\fR +.sp +class::\fBinterface_capprovider\&.provider\fR \fBconstructor\fR \fIproviderpkg\fR +.sp +class::\fBinterface_capprovider\&.provider\fR \fBregister\fR ?capabilityname_glob? +.sp +class::\fBinterface_capprovider\&.provider\fR \fBcapabilities\fR +.sp +\fBcapability_exists\fR \fIcapname\fR +.sp +\fBcapability_has_handler\fR \fIcapname\fR +.sp +\fBcapability_get_handler\fR \fIcapname\fR +.sp +advanced::\fBpromote_provider\fR \fIpkg\fR +.sp +advanced::\fBdemote_provider\fR \fIpkg\fR +.sp +.BE +.SH DESCRIPTION +.SH OVERVIEW +.PP +punk::cap provides management of named capabilities and the provider packages and handler packages that implement a pluggable capability\&. +.SS CONCEPTS +.PP +A \fIcapability\fR may be something like providing a folder of files, or just a data dictionary, and/or an API +.PP +\fIcapability handler\fR - a package/namespace which may provide validation and standardised ways of looking up provider data +registered (or not) using register_capabilityname +.PP +\fIcapability provider\fR - a package which registers as providing one or more capablities\&. +.PP +registered using register_package +the capabilitylist is a list of 2-element lists where the first element is the capabilityname and the second element is a (possibly empty) dict of data relevant to that capability +A capabilityname may appear multiple times\&. ie a package may register that it provides the capability with multiple datasets\&. +.SH API +.SS "NAMESPACE PUNK::CAP::CLASS" +.PP +class definitions +.IP \(bu +.sp +\fIhandler_classes\fR +.RS +.IP [1] +\fICLASS interface_caphandler\&.registry\fR +.RS +.TP +class::\fBinterface_caphandler\&.registry\fR \fBpkg_register\fR \fIpkg\fR \fIcapname\fR \fIcapdict\fR \fIfullcapabilitylist\fR +handler may override and return 0 (indicating don't register)e\&.g if pkg capdict data wasn't valid +overridden handler must be able to handle multiple calls for same pkg - but it may return 1 or 0 as it wishes\&. +.TP +class::\fBinterface_caphandler\&.registry\fR \fBpkg_unregister\fR \fIpkg\fR +.RE +.IP [2] +\fICLASS interface_caphandler\&.sysapi\fR +.RS +.RE +.RE +.IP \(bu +.sp +\fIprovider_classes\fR +.RS +.IP [1] +\fICLASS interface_cappprovider\&.registration\fR +Your provider package will need to instantiate this object under a sub-namespace called \fBcapsystem\fR within your package namespace\&. +.sp +If your package namespace is mypackages::providerpkg then the object command would be at mypackages::providerpkg::capsystem::capprovider\&.registration +.sp +Example code for your provider package to evaluate within its namespace: +.CS + + +namespace eval capsystem { + if {[info commands capprovider\&.registration] eq ""} { + punk::cap::class::interface_capprovider\&.registration create capprovider\&.registration + oo::objdefine capprovider\&.registration { + method get_declarations {} { + set decls [list] + lappend decls [list punk\&.templates {relpath \&.\&./templates}] + lappend decls [list another_capability_name {somekey blah key2 etc}] + return $decls + } + } + } +} + +.CE +.sp +The above example declares that your package can be registered as a provider for the capabilities named 'punk\&.templates' and 'another_capability_name' +.RS +.TP +class::\fBinterface_capprovider\&.registration\fR \fBget_declarations\fR +.sp +This method must be overridden by your provider using oo::objdefine cappprovider\&.registration as in the example above\&. +There must be at least one 2-element list in the result for the provider to be registerable\&. +.sp +The first element of the list is the capabilityname - which can be custom to your provider/handler packages - or a well-known name that other authors may use/implement\&. +.sp +The second element is a dictionary of keys specific to the capability being implemented\&. It may be empty if the any potential capability handlers for the named capability don't require registration data\&. +.RE +.IP [2] +\fICLASS interface_capprovider\&.provider\fR +.sp +Your provider package will need to instantiate this directly under it's own namespace with the command name of \fIprovider\fR +.CS + + + namespace eval mypackages::providerpkg { + punk::cap::class::interface_capprovider\&.provider create provider mypackages::providerpkg + } + +.CE +.RS +.TP +class::\fBinterface_capprovider\&.provider\fR \fBconstructor\fR \fIproviderpkg\fR +.TP +class::\fBinterface_capprovider\&.provider\fR \fBregister\fR ?capabilityname_glob? +.sp +This is the mechanism by which a user of your provider package will register your package as a provider of the capability named\&. +.sp +A user of your provider may elect to register all your declared capabilities: +.CS + + + package require mypackages::providerpkg + mypackages::providerpkg::provider register * + +.CE +.sp +Or a specific capability may be registered: +.CS + + + package require mypackages::providerpkg + mypackages::providerpkg::provider register another_capability_name + +.CE +.TP +class::\fBinterface_capprovider\&.provider\fR \fBcapabilities\fR +.sp +return a list of capabilities supported by this provider package +.RE +.RE +.PP +.SS "NAMESPACE PUNK::CAP" +.PP +Main punk::cap API for client programs interested in using capability handler packages and associated (registered) provider packages +.TP +\fBcapability_exists\fR \fIcapname\fR +Return a boolean indicating if the named capability exists (0|1) +.TP +\fBcapability_has_handler\fR \fIcapname\fR +Return a boolean indicating if the named capability has a handler package installed (0|1) +.TP +\fBcapability_get_handler\fR \fIcapname\fR +Return the base namespace of the active handler package for the named capability\&. +.sp +The base namespace for a handler will always be the package name, but prefixed with :: +.PP +.SS "NAMESPACE PUNK::CAP::ADVANCED" +.PP +punk::cap::advanced API\&. Functions here are generally not the preferred way to interact with punk::cap\&. +.PP +In some cases they may allow interaction in less safe ways or may allow use of features that are unavailable in the base namespace\&. +.PP +Some functions are here because they are only marginally or rarely useful, and they are here to keep the base API simple\&. +.TP +advanced::\fBpromote_provider\fR \fIpkg\fR +.sp +Move the named provider package to the preferred end of the list (tail)\&. +.sp +The active handler may or may not utilise this for preferencing\&. See documentation for the specific handler package to confirm\&. +.sp +.sp +promote/demote doesn't always make a lot of sense \&.\&. should preferably be configurable per capapbility for multicap provider pkgs +.sp +The idea is to provide a crude way to preference/depreference packages independently of order the packages were loaded +e\&.g a caller or cap-handler can ascribe some meaning to the order of the 'providers' key returned from punk::cap::capabilities +.sp +The order of providers will be the order the packages were loaded & registered +.sp +the naming: "promote vs demote" operates on a latest-package-in-list has higher preference assumption (matching last pkg loaded) +.sp +Each capability handler could and should implement specific preferencing methods within its own API if finer control needed\&. +In some cases the preference/loading order may be inapplicable/irrelevant to a particular capability anyway\&. +.sp +As this is just a basic mechanism, which can't support independent per-cap preferencing for multi-cap packages - +it only allows putting the pkgs to the head or tail of the lists\&. +.sp +Whether particular caps or users of caps do anything with this ordering is dependent on the cap-handler and/or calling code\&. +.TP +advanced::\fBdemote_provider\fR \fIpkg\fR +.sp +Move the named provider package to the preferred end of the list (tail)\&. +.sp +The active handler may or may not utilise this for preferencing\&. See documentation for the specific handler package to confirm\&. +.PP +.SH INTERNAL +.SS "NAMESPACE PUNK::CAP::CAPSYSTEM" +.PP +Internal functions used to communicate between punk::cap and capability handlers +.PP +.SH COPYRIGHT +.nf +Copyright (c) 2023 JMNoble - BSD licensed + +.fi diff --git a/src/embedded/man/files/_module_punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0.1.0.tm.n b/src/embedded/man/files/_module_punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0.1.0.tm.n new file mode 100644 index 0000000..399ec42 --- /dev/null +++ b/src/embedded/man/files/_module_punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0.1.0.tm.n @@ -0,0 +1,318 @@ +'\" +'\" Generated from file '_module_punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0\&.1\&.0\&.tm\&.man' by tcllib/doctools with format 'nroff' +'\" Copyright (c) 2023 JMNoble - BSD licensed +'\" +.TH "punk::cap" 0 0\&.1\&.0 doc "punk capabilities plugin system" +.\" The -*- nroff -*- definitions below are for supplemental macros used +.\" in Tcl/Tk manual entries. +.\" +.\" .AP type name in/out ?indent? +.\" Start paragraph describing an argument to a library procedure. +.\" type is type of argument (int, etc.), in/out is either "in", "out", +.\" or "in/out" to describe whether procedure reads or modifies arg, +.\" and indent is equivalent to second arg of .IP (shouldn't ever be +.\" needed; use .AS below instead) +.\" +.\" .AS ?type? ?name? +.\" Give maximum sizes of arguments for setting tab stops. Type and +.\" name are examples of largest possible arguments that will be passed +.\" to .AP later. If args are omitted, default tab stops are used. +.\" +.\" .BS +.\" Start box enclosure. From here until next .BE, everything will be +.\" enclosed in one large box. +.\" +.\" .BE +.\" End of box enclosure. +.\" +.\" .CS +.\" Begin code excerpt. +.\" +.\" .CE +.\" End code excerpt. +.\" +.\" .VS ?version? ?br? +.\" Begin vertical sidebar, for use in marking newly-changed parts +.\" of man pages. The first argument is ignored and used for recording +.\" the version when the .VS was added, so that the sidebars can be +.\" found and removed when they reach a certain age. If another argument +.\" is present, then a line break is forced before starting the sidebar. +.\" +.\" .VE +.\" End of vertical sidebar. +.\" +.\" .DS +.\" Begin an indented unfilled display. +.\" +.\" .DE +.\" End of indented unfilled display. +.\" +.\" .SO ?manpage? +.\" Start of list of standard options for a Tk widget. The manpage +.\" argument defines where to look up the standard options; if +.\" omitted, defaults to "options". The options follow on successive +.\" lines, in three columns separated by tabs. +.\" +.\" .SE +.\" End of list of standard options for a Tk widget. +.\" +.\" .OP cmdName dbName dbClass +.\" Start of description of a specific option. cmdName gives the +.\" option's name as specified in the class command, dbName gives +.\" the option's name in the option database, and dbClass gives +.\" the option's class in the option database. +.\" +.\" .UL arg1 arg2 +.\" Print arg1 underlined, then print arg2 normally. +.\" +.\" .QW arg1 ?arg2? +.\" Print arg1 in quotes, then arg2 normally (for trailing punctuation). +.\" +.\" .PQ arg1 ?arg2? +.\" Print an open parenthesis, arg1 in quotes, then arg2 normally +.\" (for trailing punctuation) and then a closing parenthesis. +.\" +.\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages. +.if t .wh -1.3i ^B +.nr ^l \n(.l +.ad b +.\" # Start an argument description +.de AP +.ie !"\\$4"" .TP \\$4 +.el \{\ +. ie !"\\$2"" .TP \\n()Cu +. el .TP 15 +.\} +.ta \\n()Au \\n()Bu +.ie !"\\$3"" \{\ +\&\\$1 \\fI\\$2\\fP (\\$3) +.\".b +.\} +.el \{\ +.br +.ie !"\\$2"" \{\ +\&\\$1 \\fI\\$2\\fP +.\} +.el \{\ +\&\\fI\\$1\\fP +.\} +.\} +.. +.\" # define tabbing values for .AP +.de AS +.nr )A 10n +.if !"\\$1"" .nr )A \\w'\\$1'u+3n +.nr )B \\n()Au+15n +.\" +.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n +.nr )C \\n()Bu+\\w'(in/out)'u+2n +.. +.AS Tcl_Interp Tcl_CreateInterp in/out +.\" # BS - start boxed text +.\" # ^y = starting y location +.\" # ^b = 1 +.de BS +.br +.mk ^y +.nr ^b 1u +.if n .nf +.if n .ti 0 +.if n \l'\\n(.lu\(ul' +.if n .fi +.. +.\" # BE - end boxed text (draw box now) +.de BE +.nf +.ti 0 +.mk ^t +.ie n \l'\\n(^lu\(ul' +.el \{\ +.\" Draw four-sided box normally, but don't draw top of +.\" box if the box started on an earlier page. +.ie !\\n(^b-1 \{\ +\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.el \}\ +\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.\} +.fi +.br +.nr ^b 0 +.. +.\" # VS - start vertical sidebar +.\" # ^Y = starting y location +.\" # ^v = 1 (for troff; for nroff this doesn't matter) +.de VS +.if !"\\$2"" .br +.mk ^Y +.ie n 'mc \s12\(br\s0 +.el .nr ^v 1u +.. +.\" # VE - end of vertical sidebar +.de VE +.ie n 'mc +.el \{\ +.ev 2 +.nf +.ti 0 +.mk ^t +\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n' +.sp -1 +.fi +.ev +.\} +.nr ^v 0 +.. +.\" # Special macro to handle page bottom: finish off current +.\" # box/sidebar if in box/sidebar mode, then invoked standard +.\" # page bottom macro. +.de ^B +.ev 2 +'ti 0 +'nf +.mk ^t +.if \\n(^b \{\ +.\" Draw three-sided box if this is the box's first page, +.\" draw two sides but no top otherwise. +.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.\} +.if \\n(^v \{\ +.nr ^x \\n(^tu+1v-\\n(^Yu +\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c +.\} +.bp +'fi +.ev +.if \\n(^b \{\ +.mk ^y +.nr ^b 2 +.\} +.if \\n(^v \{\ +.mk ^Y +.\} +.. +.\" # DS - begin display +.de DS +.RS +.nf +.sp +.. +.\" # DE - end display +.de DE +.fi +.RE +.sp +.. +.\" # SO - start of list of standard options +.de SO +'ie '\\$1'' .ds So \\fBoptions\\fR +'el .ds So \\fB\\$1\\fR +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 5.5c 11c +.ft B +.. +.\" # SE - end of list of standard options +.de SE +.fi +.ft R +.LP +See the \\*(So manual entry for details on the standard options. +.. +.\" # OP - start of full description for a single option +.de OP +.LP +.nf +.ta 4c +Command-Line Name: \\fB\\$1\\fR +Database Name: \\fB\\$2\\fR +Database Class: \\fB\\$3\\fR +.fi +.IP +.. +.\" # CS - begin code excerpt +.de CS +.RS +.nf +.ta .25i .5i .75i 1i +.. +.\" # CE - end code excerpt +.de CE +.fi +.RE +.. +.\" # UL - underline word +.de UL +\\$1\l'|0\(ul'\\$2 +.. +.\" # QW - apply quotation marks to word +.de QW +.ie '\\*(lq'"' ``\\$1''\\$2 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\$2 +.. +.\" # PQ - apply parens and quotation marks to word +.de PQ +.ie '\\*(lq'"' (``\\$1''\\$2)\\$3 +.\"" fix emacs highlighting +.el (\\*(lq\\$1\\*(rq\\$2)\\$3 +.. +.\" # QR - quoted range +.de QR +.ie '\\*(lq'"' ``\\$1''\\-``\\$2''\\$3 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\-\\*(lq\\$2\\*(rq\\$3 +.. +.\" # MT - "empty" string +.de MT +.QW "" +.. +.BS +.SH NAME +punk::cap \- Module API +.SH SYNOPSIS +package require \fBpunk::cap \fR +.sp +\fBinterface_caphandler\&.registry\fR \fBpkg_register\fR \fIpkg\fR \fIcapname\fR \fIcapdict\fR \fIfullcapabilitylist\fR +.sp +\fBinterface_caphandler\&.registry\fR \fBpkg_unregister\fR \fIpkg\fR +.sp +\fBinterface_capprovider\&.registration\fR \fBpkg_unregister\fR \fIpkg\fR +.sp +\fBinterface_capprovider\&.provider\fR \fBregister\fR ?capabilityname_glob? +.sp +\fBinterface_capprovider\&.provider\fR \fBcapabilities\fR +.sp +\fBexists\fR \fIcapname\fR +.sp +\fBhas_handler\fR \fIcapname\fR +.sp +.BE +.SH DESCRIPTION +.TP +\fBinterface_caphandler\&.registry\fR \fBpkg_register\fR \fIpkg\fR \fIcapname\fR \fIcapdict\fR \fIfullcapabilitylist\fR +handler may override and return 0 (indicating don't register)e\&.g if pkg capdict data wasn't valid +overridden handler must be able to handle multiple calls for same pkg - but it may return 1 or 0 as it wishes\&. +.TP +\fBinterface_caphandler\&.registry\fR \fBpkg_unregister\fR \fIpkg\fR +.TP +\fBinterface_capprovider\&.registration\fR \fBpkg_unregister\fR \fIpkg\fR +.TP +\fBinterface_capprovider\&.provider\fR \fBregister\fR ?capabilityname_glob? +.TP +\fBinterface_capprovider\&.provider\fR \fBcapabilities\fR +.TP +\fBexists\fR \fIcapname\fR +Return a boolean indicating if the named capability exists (0|1) +.TP +\fBhas_handler\fR \fIcapname\fR +Return a boolean indicating if the named capability has a handler package installed (0|1) +.PP +.SH COPYRIGHT +.nf +Copyright (c) 2023 JMNoble - BSD licensed + +.fi diff --git a/src/embedded/man/files/_module_punk_mix_templates_modules_template_module-0.0.1.tm.n b/src/embedded/man/files/_module_punk_mix_templates_modules_template_module-0.0.1.tm.n new file mode 100644 index 0000000..765c9ba --- /dev/null +++ b/src/embedded/man/files/_module_punk_mix_templates_modules_template_module-0.0.1.tm.n @@ -0,0 +1,286 @@ +'\" +'\" Generated from file '_module_punk_mix_templates_modules_template_module-0\&.0\&.1\&.tm\&.man' by tcllib/doctools with format 'nroff' +'\" Copyright (c) %year% +'\" +.TH "%pkg%" 0 999999\&.0a1\&.0 doc "-" +.\" The -*- nroff -*- definitions below are for supplemental macros used +.\" in Tcl/Tk manual entries. +.\" +.\" .AP type name in/out ?indent? +.\" Start paragraph describing an argument to a library procedure. +.\" type is type of argument (int, etc.), in/out is either "in", "out", +.\" or "in/out" to describe whether procedure reads or modifies arg, +.\" and indent is equivalent to second arg of .IP (shouldn't ever be +.\" needed; use .AS below instead) +.\" +.\" .AS ?type? ?name? +.\" Give maximum sizes of arguments for setting tab stops. Type and +.\" name are examples of largest possible arguments that will be passed +.\" to .AP later. If args are omitted, default tab stops are used. +.\" +.\" .BS +.\" Start box enclosure. From here until next .BE, everything will be +.\" enclosed in one large box. +.\" +.\" .BE +.\" End of box enclosure. +.\" +.\" .CS +.\" Begin code excerpt. +.\" +.\" .CE +.\" End code excerpt. +.\" +.\" .VS ?version? ?br? +.\" Begin vertical sidebar, for use in marking newly-changed parts +.\" of man pages. The first argument is ignored and used for recording +.\" the version when the .VS was added, so that the sidebars can be +.\" found and removed when they reach a certain age. If another argument +.\" is present, then a line break is forced before starting the sidebar. +.\" +.\" .VE +.\" End of vertical sidebar. +.\" +.\" .DS +.\" Begin an indented unfilled display. +.\" +.\" .DE +.\" End of indented unfilled display. +.\" +.\" .SO ?manpage? +.\" Start of list of standard options for a Tk widget. The manpage +.\" argument defines where to look up the standard options; if +.\" omitted, defaults to "options". The options follow on successive +.\" lines, in three columns separated by tabs. +.\" +.\" .SE +.\" End of list of standard options for a Tk widget. +.\" +.\" .OP cmdName dbName dbClass +.\" Start of description of a specific option. cmdName gives the +.\" option's name as specified in the class command, dbName gives +.\" the option's name in the option database, and dbClass gives +.\" the option's class in the option database. +.\" +.\" .UL arg1 arg2 +.\" Print arg1 underlined, then print arg2 normally. +.\" +.\" .QW arg1 ?arg2? +.\" Print arg1 in quotes, then arg2 normally (for trailing punctuation). +.\" +.\" .PQ arg1 ?arg2? +.\" Print an open parenthesis, arg1 in quotes, then arg2 normally +.\" (for trailing punctuation) and then a closing parenthesis. +.\" +.\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages. +.if t .wh -1.3i ^B +.nr ^l \n(.l +.ad b +.\" # Start an argument description +.de AP +.ie !"\\$4"" .TP \\$4 +.el \{\ +. ie !"\\$2"" .TP \\n()Cu +. el .TP 15 +.\} +.ta \\n()Au \\n()Bu +.ie !"\\$3"" \{\ +\&\\$1 \\fI\\$2\\fP (\\$3) +.\".b +.\} +.el \{\ +.br +.ie !"\\$2"" \{\ +\&\\$1 \\fI\\$2\\fP +.\} +.el \{\ +\&\\fI\\$1\\fP +.\} +.\} +.. +.\" # define tabbing values for .AP +.de AS +.nr )A 10n +.if !"\\$1"" .nr )A \\w'\\$1'u+3n +.nr )B \\n()Au+15n +.\" +.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n +.nr )C \\n()Bu+\\w'(in/out)'u+2n +.. +.AS Tcl_Interp Tcl_CreateInterp in/out +.\" # BS - start boxed text +.\" # ^y = starting y location +.\" # ^b = 1 +.de BS +.br +.mk ^y +.nr ^b 1u +.if n .nf +.if n .ti 0 +.if n \l'\\n(.lu\(ul' +.if n .fi +.. +.\" # BE - end boxed text (draw box now) +.de BE +.nf +.ti 0 +.mk ^t +.ie n \l'\\n(^lu\(ul' +.el \{\ +.\" Draw four-sided box normally, but don't draw top of +.\" box if the box started on an earlier page. +.ie !\\n(^b-1 \{\ +\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.el \}\ +\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.\} +.fi +.br +.nr ^b 0 +.. +.\" # VS - start vertical sidebar +.\" # ^Y = starting y location +.\" # ^v = 1 (for troff; for nroff this doesn't matter) +.de VS +.if !"\\$2"" .br +.mk ^Y +.ie n 'mc \s12\(br\s0 +.el .nr ^v 1u +.. +.\" # VE - end of vertical sidebar +.de VE +.ie n 'mc +.el \{\ +.ev 2 +.nf +.ti 0 +.mk ^t +\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n' +.sp -1 +.fi +.ev +.\} +.nr ^v 0 +.. +.\" # Special macro to handle page bottom: finish off current +.\" # box/sidebar if in box/sidebar mode, then invoked standard +.\" # page bottom macro. +.de ^B +.ev 2 +'ti 0 +'nf +.mk ^t +.if \\n(^b \{\ +.\" Draw three-sided box if this is the box's first page, +.\" draw two sides but no top otherwise. +.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.\} +.if \\n(^v \{\ +.nr ^x \\n(^tu+1v-\\n(^Yu +\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c +.\} +.bp +'fi +.ev +.if \\n(^b \{\ +.mk ^y +.nr ^b 2 +.\} +.if \\n(^v \{\ +.mk ^Y +.\} +.. +.\" # DS - begin display +.de DS +.RS +.nf +.sp +.. +.\" # DE - end display +.de DE +.fi +.RE +.sp +.. +.\" # SO - start of list of standard options +.de SO +'ie '\\$1'' .ds So \\fBoptions\\fR +'el .ds So \\fB\\$1\\fR +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 5.5c 11c +.ft B +.. +.\" # SE - end of list of standard options +.de SE +.fi +.ft R +.LP +See the \\*(So manual entry for details on the standard options. +.. +.\" # OP - start of full description for a single option +.de OP +.LP +.nf +.ta 4c +Command-Line Name: \\fB\\$1\\fR +Database Name: \\fB\\$2\\fR +Database Class: \\fB\\$3\\fR +.fi +.IP +.. +.\" # CS - begin code excerpt +.de CS +.RS +.nf +.ta .25i .5i .75i 1i +.. +.\" # CE - end code excerpt +.de CE +.fi +.RE +.. +.\" # UL - underline word +.de UL +\\$1\l'|0\(ul'\\$2 +.. +.\" # QW - apply quotation marks to word +.de QW +.ie '\\*(lq'"' ``\\$1''\\$2 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\$2 +.. +.\" # PQ - apply parens and quotation marks to word +.de PQ +.ie '\\*(lq'"' (``\\$1''\\$2)\\$3 +.\"" fix emacs highlighting +.el (\\*(lq\\$1\\*(rq\\$2)\\$3 +.. +.\" # QR - quoted range +.de QR +.ie '\\*(lq'"' ``\\$1''\\-``\\$2''\\$3 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\-\\*(lq\\$2\\*(rq\\$3 +.. +.\" # MT - "empty" string +.de MT +.QW "" +.. +.BS +.SH NAME +%pkg% \- Module API +.SH SYNOPSIS +package require \fB%pkg% \fR +.sp +.BE +.SH DESCRIPTION +.PP +.SH COPYRIGHT +.nf +Copyright (c) %year% + +.fi diff --git a/src/embedded/man/toc.n b/src/embedded/man/toc.n index 41aa486..a725ebc 100644 --- a/src/embedded/man/toc.n +++ b/src/embedded/man/toc.n @@ -273,5 +273,14 @@ Database Class: \\fB\\$3\\fR doc .RS .TP +\fB%pkg%\fR +\fIfiles/_module_punk_mix_templates_modules_template_module-0\&.0\&.1\&.tm\&.n\fR: Module API +.TP +\fBpunk::cap\fR +\fIfiles/_module_punk_cap-0\&.1\&.0\&.tm\&.n\fR: capability provider and handler plugin system +.TP +\fBpunk::cap\fR +\fIfiles/_module_punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0\&.1\&.0\&.tm\&.n\fR: Module API +.TP \fBpunkshell\fR \fIfiles/main\&.n\fR: punkshell - Core diff --git a/src/embedded/md/.doc/tocdoc b/src/embedded/md/.doc/tocdoc index b810fbd..3abcf1a 100644 --- a/src/embedded/md/.doc/tocdoc +++ b/src/embedded/md/.doc/tocdoc @@ -1,3 +1,6 @@ [toc_begin {Table Of Contents} doc] -[item doc/files/main.md punkshell {punkshell - Core}] +[item doc/files/_module_punk_mix_templates_modules_template_module-0.0.1.tm.md %pkg% {Module API}] +[item doc/files/_module_punk_cap-0.1.0.tm.md punk::cap {capability provider and handler plugin system}] +[item doc/files/_module_punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0.1.0.tm.md punk::cap {Module API}] +[item doc/files/main.md punkshell {punkshell - Core}] [toc_end] diff --git a/src/embedded/md/.toc b/src/embedded/md/.toc index 99dfdfc..07f54c8 100644 --- a/src/embedded/md/.toc +++ b/src/embedded/md/.toc @@ -1 +1 @@ -doc {doc/toc {{doc/files/main.md punkshell {punkshell - Core}}}} \ No newline at end of file +doc {doc/toc {{doc/files/_module_punk_mix_templates_modules_template_module-0.0.1.tm.md %pkg% {Module API}} {doc/files/_module_punk_cap-0.1.0.tm.md punk::cap {capability provider and handler plugin system}} {doc/files/_module_punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0.1.0.tm.md punk::cap {Module API}} {doc/files/main.md punkshell {punkshell - Core}}}} \ No newline at end of file diff --git a/src/embedded/md/.xrf b/src/embedded/md/.xrf index b402820..15bef2e 100644 --- a/src/embedded/md/.xrf +++ b/src/embedded/md/.xrf @@ -1 +1 @@ -{punkshell - Core} doc/files/main.md shell {index.md shell} kw,punk {index.md punk} sa,punkshell(n) doc/files/main.md punkshell(n) doc/files/main.md kw,repl {index.md repl} sa,punkshell doc/files/main.md punkshell doc/files/main.md kw,shell {index.md shell} punk {index.md punk} repl {index.md repl} \ No newline at end of file +{capability provider and handler plugin system} doc/files/_module_punk_cap-0.1.0.tm.md repl {index.md repl} %pkg% doc/files/_module_punk_mix_templates_modules_template_module-0.0.1.tm.md kw,punk {index.md punk} %pkg%(0) doc/files/_module_punk_mix_templates_modules_template_module-0.0.1.tm.md punkshell(n) doc/files/main.md sa,punk::cap doc/files/_module_punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0.1.0.tm.md punkshell doc/files/main.md sa,punk::cap(0) doc/files/_module_punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0.1.0.tm.md {Module API} doc/files/_module_punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0.1.0.tm.md shell {index.md shell} kw,repl {index.md repl} sa,%pkg% doc/files/_module_punk_mix_templates_modules_template_module-0.0.1.tm.md {punkshell - Core} doc/files/main.md sa,%pkg%(0) doc/files/_module_punk_mix_templates_modules_template_module-0.0.1.tm.md sa,punkshell(n) doc/files/main.md punk::cap doc/files/_module_punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0.1.0.tm.md sa,punkshell doc/files/main.md kw,shell {index.md shell} punk {index.md punk} punk::cap(0) doc/files/_module_punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0.1.0.tm.md \ No newline at end of file diff --git a/src/embedded/md/doc/files/_module_punk_cap-0.1.0.tm.md b/src/embedded/md/doc/files/_module_punk_cap-0.1.0.tm.md new file mode 100644 index 0000000..5672748 --- /dev/null +++ b/src/embedded/md/doc/files/_module_punk_cap-0.1.0.tm.md @@ -0,0 +1,262 @@ + +[//000000001]: # (punk::cap \- punk capabilities plugin system) +[//000000002]: # (Generated from file '\_module\_punk\_cap\-0\.1\.0\.tm\.man' by tcllib/doctools with format 'markdown') +[//000000003]: # (Copyright © 2023 JMNoble \- BSD licensed) +[//000000004]: # (punk::cap\(0\) 0\.1\.0 doc "punk capabilities plugin system") + +

[ Main Table Of Contents | Table Of Contents | Keyword Index ]
+ +# NAME + +punk::cap \- capability provider and handler plugin system + +# Table Of Contents + + - [Table Of Contents](#toc) + + - [Synopsis](#synopsis) + + - [Description](#section1) + + - [Overview](#section2) + + - [Concepts](#subsection1) + + - [API](#section3) + + - [Namespace punk::cap::class](#subsection2) + + - [Namespace punk::cap](#subsection3) + + - [Namespace punk::cap::advanced](#subsection4) + + - [Internal](#section4) + + - [Namespace punk::cap::capsystem](#subsection5) + + - [Copyright](#copyright) + +# SYNOPSIS + +package require punk::cap + +[class::__interface\_caphandler\.registry__ __pkg\_register__ *pkg* *capname* *capdict* *fullcapabilitylist*](#1) +[class::__interface\_caphandler\.registry__ __pkg\_unregister__ *pkg*](#2) +[class::__interface\_capprovider\.registration__ __get\_declarations__](#3) +[class::__interface\_capprovider\.provider__ __constructor__ *providerpkg*](#4) +[class::__interface\_capprovider\.provider__ __register__ ?capabilityname\_glob?](#5) +[class::__interface\_capprovider\.provider__ __capabilities__](#6) +[__capability\_exists__ *capname*](#7) +[__capability\_has\_handler__ *capname*](#8) +[__capability\_get\_handler__ *capname*](#9) +[advanced::__promote\_provider__ *pkg*](#10) +[advanced::__demote\_provider__ *pkg*](#11) + +# DESCRIPTION + +# Overview + +punk::cap provides management of named capabilities and the provider packages +and handler packages that implement a pluggable capability\. + +## Concepts + +A *capability* may be something like providing a folder of files, or just a +data dictionary, and/or an API + +*capability handler* \- a package/namespace which may provide validation and +standardised ways of looking up provider data registered \(or not\) using +register\_capabilityname + +*capability provider* \- a package which registers as providing one or more +capablities\. + +registered using register\_package the capabilitylist is a +list of 2\-element lists where the first element is the capabilityname and the +second element is a \(possibly empty\) dict of data relevant to that capability A +capabilityname may appear multiple times\. ie a package may register that it +provides the capability with multiple datasets\. + +# API + +## Namespace punk::cap::class + +class definitions + + - *handler\_classes* + + 1. *CLASS interface\_caphandler\.registry* + + * class::__interface\_caphandler\.registry__ __pkg\_register__ *pkg* *capname* *capdict* *fullcapabilitylist* + + handler may override and return 0 \(indicating don't register\)e\.g if + pkg capdict data wasn't valid overridden handler must be able to + handle multiple calls for same pkg \- but it may return 1 or 0 as it + wishes\. + + * class::__interface\_caphandler\.registry__ __pkg\_unregister__ *pkg* + + 1. *CLASS interface\_caphandler\.sysapi* + + - *provider\_classes* + + 1. *CLASS interface\_cappprovider\.registration* Your provider package + will need to instantiate this object under a sub\-namespace called + __capsystem__ within your package namespace\. + + If your package namespace is mypackages::providerpkg then the object + command would be at + mypackages::providerpkg::capsystem::capprovider\.registration + + Example code for your provider package to evaluate within its + namespace: + + namespace eval capsystem { + if {[info commands capprovider.registration] eq ""} { + punk::cap::class::interface_capprovider.registration create capprovider.registration + oo::objdefine capprovider.registration { + method get_declarations {} { + set decls [list] + lappend decls [list punk.templates {relpath ../templates}] + lappend decls [list another_capability_name {somekey blah key2 etc}] + return $decls + } + } + } + } + + The above example declares that your package can be registered as a + provider for the capabilities named 'punk\.templates' and + 'another\_capability\_name' + + * class::__interface\_capprovider\.registration__ __get\_declarations__ + + This method must be overridden by your provider using oo::objdefine + cappprovider\.registration as in the example above\. There must be at + least one 2\-element list in the result for the provider to be + registerable\. + + The first element of the list is the capabilityname \- which can be + custom to your provider/handler packages \- or a well\-known name + that other authors may use/implement\. + + The second element is a dictionary of keys specific to the + capability being implemented\. It may be empty if the any potential + capability handlers for the named capability don't require + registration data\. + + 1. *CLASS interface\_capprovider\.provider* + + Your provider package will need to instantiate this directly under it's + own namespace with the command name of *provider* + + namespace eval mypackages::providerpkg { + punk::cap::class::interface_capprovider.provider create provider mypackages::providerpkg + } + + * class::__interface\_capprovider\.provider__ __constructor__ *providerpkg* + + * class::__interface\_capprovider\.provider__ __register__ ?capabilityname\_glob? + + This is the mechanism by which a user of your provider package will + register your package as a provider of the capability named\. + + A user of your provider may elect to register all your declared + capabilities: + + package require mypackages::providerpkg + mypackages::providerpkg::provider register * + + Or a specific capability may be registered: + + package require mypackages::providerpkg + mypackages::providerpkg::provider register another_capability_name + + * class::__interface\_capprovider\.provider__ __capabilities__ + + return a list of capabilities supported by this provider package + +## Namespace punk::cap + +Main punk::cap API for client programs interested in using capability handler +packages and associated \(registered\) provider packages + + - __capability\_exists__ *capname* + + Return a boolean indicating if the named capability exists \(0|1\) + + - __capability\_has\_handler__ *capname* + + Return a boolean indicating if the named capability has a handler package + installed \(0|1\) + + - __capability\_get\_handler__ *capname* + + Return the base namespace of the active handler package for the named + capability\. + + The base namespace for a handler will always be the package name, but + prefixed with :: + +## Namespace punk::cap::advanced + +punk::cap::advanced API\. Functions here are generally not the preferred way to +interact with punk::cap\. + +In some cases they may allow interaction in less safe ways or may allow use of +features that are unavailable in the base namespace\. + +Some functions are here because they are only marginally or rarely useful, and +they are here to keep the base API simple\. + + - advanced::__promote\_provider__ *pkg* + + Move the named provider package to the preferred end of the list \(tail\)\. + + The active handler may or may not utilise this for preferencing\. See + documentation for the specific handler package to confirm\. + + promote/demote doesn't always make a lot of sense \.\. should preferably be + configurable per capapbility for multicap provider pkgs + + The idea is to provide a crude way to preference/depreference packages + independently of order the packages were loaded e\.g a caller or cap\-handler + can ascribe some meaning to the order of the 'providers' key returned from + punk::cap::capabilities + + The order of providers will be the order the packages were loaded & + registered + + the naming: "promote vs demote" operates on a latest\-package\-in\-list has + higher preference assumption \(matching last pkg loaded\) + + Each capability handler could and should implement specific preferencing + methods within its own API if finer control needed\. In some cases the + preference/loading order may be inapplicable/irrelevant to a particular + capability anyway\. + + As this is just a basic mechanism, which can't support independent per\-cap + preferencing for multi\-cap packages \- it only allows putting the pkgs to the + head or tail of the lists\. + + Whether particular caps or users of caps do anything with this ordering is + dependent on the cap\-handler and/or calling code\. + + - advanced::__demote\_provider__ *pkg* + + Move the named provider package to the preferred end of the list \(tail\)\. + + The active handler may or may not utilise this for preferencing\. See + documentation for the specific handler package to confirm\. + +# Internal + +## Namespace punk::cap::capsystem + +Internal functions used to communicate between punk::cap and capability handlers + +# COPYRIGHT + +Copyright © 2023 JMNoble \- BSD licensed diff --git a/src/embedded/md/doc/files/_module_punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0.1.0.tm.md b/src/embedded/md/doc/files/_module_punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0.1.0.tm.md new file mode 100644 index 0000000..939af0b --- /dev/null +++ b/src/embedded/md/doc/files/_module_punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0.1.0.tm.md @@ -0,0 +1,64 @@ + +[//000000001]: # (punk::cap \- punk capabilities plugin system) +[//000000002]: # (Generated from file '\_module\_punk\_mix\_templates\_layouts\_project\_src\_bootsupport\_modules\_punk\_cap\-0\.1\.0\.tm\.man' by tcllib/doctools with format 'markdown') +[//000000003]: # (Copyright © 2023 JMNoble \- BSD licensed) +[//000000004]: # (punk::cap\(0\) 0\.1\.0 doc "punk capabilities plugin system") + +
[ Main Table Of Contents | Table Of Contents | Keyword Index ]
+ +# NAME + +punk::cap \- Module API + +# Table Of Contents + + - [Table Of Contents](#toc) + + - [Synopsis](#synopsis) + + - [Description](#section1) + + - [Copyright](#copyright) + +# SYNOPSIS + +package require punk::cap + +[__interface\_caphandler\.registry__ __pkg\_register__ *pkg* *capname* *capdict* *fullcapabilitylist*](#1) +[__interface\_caphandler\.registry__ __pkg\_unregister__ *pkg*](#2) +[__interface\_capprovider\.registration__ __pkg\_unregister__ *pkg*](#3) +[__interface\_capprovider\.provider__ __register__ ?capabilityname\_glob?](#4) +[__interface\_capprovider\.provider__ __capabilities__](#5) +[__exists__ *capname*](#6) +[__has\_handler__ *capname*](#7) + +# DESCRIPTION + + - __interface\_caphandler\.registry__ __pkg\_register__ *pkg* *capname* *capdict* *fullcapabilitylist* + + handler may override and return 0 \(indicating don't register\)e\.g if pkg + capdict data wasn't valid overridden handler must be able to handle multiple + calls for same pkg \- but it may return 1 or 0 as it wishes\. + + - __interface\_caphandler\.registry__ __pkg\_unregister__ *pkg* + + - __interface\_capprovider\.registration__ __pkg\_unregister__ *pkg* + + - __interface\_capprovider\.provider__ __register__ ?capabilityname\_glob? + + - __interface\_capprovider\.provider__ __capabilities__ + + - __exists__ *capname* + + Return a boolean indicating if the named capability exists \(0|1\) + + - __has\_handler__ *capname* + + Return a boolean indicating if the named capability has a handler package + installed \(0|1\) + +# COPYRIGHT + +Copyright © 2023 JMNoble \- BSD licensed diff --git a/src/embedded/md/doc/files/_module_punk_mix_templates_modules_template_module-0.0.1.tm.md b/src/embedded/md/doc/files/_module_punk_mix_templates_modules_template_module-0.0.1.tm.md new file mode 100644 index 0000000..9aaea86 --- /dev/null +++ b/src/embedded/md/doc/files/_module_punk_mix_templates_modules_template_module-0.0.1.tm.md @@ -0,0 +1,33 @@ + +[//000000001]: # (%pkg% \- \-) +[//000000002]: # (Generated from file '\_module\_punk\_mix\_templates\_modules\_template\_module\-0\.0\.1\.tm\.man' by tcllib/doctools with format 'markdown') +[//000000003]: # (Copyright © %year%) +[//000000004]: # (%pkg%\(0\) 999999\.0a1\.0 doc "\-") + +
[ Main Table Of Contents | Table Of Contents | Keyword Index ]
+ +# NAME + +%pkg% \- Module API + +# Table Of Contents + + - [Table Of Contents](#toc) + + - [Synopsis](#synopsis) + + - [Description](#section1) + + - [Copyright](#copyright) + +# SYNOPSIS + +package require %pkg% + +# DESCRIPTION + +# COPYRIGHT + +Copyright © %year% diff --git a/src/embedded/md/doc/toc.md b/src/embedded/md/doc/toc.md index e60533d..258bf48 100644 --- a/src/embedded/md/doc/toc.md +++ b/src/embedded/md/doc/toc.md @@ -3,4 +3,10 @@ # Table Of Contents \-\- doc + - [%pkg%](doc/files/\_module\_punk\_mix\_templates\_modules\_template\_module\-0\.0\.1\.tm\.md) Module API + + - [punk::cap](doc/files/\_module\_punk\_cap\-0\.1\.0\.tm\.md) capability provider and handler plugin system + + - [punk::cap](doc/files/\_module\_punk\_mix\_templates\_layouts\_project\_src\_bootsupport\_modules\_punk\_cap\-0\.1\.0\.tm\.md) Module API + - [punkshell](doc/files/main\.md) punkshell \- Core diff --git a/src/embedded/md/toc.md b/src/embedded/md/toc.md index e60533d..258bf48 100644 --- a/src/embedded/md/toc.md +++ b/src/embedded/md/toc.md @@ -3,4 +3,10 @@ # Table Of Contents \-\- doc + - [%pkg%](doc/files/\_module\_punk\_mix\_templates\_modules\_template\_module\-0\.0\.1\.tm\.md) Module API + + - [punk::cap](doc/files/\_module\_punk\_cap\-0\.1\.0\.tm\.md) capability provider and handler plugin system + + - [punk::cap](doc/files/\_module\_punk\_mix\_templates\_layouts\_project\_src\_bootsupport\_modules\_punk\_cap\-0\.1\.0\.tm\.md) Module API + - [punkshell](doc/files/main\.md) punkshell \- Core diff --git a/src/embedded/www/.doc/tocdoc b/src/embedded/www/.doc/tocdoc index 8e5bce6..24ebeed 100644 --- a/src/embedded/www/.doc/tocdoc +++ b/src/embedded/www/.doc/tocdoc @@ -1,3 +1,6 @@ [toc_begin {Table Of Contents} doc] -[item doc/files/main.html punkshell {punkshell - Core}] +[item doc/files/_module_punk_mix_templates_modules_template_module-0.0.1.tm.html %pkg% {Module API}] +[item doc/files/_module_punk_cap-0.1.0.tm.html punk::cap {capability provider and handler plugin system}] +[item doc/files/_module_punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0.1.0.tm.html punk::cap {Module API}] +[item doc/files/main.html punkshell {punkshell - Core}] [toc_end] diff --git a/src/embedded/www/.toc b/src/embedded/www/.toc index 46581f3..62bb20a 100644 --- a/src/embedded/www/.toc +++ b/src/embedded/www/.toc @@ -1 +1 @@ -doc {doc/toc {{doc/files/main.html punkshell {punkshell - Core}}}} \ No newline at end of file +doc {doc/toc {{doc/files/_module_punk_mix_templates_modules_template_module-0.0.1.tm.html %pkg% {Module API}} {doc/files/_module_punk_cap-0.1.0.tm.html punk::cap {capability provider and handler plugin system}} {doc/files/_module_punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0.1.0.tm.html punk::cap {Module API}} {doc/files/main.html punkshell {punkshell - Core}}}} \ No newline at end of file diff --git a/src/embedded/www/.xrf b/src/embedded/www/.xrf index 698b900..649efed 100644 --- a/src/embedded/www/.xrf +++ b/src/embedded/www/.xrf @@ -1 +1 @@ -{punkshell - Core} doc/files/main.html shell {index.html shell} kw,punk {index.html punk} sa,punkshell(n) doc/files/main.html punkshell(n) doc/files/main.html kw,repl {index.html repl} sa,punkshell doc/files/main.html punkshell doc/files/main.html kw,shell {index.html shell} punk {index.html punk} repl {index.html repl} \ No newline at end of file +{capability provider and handler plugin system} doc/files/_module_punk_cap-0.1.0.tm.html repl {index.html repl} %pkg% doc/files/_module_punk_mix_templates_modules_template_module-0.0.1.tm.html kw,punk {index.html punk} %pkg%(0) doc/files/_module_punk_mix_templates_modules_template_module-0.0.1.tm.html punkshell(n) doc/files/main.html sa,punk::cap doc/files/_module_punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0.1.0.tm.html punkshell doc/files/main.html sa,punk::cap(0) doc/files/_module_punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0.1.0.tm.html {Module API} doc/files/_module_punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0.1.0.tm.html shell {index.html shell} kw,repl {index.html repl} sa,%pkg% doc/files/_module_punk_mix_templates_modules_template_module-0.0.1.tm.html {punkshell - Core} doc/files/main.html sa,%pkg%(0) doc/files/_module_punk_mix_templates_modules_template_module-0.0.1.tm.html sa,punkshell(n) doc/files/main.html punk::cap doc/files/_module_punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0.1.0.tm.html sa,punkshell doc/files/main.html kw,shell {index.html shell} punk {index.html punk} punk::cap(0) doc/files/_module_punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0.1.0.tm.html \ No newline at end of file diff --git a/src/embedded/www/doc/files/_module_punk_cap-0.1.0.tm.html b/src/embedded/www/doc/files/_module_punk_cap-0.1.0.tm.html new file mode 100644 index 0000000..e8987d5 --- /dev/null +++ b/src/embedded/www/doc/files/_module_punk_cap-0.1.0.tm.html @@ -0,0 +1,301 @@ + +punk::cap - punk capabilities plugin system + + + + + +
[ + Main Table Of Contents +| Table Of Contents +| Keyword Index + ]
+
+

punk::cap(0) 0.1.0 doc "punk capabilities plugin system"

+

Name

+

punk::cap - capability provider and handler plugin system

+
+ + + +

Overview

+

punk::cap provides management of named capabilities and the provider packages and handler packages that implement a pluggable capability.

+

Concepts

+

A capability may be something like providing a folder of files, or just a data dictionary, and/or an API

+

capability handler - a package/namespace which may provide validation and standardised ways of looking up provider data + registered (or not) using register_capabilityname <capname> <capnamespace>

+

capability provider - a package which registers as providing one or more capablities.

+

registered using register_package <pkg> <capabilitylist> +the capabilitylist is a list of 2-element lists where the first element is the capabilityname and the second element is a (possibly empty) dict of data relevant to that capability +A capabilityname may appear multiple times. ie a package may register that it provides the capability with multiple datasets.

+
+
+

API

+

Namespace punk::cap::class

+

class definitions

+
    + +

  • handler_classes

    +
      +

    1. CLASS interface_caphandler.registry

      +
      +
      class::interface_caphandler.registry pkg_register pkg capname capdict fullcapabilitylist
      +

      handler may override and return 0 (indicating don't register)e.g if pkg capdict data wasn't valid +overridden handler must be able to handle multiple calls for same pkg - but it may return 1 or 0 as it wishes.

      +
      class::interface_caphandler.registry pkg_unregister pkg
      +
      +
      +
      2. +

    2. CLASS interface_caphandler.sysapi

      +
      +
      +
      3. +
    +
    • +

  • provider_classes

    +
      + +

    1. CLASS interface_cappprovider.registration + Your provider package will need to instantiate this object under a sub-namespace called capsystem within your package namespace.

      +

      If your package namespace is mypackages::providerpkg then the object command would be at mypackages::providerpkg::capsystem::capprovider.registration

      +

      Example code for your provider package to evaluate within its namespace:

      +
      +namespace eval capsystem {
+    if {[info commands capprovider.registration] eq ""} {
+        punk::cap::class::interface_capprovider.registration create capprovider.registration
+        oo::objdefine capprovider.registration {
+            method get_declarations {} {
+                set decls [list]
+                lappend decls [list punk.templates {relpath ../templates}]
+                lappend decls [list another_capability_name {somekey blah key2 etc}]
+                return $decls
+            }
+        }
+    }
+}
+
      +

      The above example declares that your package can be registered as a provider for the capabilities named 'punk.templates' and 'another_capability_name'

      +
      +
      class::interface_capprovider.registration get_declarations
      +

      This method must be overridden by your provider using oo::objdefine cappprovider.registration as in the example above. + There must be at least one 2-element list in the result for the provider to be registerable.

      +

      The first element of the list is the capabilityname - which can be custom to your provider/handler packages - or a well-known name that other authors may use/implement.

      +

      The second element is a dictionary of keys specific to the capability being implemented. It may be empty if the any potential capability handlers for the named capability don't require registration data.

      +
      +
      2. +

    2. CLASS interface_capprovider.provider

      +

      Your provider package will need to instantiate this directly under it's own namespace with the command name of provider

      +
      +       namespace eval mypackages::providerpkg {
+           punk::cap::class::interface_capprovider.provider create provider mypackages::providerpkg
+       }
+
      +
      +
      class::interface_capprovider.provider constructor providerpkg
      +
      +
      class::interface_capprovider.provider register ?capabilityname_glob?
      +

      This is the mechanism by which a user of your provider package will register your package as a provider of the capability named.

      +

      A user of your provider may elect to register all your declared capabilities:

      +
      +  package require mypackages::providerpkg
+  mypackages::providerpkg::provider register *
+
      +

      Or a specific capability may be registered:

      +
      +  package require mypackages::providerpkg
+  mypackages::providerpkg::provider register another_capability_name
+
      +
      +
      class::interface_capprovider.provider capabilities
      +

      return a list of capabilities supported by this provider package

      +
      +
      3. +
    +
    • +
+
+

Namespace punk::cap

+

Main punk::cap API for client programs interested in using capability handler packages and associated (registered) provider packages

+
+ +
capability_exists capname
+

Return a boolean indicating if the named capability exists (0|1)

+
capability_has_handler capname
+

Return a boolean indicating if the named capability has a handler package installed (0|1)

+
capability_get_handler capname
+

Return the base namespace of the active handler package for the named capability.

+

The base namespace for a handler will always be the package name, but prefixed with ::

+
+
+

Namespace punk::cap::advanced

+

punk::cap::advanced API. Functions here are generally not the preferred way to interact with punk::cap.

+

In some cases they may allow interaction in less safe ways or may allow use of features that are unavailable in the base namespace.

+

Some functions are here because they are only marginally or rarely useful, and they are here to keep the base API simple.

+
+ +
advanced::promote_provider pkg
+

Move the named provider package to the preferred end of the list (tail).

+

The active handler may or may not utilise this for preferencing. See documentation for the specific handler package to confirm.

+

promote/demote doesn't always make a lot of sense .. should preferably be configurable per capapbility for multicap provider pkgs

+

The idea is to provide a crude way to preference/depreference packages independently of order the packages were loaded +e.g a caller or cap-handler can ascribe some meaning to the order of the 'providers' key returned from punk::cap::capabilities <capname>

+

The order of providers will be the order the packages were loaded & registered

+

the naming: "promote vs demote" operates on a latest-package-in-list has higher preference assumption (matching last pkg loaded)

+

Each capability handler could and should implement specific preferencing methods within its own API if finer control needed. +In some cases the preference/loading order may be inapplicable/irrelevant to a particular capability anyway.

+

As this is just a basic mechanism, which can't support independent per-cap preferencing for multi-cap packages - + it only allows putting the pkgs to the head or tail of the lists.

+

Whether particular caps or users of caps do anything with this ordering is dependent on the cap-handler and/or calling code.

+
advanced::demote_provider pkg
+

Move the named provider package to the preferred end of the list (tail).

+

The active handler may or may not utilise this for preferencing. See documentation for the specific handler package to confirm.

+
+
+
+

Internal

+

Namespace punk::cap::capsystem

+

Internal functions used to communicate between punk::cap and capability handlers

+
+
+
+
+ +
diff --git a/src/embedded/www/doc/files/_module_punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0.1.0.tm.html b/src/embedded/www/doc/files/_module_punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0.1.0.tm.html new file mode 100644 index 0000000..dcbd11c --- /dev/null +++ b/src/embedded/www/doc/files/_module_punk_mix_templates_layouts_project_src_bootsupport_modules_punk_cap-0.1.0.tm.html @@ -0,0 +1,156 @@ + +punk::cap - punk capabilities plugin system + + + + + +
[ + Main Table Of Contents +| Table Of Contents +| Keyword Index + ]
+
+

punk::cap(0) 0.1.0 doc "punk capabilities plugin system"

+

Name

+

punk::cap - Module API

+
+ + +

Description

+
+
interface_caphandler.registry pkg_register pkg capname capdict fullcapabilitylist
+

handler may override and return 0 (indicating don't register)e.g if pkg capdict data wasn't valid +overridden handler must be able to handle multiple calls for same pkg - but it may return 1 or 0 as it wishes.

+
interface_caphandler.registry pkg_unregister pkg
+
+
interface_capprovider.registration pkg_unregister pkg
+
+
interface_capprovider.provider register ?capabilityname_glob?
+
+
interface_capprovider.provider capabilities
+
+
exists capname
+

Return a boolean indicating if the named capability exists (0|1)

+
has_handler capname
+

Return a boolean indicating if the named capability has a handler package installed (0|1)

+
+
+ +
diff --git a/src/embedded/www/doc/files/_module_punk_mix_templates_modules_template_module-0.0.1.tm.html b/src/embedded/www/doc/files/_module_punk_mix_templates_modules_template_module-0.0.1.tm.html new file mode 100644 index 0000000..10db597 --- /dev/null +++ b/src/embedded/www/doc/files/_module_punk_mix_templates_modules_template_module-0.0.1.tm.html @@ -0,0 +1,132 @@ + +%pkg% - - + + + + + +
[ + Main Table Of Contents +| Table Of Contents +| Keyword Index + ]
+
+

%pkg%(0) 999999.0a1.0 doc "-"

+

Name

+

%pkg% - Module API

+
+ +

Synopsis

+
+
    +
  • package require %pkg%
    • +
+
+
+ + +
diff --git a/src/embedded/www/doc/toc.html b/src/embedded/www/doc/toc.html index 010ab28..6d8e21f 100644 --- a/src/embedded/www/doc/toc.html +++ b/src/embedded/www/doc/toc.html @@ -13,6 +13,18 @@

doc

+ + + + + + + + + + + + diff --git a/src/embedded/www/toc.html b/src/embedded/www/toc.html index 2af2910..3ca724f 100644 --- a/src/embedded/www/toc.html +++ b/src/embedded/www/toc.html @@ -13,6 +13,18 @@

doc

%pkg%Module API
punk::capcapability provider and handler plugin system
punk::capModule API
punkshell punkshell - Core
+ + + + + + + + + + + + diff --git a/src/make.tcl b/src/make.tcl index 547b880..c01c977 100644 --- a/src/make.tcl +++ b/src/make.tcl @@ -378,7 +378,7 @@ if {$::punkmake::command eq "bootsupport"} { set project_layouts [glob -nocomplain -dir $project_layout_base -type d -tail *] foreach layoutname $project_layouts { if {[file exists [file join $project_layout_base $layoutname/src/bootsupport]]} { - set unpublish [list\ + set antipaths [list\ README.md\ ] set sourcemodules $projectroot/src/bootsupport/modules @@ -386,7 +386,7 @@ if {$::punkmake::command eq "bootsupport"} { file mkdir $targetroot puts stdout "BOOTSUPPORT layouts/$layoutname: copying from $sourcemodules to $targetroot (if source file changed)" - set resultdict [punkcheck::install $sourcemodules $targetroot -overwrite installedsourcechanged-targets -unpublish_paths $unpublish] + set resultdict [punkcheck::install $sourcemodules $targetroot -overwrite installedsourcechanged-targets -antiglob_paths $antipaths] puts stdout [punkcheck::summarize_install_resultdict $resultdict] flush stdout } @@ -420,17 +420,17 @@ file mkdir $target_modules_base #external libs and modules first - and any supporting files - no 'building' required if {[file exists $sourcefolder/vendorlib]} { - #unpublish README.md from source folder - but only the root one - #-unpublish_paths takes relative patterns e.g + #exclude README.md from source folder - but only the root one + #-antiglob_paths takes relative patterns e.g # */test.txt will only match test.txt exactly one level deep. # */*/*.foo will match any path ending in .foo that is exactly 2 levels deep. # **/test.txt will match at any level below the root (but not in the root) - set unpublish [list\ + set antipaths [list\ README.md\ ] puts stdout "VENDORLIB: copying from $sourcefolder/vendorlib to $projectroot/lib (if source file changed)" - set resultdict [punkcheck::install $sourcefolder/vendorlib $projectroot/lib -overwrite installedsourcechanged-targets -unpublish_paths $unpublish] + set resultdict [punkcheck::install $sourcefolder/vendorlib $projectroot/lib -overwrite installedsourcechanged-targets -antiglob_paths $antipaths] puts stdout [punkcheck::summarize_install_resultdict $resultdict] } else { @@ -440,7 +440,7 @@ if {[file exists $sourcefolder/vendorlib]} { if {[file exists $sourcefolder/vendormodules]} { #install .tm *and other files* puts stdout "VENDORMODULES: copying from $sourcefolder/vendormodules to $target_modules_base (if source file changed)" - set resultdict [punkcheck::install $sourcefolder/vendormodules $target_modules_base -installer make.tcl -overwrite installedsourcechanged-targets -unpublish_paths {README.md}] + set resultdict [punkcheck::install $sourcefolder/vendormodules $target_modules_base -installer make.tcl -overwrite installedsourcechanged-targets -antiglob_paths {README.md}] puts stdout [punkcheck::summarize_install_resultdict $resultdict] } else { puts stderr "VENDORMODULES: No src/vendormodules folder found." @@ -526,7 +526,7 @@ foreach src_module_dir $source_module_folderlist { set overwrite "installedsourcechanged-targets" #set overwrite "ALL-TARGETS" puts stdout "MODULEFOLDER non_tm_files $src_module_dir - copying to $target_modules_base (if source file changed)" - set resultdict [punkcheck::install_non_tm_files $src_module_dir $target_modules_base -installer make.tcl -overwrite $overwrite -unpublish_paths {README.md}] + set resultdict [punkcheck::install_non_tm_files $src_module_dir $target_modules_base -installer make.tcl -overwrite $overwrite -antiglob_paths {README.md}] puts stdout [punkcheck::summarize_install_resultdict $resultdict] } diff --git a/src/mixtemplates/layouts/basic/src/bootsupport/modules/mime-1.7.0.tm b/src/mixtemplates/layouts/basic/src/bootsupport/modules/mime-1.7.0.tm new file mode 100644 index 0000000..fa46076 --- /dev/null +++ b/src/mixtemplates/layouts/basic/src/bootsupport/modules/mime-1.7.0.tm @@ -0,0 +1,3942 @@ +# mime.tcl - MIME body parts +# +# (c) 1999-2000 Marshall T. Rose +# (c) 2000 Brent Welch +# (c) 2000 Sandeep Tamhankar +# (c) 2000 Dan Kuchler +# (c) 2000-2001 Eric Melski +# (c) 2001 Jeff Hobbs +# (c) 2001-2008 Andreas Kupries +# (c) 2002-2003 David Welton +# (c) 2003-2008 Pat Thoyts +# (c) 2005 Benjamin Riefenstahl +# (c) 2013-2021 Poor Yorick +# +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# Influenced by Borenstein's/Rose's safe-tcl (circa 1993) and Darren New's +# unpublished package of 1999. +# + +# new string features and inline scan are used, requiring 8.3. +package require Tcl 8.5 + +package provide mime 1.7.0 +package require tcl::chan::memchan + + +if {[catch {package require Trf 2.0}]} { + + # Fall-back to tcl-based procedures of base64 and quoted-printable + # encoders + ## + # Warning! + ## + # These are a fragile emulations of the more general calling + # sequence that appears to work with this code here. + ## + # The `__ignored__` arguments are expected to be `--` options on + # the caller's side. (See the uses in `copymessageaux`, + # `buildmessageaux`, `parsepart`, and `getbody`). + + package require base64 2.0 + set ::major [lindex [split [package require md5] .] 0] + + # Create these commands in the mime namespace so that they + # won't collide with things at the global namespace level + + namespace eval ::mime { + proc base64 {-mode what __ignored__ chunk} { + return [base64::$what $chunk] + } + proc quoted-printable {-mode what __ignored__ chunk} { + return [mime::qp_$what $chunk] + } + + if {$::major < 2} { + # md5 v1, result is hex string ready for use. + proc md5 {__ignored__ string} { + return [md5::md5 $string] + } + } else { + # md5 v2, need option to get hex string + proc md5 {__ignored__ string} { + return [md5::md5 -hex $string] + } + } + } + + unset ::major +} + +# +# state variables: +# +# canonicalP: input is in its canonical form +# content: type/subtype +# params: dictionary (keys are lower-case) +# encoding: transfer encoding +# version: MIME-version +# header: dictionary (keys are lower-case) +# lowerL: list of header keys, lower-case +# mixedL: list of header keys, mixed-case +# value: either "file", "parts", or "string" +# +# file: input file +# fd: cached file-descriptor, typically for root +# root: token for top-level part, for (distant) subordinates +# offset: number of octets from beginning of file/string +# count: length in octets of (encoded) content +# +# parts: list of bodies (tokens) +# +# string: input string +# +# cid: last child-id assigned +# + + +namespace eval ::mime { + variable mime + array set mime {uid 0 cid 0} + + # RFC 822 lexemes + variable addrtokenL + lappend addrtokenL \; , < > : . ( ) @ \" \[ ] \\ + variable addrlexemeL { + LX_SEMICOLON LX_COMMA + LX_LBRACKET LX_RBRACKET + LX_COLON LX_DOT + LX_LPAREN LX_RPAREN + LX_ATSIGN LX_QUOTE + LX_LSQUARE LX_RSQUARE + LX_QUOTE + } + + # RFC 2045 lexemes + variable typetokenL + lappend typetokenL \; , < > : ? ( ) @ \" \[ \] = / \\ + variable typelexemeL { + LX_SEMICOLON LX_COMMA + LX_LBRACKET LX_RBRACKET + LX_COLON LX_QUESTION + LX_LPAREN LX_RPAREN + LX_ATSIGN LX_QUOTE + LX_LSQUARE LX_RSQUARE + LX_EQUALS LX_SOLIDUS + LX_QUOTE + } + + variable encList { + ascii US-ASCII + big5 Big5 + cp1250 Windows-1250 + cp1251 Windows-1251 + cp1252 Windows-1252 + cp1253 Windows-1253 + cp1254 Windows-1254 + cp1255 Windows-1255 + cp1256 Windows-1256 + cp1257 Windows-1257 + cp1258 Windows-1258 + cp437 IBM437 + cp737 {} + cp775 IBM775 + cp850 IBM850 + cp852 IBM852 + cp855 IBM855 + cp857 IBM857 + cp860 IBM860 + cp861 IBM861 + cp862 IBM862 + cp863 IBM863 + cp864 IBM864 + cp865 IBM865 + cp866 IBM866 + cp869 IBM869 + cp874 {} + cp932 {} + cp936 GBK + cp949 {} + cp950 {} + dingbats {} + ebcdic {} + euc-cn EUC-CN + euc-jp EUC-JP + euc-kr EUC-KR + gb12345 GB12345 + gb1988 GB1988 + gb2312 GB2312 + iso2022 ISO-2022 + iso2022-jp ISO-2022-JP + iso2022-kr ISO-2022-KR + iso8859-1 ISO-8859-1 + iso8859-2 ISO-8859-2 + iso8859-3 ISO-8859-3 + iso8859-4 ISO-8859-4 + iso8859-5 ISO-8859-5 + iso8859-6 ISO-8859-6 + iso8859-7 ISO-8859-7 + iso8859-8 ISO-8859-8 + iso8859-9 ISO-8859-9 + iso8859-10 ISO-8859-10 + iso8859-13 ISO-8859-13 + iso8859-14 ISO-8859-14 + iso8859-15 ISO-8859-15 + iso8859-16 ISO-8859-16 + jis0201 JIS_X0201 + jis0208 JIS_C6226-1983 + jis0212 JIS_X0212-1990 + koi8-r KOI8-R + koi8-u KOI8-U + ksc5601 KS_C_5601-1987 + macCentEuro {} + macCroatian {} + macCyrillic {} + macDingbats {} + macGreek {} + macIceland {} + macJapan {} + macRoman {} + macRomania {} + macThai {} + macTurkish {} + macUkraine {} + shiftjis Shift_JIS + symbol {} + tis-620 TIS-620 + unicode {} + utf-8 UTF-8 + } + + variable encodings + array set encodings $encList + variable reversemap + # Initialized at the bottom of the file + + variable encAliasList { + ascii ANSI_X3.4-1968 + ascii iso-ir-6 + ascii ANSI_X3.4-1986 + ascii ISO_646.irv:1991 + ascii ASCII + ascii ISO646-US + ascii us + ascii IBM367 + ascii cp367 + cp437 cp437 + cp437 437 + cp775 cp775 + cp850 cp850 + cp850 850 + cp852 cp852 + cp852 852 + cp855 cp855 + cp855 855 + cp857 cp857 + cp857 857 + cp860 cp860 + cp860 860 + cp861 cp861 + cp861 861 + cp861 cp-is + cp862 cp862 + cp862 862 + cp863 cp863 + cp863 863 + cp864 cp864 + cp865 cp865 + cp865 865 + cp866 cp866 + cp866 866 + cp869 cp869 + cp869 869 + cp869 cp-gr + cp936 CP936 + cp936 MS936 + cp936 Windows-936 + iso8859-1 ISO_8859-1:1987 + iso8859-1 iso-ir-100 + iso8859-1 ISO_8859-1 + iso8859-1 latin1 + iso8859-1 l1 + iso8859-1 IBM819 + iso8859-1 CP819 + iso8859-2 ISO_8859-2:1987 + iso8859-2 iso-ir-101 + iso8859-2 ISO_8859-2 + iso8859-2 latin2 + iso8859-2 l2 + iso8859-3 ISO_8859-3:1988 + iso8859-3 iso-ir-109 + iso8859-3 ISO_8859-3 + iso8859-3 latin3 + iso8859-3 l3 + iso8859-4 ISO_8859-4:1988 + iso8859-4 iso-ir-110 + iso8859-4 ISO_8859-4 + iso8859-4 latin4 + iso8859-4 l4 + iso8859-5 ISO_8859-5:1988 + iso8859-5 iso-ir-144 + iso8859-5 ISO_8859-5 + iso8859-5 cyrillic + iso8859-6 ISO_8859-6:1987 + iso8859-6 iso-ir-127 + iso8859-6 ISO_8859-6 + iso8859-6 ECMA-114 + iso8859-6 ASMO-708 + iso8859-6 arabic + iso8859-7 ISO_8859-7:1987 + iso8859-7 iso-ir-126 + iso8859-7 ISO_8859-7 + iso8859-7 ELOT_928 + iso8859-7 ECMA-118 + iso8859-7 greek + iso8859-7 greek8 + iso8859-8 ISO_8859-8:1988 + iso8859-8 iso-ir-138 + iso8859-8 ISO_8859-8 + iso8859-8 hebrew + iso8859-9 ISO_8859-9:1989 + iso8859-9 iso-ir-148 + iso8859-9 ISO_8859-9 + iso8859-9 latin5 + iso8859-9 l5 + iso8859-10 iso-ir-157 + iso8859-10 l6 + iso8859-10 ISO_8859-10:1992 + iso8859-10 latin6 + iso8859-14 iso-ir-199 + iso8859-14 ISO_8859-14:1998 + iso8859-14 ISO_8859-14 + iso8859-14 latin8 + iso8859-14 iso-celtic + iso8859-14 l8 + iso8859-15 ISO_8859-15 + iso8859-15 Latin-9 + iso8859-16 iso-ir-226 + iso8859-16 ISO_8859-16:2001 + iso8859-16 ISO_8859-16 + iso8859-16 latin10 + iso8859-16 l10 + jis0201 X0201 + jis0208 iso-ir-87 + jis0208 x0208 + jis0208 JIS_X0208-1983 + jis0212 x0212 + jis0212 iso-ir-159 + ksc5601 iso-ir-149 + ksc5601 KS_C_5601-1989 + ksc5601 KSC5601 + ksc5601 korean + shiftjis MS_Kanji + utf-8 UTF8 + } + + namespace export {*}{ + copymessage finalize getbody getheader getproperty initialize + mapencoding parseaddress parsedatetime reversemapencoding setheader + uniqueID + } +} + +# ::mime::initialize -- +# +# Creates a MIME part, and returnes the MIME token for that part. +# +# Arguments: +# args Args can be any one of the following: +# ?-canonical type/subtype +# ?-param {key value}?... +# ?-encoding value? +# ?-header {key value}?... ? +# (-file name | -string value | -parts {token1 ... tokenN}) +# +# If the -canonical option is present, then the body is in +# canonical (raw) form and is found by consulting either the -file, +# -string, or -parts option. +# +# In addition, both the -param and -header options may occur zero +# or more times to specify "Content-Type" parameters (e.g., +# "charset") and header keyword/values (e.g., +# "Content-Disposition"), respectively. +# +# Also, -encoding, if present, specifies the +# "Content-Transfer-Encoding" when copying the body. +# +# If the -canonical option is not present, then the MIME part +# contained in either the -file or the -string option is parsed, +# dynamically generating subordinates as appropriate. +# +# Results: +# An initialized mime token. + +proc ::mime::initialize args { + global errorCode errorInfo + + variable mime + + set token [namespace current]::[incr mime(uid)] + # FRINK: nocheck + variable $token + upvar 0 $token state + + if {[catch [list mime::initializeaux $token {*}$args] result eopts]} { + catch {mime::finalize $token -subordinates dynamic} + return -options $eopts $result + } + return $token +} + +# ::mime::initializeaux -- +# +# Configures the MIME token created in mime::initialize based on +# the arguments that mime::initialize supports. +# +# Arguments: +# token The MIME token to configure. +# args Args can be any one of the following: +# ?-canonical type/subtype +# ?-param {key value}?... +# ?-encoding value? +# ?-header {key value}?... ? +# (-file name | -string value | -parts {token1 ... tokenN}) +# +# Results: +# Either configures the mime token, or throws an error. + +proc ::mime::initializeaux {token args} { + global errorCode errorInfo + # FRINK: nocheck + variable $token + upvar 0 $token state + + array set params [set state(params) {}] + set state(encoding) {} + set state(version) 1.0 + + set state(header) {} + set state(lowerL) {} + set state(mixedL) {} + + set state(cid) 0 + + set userheader 0 + + set argc [llength $args] + for {set argx 0} {$argx < $argc} {incr argx} { + set option [lindex $args $argx] + if {[incr argx] >= $argc} { + error "missing argument to $option" + } + set value [lindex $args $argx] + + switch -- $option { + -canonical { + set state(content) [string tolower $value] + } + + -param { + if {[llength $value] != 2} { + error "-param expects a key and a value, not $value" + } + set lower [string tolower [set mixed [lindex $value 0]]] + if {[info exists params($lower)]} { + error "the $mixed parameter may be specified at most once" + } + + set params($lower) [lindex $value 1] + set state(params) [array get params] + } + + -encoding { + set value [string tolower $value[set value {}]] + + switch -- $value { + 7bit - 8bit - binary - quoted-printable - base64 { + } + + default { + error "unknown value for -encoding $state(encoding)" + } + } + set state(encoding) [string tolower $value] + } + + -header { + if {[llength $value] != 2} { + error "-header expects a key and a value, not $value" + } + set lower [string tolower [set mixed [lindex $value 0]]] + if {$lower eq {content-type}} { + error "use -canonical instead of -header $value" + } + if {$lower eq {content-transfer-encoding}} { + error "use -encoding instead of -header $value" + } + if {$lower in {content-md5 mime-version}} { + error {don't go there...} + } + if {$lower ni $state(lowerL)} { + lappend state(lowerL) $lower + lappend state(mixedL) $mixed + } + + set userheader 1 + + array set header $state(header) + lappend header($lower) [lindex $value 1] + set state(header) [array get header] + } + + -file { + set state(file) $value + } + + -parts { + set state(parts) $value + } + + -string { + set state(string) $value + + set state(lines) [split $value \n] + set state(lines.count) [llength $state(lines)] + set state(lines.current) 0 + } + + -root { + # the following are internal options + + set state(root) $value + } + + -offset { + set state(offset) $value + } + + -count { + set state(count) $value + } + + -lineslist { + set state(lines) $value + set state(lines.count) [llength $state(lines)] + set state(lines.current) 0 + #state(string) is needed, but will be built when required + set state(string) {} + } + + default { + error "unknown option $option" + } + } + } + + #We only want one of -file, -parts or -string: + set valueN 0 + foreach value {file parts string} { + if {[info exists state($value)]} { + set state(value) $value + incr valueN + } + } + if {$valueN != 1 && ![info exists state(lines)]} { + error {specify exactly one of -file, -parts, or -string} + } + + if {[set state(canonicalP) [info exists state(content)]]} { + switch -- $state(value) { + file { + set state(offset) 0 + } + + parts { + switch -glob -- $state(content) { + text/* + - + image/* + - + audio/* + - + video/* { + error "-canonical $state(content) and -parts do not mix" + } + + default { + if {$state(encoding) ne {}} { + error {-encoding and -parts do not mix} + } + } + } + } + default {# Go ahead} + } + + if {[lsearch -exact $state(lowerL) content-id] < 0} { + lappend state(lowerL) content-id + lappend state(mixedL) Content-ID + + array set header $state(header) + lappend header(content-id) [uniqueID] + set state(header) [array get header] + } + + set state(version) 1.0 + return + } + + if {$state(params) ne {}} { + error {-param requires -canonical} + } + if {$state(encoding) ne {}} { + error {-encoding requires -canonical} + } + if {$userheader} { + error {-header requires -canonical} + } + if {[info exists state(parts)]} { + error {-parts requires -canonical} + } + + if {[set fileP [info exists state(file)]]} { + if {[set openP [info exists state(root)]]} { + # FRINK: nocheck + variable $state(root) + upvar 0 $state(root) root + + set state(fd) $root(fd) + } else { + set state(root) $token + set state(fd) [open $state(file) RDONLY] + set state(offset) 0 + seek $state(fd) 0 end + set state(count) [tell $state(fd)] + + fconfigure $state(fd) -translation binary + } + } + + set code [catch {mime::parsepart $token} result] + set ecode $errorCode + set einfo $errorInfo + + if {$fileP} { + if {!$openP} { + unset state(root) + catch {close $state(fd)} + } + unset state(fd) + } + + return -code $code -errorinfo $einfo -errorcode $ecode $result +} + +# ::mime::parsepart -- +# +# Parses the MIME headers and attempts to break up the message +# into its various parts, creating a MIME token for each part. +# +# Arguments: +# token The MIME token to parse. +# +# Results: +# Throws an error if it has problems parsing the MIME token, +# otherwise it just sets up the appropriate variables. + +proc ::mime::parsepart {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + if {[set fileP [info exists state(file)]]} { + seek $state(fd) [set pos $state(offset)] start + set last [expr {$state(offset) + $state(count) - 1}] + } else { + set string $state(string) + } + + set vline {} + while 1 { + set blankP 0 + if {$fileP} { + if {($pos > $last) || ([set x [gets $state(fd) line]] <= 0)} { + set blankP 1 + } else { + incr pos [expr {$x + 1}] + } + } else { + if {$state(lines.current) >= $state(lines.count)} { + set blankP 1 + set line {} + } else { + set line [lindex $state(lines) $state(lines.current)] + incr state(lines.current) + set x [string length $line] + if {$x == 0} {set blankP 1} + } + } + + if {!$blankP && [string match *\r $line]} { + set line [string range $line 0 $x-2]] + if {$x == 1} { + set blankP 1 + } + } + + if {!$blankP && ( + [string first { } $line] == 0 + || + [string first \t $line] == 0 + )} { + append vline \n $line + continue + } + + if {$vline eq {}} { + if {$blankP} { + break + } + + set vline $line + continue + } + + if { + [set x [string first : $vline]] <= 0 + || + [set mixed [string trimright [ + string range $vline 0 [expr {$x - 1}]]]] eq {} + } { + error "improper line in header: $vline" + } + set value [string trim [string range $vline [expr {$x + 1}] end]] + switch -- [set lower [string tolower $mixed]] { + content-type { + if {[info exists state(content)]} { + error "multiple Content-Type fields starting with $vline" + } + + if {![catch {set x [parsetype $token $value]}]} { + set state(content) [lindex $x 0] + set state(params) [lindex $x 1] + } + } + + content-md5 { + } + + content-transfer-encoding { + if { + $state(encoding) ne {} + && + $state(encoding) ne [string tolower $value] + } { + error "multiple Content-Transfer-Encoding fields starting with $vline" + } + + set state(encoding) [string tolower $value] + } + + mime-version { + set state(version) $value + } + + default { + if {[lsearch -exact $state(lowerL) $lower] < 0} { + lappend state(lowerL) $lower + lappend state(mixedL) $mixed + } + + array set header $state(header) + lappend header($lower) $value + set state(header) [array get header] + } + } + + if {$blankP} { + break + } + set vline $line + } + + if {![info exists state(content)]} { + set state(content) text/plain + set state(params) [list charset us-ascii] + } + + if {![string match multipart/* $state(content)]} { + if {$fileP} { + set x [tell $state(fd)] + incr state(count) [expr {$state(offset) - $x}] + set state(offset) $x + } else { + # rebuild string, this is cheap and needed by other functions + set state(string) [join [ + lrange $state(lines) $state(lines.current) end] \n] + } + + if {[string match message/* $state(content)]} { + # FRINK: nocheck + variable [set child $token-[incr state(cid)]] + + set state(value) parts + set state(parts) $child + if {$fileP} { + mime::initializeaux $child \ + -file $state(file) -root $state(root) \ + -offset $state(offset) -count $state(count) + } else { + if {[info exists state(encoding)]} { + set strng [join [ + lrange $state(lines) $state(lines.current) end] \n] + switch -- $state(encoding) { + base64 - + quoted-printable { + set strng [$state(encoding) -mode decode -- $strng] + } + default {} + } + mime::initializeaux $child -string $strng + } else { + mime::initializeaux $child -lineslist [ + lrange $state(lines) $state(lines.current) end] + } + } + } + + return + } + + set state(value) parts + + set boundary {} + foreach {k v} $state(params) { + if {$k eq {boundary}} { + set boundary $v + break + } + } + if {$boundary eq {}} { + error "boundary parameter is missing in $state(content)" + } + if {[string trim $boundary] eq {}} { + error "boundary parameter is empty in $state(content)" + } + + if {$fileP} { + set pos [tell $state(fd)] + # This variable is like 'start', for the reasons laid out + # below, in the other branch of this conditional. + set initialpos $pos + } else { + # This variable is like 'start', a list of lines in the + # part. This record is made even before we find a starting + # boundary and used if we run into the terminating boundary + # before a starting boundary was found. In that case the lines + # before the terminator as recorded by tracelines are seen as + # the part, or at least we attempt to parse them as a + # part. See the forceoctet and nochild flags later. We cannot + # use 'start' as that records lines only after the starting + # boundary was found. + set tracelines [list] + } + + set inP 0 + set moreP 1 + set forceoctet 0 + while {$moreP} { + if {$fileP} { + if {$pos > $last} { + # We have run over the end of the part per the outer + # information without finding a terminating boundary. + # We now fake the boundary and force the parser to + # give any new part coming of this a mime-type of + # application/octet-stream regardless of header + # information. + set line "--$boundary--" + set x [string length $line] + set forceoctet 1 + } else { + if {[set x [gets $state(fd) line]] < 0} { + error "end-of-file encountered while parsing $state(content)" + } + } + incr pos [expr {$x + 1}] + } else { + if {$state(lines.current) >= $state(lines.count)} { + error "end-of-string encountered while parsing $state(content)" + } else { + set line [lindex $state(lines) $state(lines.current)] + incr state(lines.current) + set x [string length $line] + } + set x [string length $line] + } + if {[string last \r $line] == $x - 1} { + set line [string range $line 0 [expr {$x - 2}]] + set crlf 2 + } else { + set crlf 1 + } + + if {[string first --$boundary $line] != 0} { + if {$inP && !$fileP} { + lappend start $line + } + continue + } else { + lappend tracelines $line + } + + if {!$inP} { + # Haven't seen the starting boundary yet. Check if the + # current line contains this starting boundary. + + if {$line eq "--$boundary"} { + # Yes. Switch parser state to now search for the + # terminating boundary of the part and record where + # the part begins (or initialize the recorder for the + # lines in the part). + set inP 1 + if {$fileP} { + set start $pos + } else { + set start [list] + } + continue + } elseif {$line eq "--$boundary--"} { + # We just saw a terminating boundary before we ever + # saw the starting boundary of a part. This forces us + # to stop parsing, we do this by forcing the parser + # into an accepting state. We will try to create a + # child part based on faked start position or recorded + # lines, or, if that fails, let the current part have + # no children. + + # As an example note the test case mime-3.7 and the + # referenced file "badmail1.txt". + + set inP 1 + if {$fileP} { + set start $initialpos + } else { + set start $tracelines + } + set forceoctet 1 + # Fall through. This brings to the creation of the new + # part instead of searching further and possible + # running over the end. + } else { + continue + } + } + + # Looking for the end of the current part. We accept both a + # terminating boundary and the starting boundary of the next + # part as the end of the current part. + + if {[set moreP [string compare $line --$boundary--]] + && $line ne "--$boundary"} { + + # The current part has not ended, so we record the line + # if we are inside a part and doing string parsing. + if {$inP && !$fileP} { + lappend start $line + } + continue + } + + # The current part has ended. We now determine the exact + # boundaries, create a mime part object for it and recursively + # parse it deeper as part of that action. + + # FRINK: nocheck + variable [set child $token-[incr state(cid)]] + + lappend state(parts) $child + + set nochild 0 + if {$fileP} { + if {[set count [expr {$pos - ($start + $x + $crlf + 1)}]] < 0} { + set count 0 + } + if {$forceoctet} { + set ::errorInfo {} + if {[catch { + mime::initializeaux $child \ + -file $state(file) -root $state(root) \ + -offset $start -count $count + }]} { + set nochild 1 + set state(parts) [lrange $state(parts) 0 end-1] + } } else { + mime::initializeaux $child \ + -file $state(file) -root $state(root) \ + -offset $start -count $count + } + seek $state(fd) [set start $pos] start + } else { + if {$forceoctet} { + if {[catch { + mime::initializeaux $child -lineslist $start + }]} { + set nochild 1 + set state(parts) [lrange $state(parts) 0 end-1] + } + } else { + mime::initializeaux $child -lineslist $start + } + set start {} + } + if {$forceoctet && !$nochild} { + variable $child + upvar 0 $child childstate + set childstate(content) application/octet-stream + } + set forceoctet 0 + } +} + +# ::mime::parsetype -- +# +# Parses the string passed in and identifies the content-type and +# params strings. +# +# Arguments: +# token The MIME token to parse. +# string The content-type string that should be parsed. +# +# Results: +# Returns the content and params for the string as a two element +# tcl list. + +proc ::mime::parsetype {token string} { + global errorCode errorInfo + # FRINK: nocheck + variable $token + upvar 0 $token state + + variable typetokenL + variable typelexemeL + + set state(input) $string + set state(buffer) {} + set state(lastC) LX_END + set state(comment) {} + set state(tokenL) $typetokenL + set state(lexemeL) $typelexemeL + + set code [catch {mime::parsetypeaux $token $string} result] + set ecode $errorCode + set einfo $errorInfo + + unset {*}{ + state(input) + state(buffer) + state(lastC) + state(comment) + state(tokenL) + state(lexemeL) + } + + return -code $code -errorinfo $einfo -errorcode $ecode $result +} + +# ::mime::parsetypeaux -- +# +# A helper function for mime::parsetype. Parses the specified +# string looking for the content type and params. +# +# Arguments: +# token The MIME token to parse. +# string The content-type string that should be parsed. +# +# Results: +# Returns the content and params for the string as a two element +# tcl list. + +proc ::mime::parsetypeaux {token string} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + if {[parselexeme $token] ne {LX_ATOM}} { + error [format {expecting type (found %s)} $state(buffer)] + } + set type [string tolower $state(buffer)] + + switch -- [parselexeme $token] { + LX_SOLIDUS { + } + + LX_END { + if {$type ne {message}} { + error "expecting type/subtype (found $type)" + } + + return [list message/rfc822 {}] + } + + default { + error [format "expecting \"/\" (found %s)" $state(buffer)] + } + } + + if {[parselexeme $token] ne {LX_ATOM}} { + error [format "expecting subtype (found %s)" $state(buffer)] + } + append type [string tolower /$state(buffer)] + + array set params {} + while 1 { + switch -- [parselexeme $token] { + LX_END { + return [list $type [array get params]] + } + + LX_SEMICOLON { + } + + default { + error [format "expecting \";\" (found %s)" $state(buffer)] + } + } + + switch -- [parselexeme $token] { + LX_END { + return [list $type [array get params]] + } + + LX_ATOM { + } + + default { + error [format "expecting attribute (found %s)" $state(buffer)] + } + } + + set attribute [string tolower $state(buffer)] + + if {[parselexeme $token] ne {LX_EQUALS}} { + error [format {expecting "=" (found %s)} $state(buffer)] + } + + switch -- [parselexeme $token] { + LX_ATOM { + } + + LX_QSTRING { + set state(buffer) [ + string range $state(buffer) 1 [ + expr {[string length $state(buffer)] - 2}]] + } + + default { + error [format {expecting value (found %s)} $state(buffer)] + } + } + set params($attribute) $state(buffer) + } +} + +# ::mime::finalize -- +# +# mime::finalize destroys a MIME part. +# +# If the -subordinates option is present, it specifies which +# subordinates should also be destroyed. The default value is +# "dynamic". +# +# Arguments: +# token The MIME token to parse. +# args Args can be optionally be of the following form: +# ?-subordinates "all" | "dynamic" | "none"? +# +# Results: +# Returns an empty string. + +proc ::mime::finalize {token args} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + array set options [list -subordinates dynamic] + array set options $args + + switch -- $options(-subordinates) { + all { + #TODO: this code path is untested + if {$state(value) eq {parts}} { + foreach part $state(parts) { + eval [linsert $args 0 mime::finalize $part] + } + } + } + + dynamic { + for {set cid $state(cid)} {$cid > 0} {incr cid -1} { + eval [linsert $args 0 mime::finalize $token-$cid] + } + } + + none { + } + + default { + error "unknown value for -subordinates $options(-subordinates)" + } + } + + foreach name [array names state] { + unset state($name) + } + # FRINK: nocheck + unset $token +} + +# ::mime::getproperty -- +# +# mime::getproperty returns the properties of a MIME part. +# +# The properties are: +# +# property value +# ======== ===== +# content the type/subtype describing the content +# encoding the "Content-Transfer-Encoding" +# params a list of "Content-Type" parameters +# parts a list of tokens for the part's subordinates +# size the approximate size of the content (unencoded) +# +# The "parts" property is present only if the MIME part has +# subordinates. +# +# If mime::getproperty is invoked with the name of a specific +# property, then the corresponding value is returned; instead, if +# -names is specified, a list of all properties is returned; +# otherwise, a dictionary of properties is returned. +# +# Arguments: +# token The MIME token to parse. +# property One of 'content', 'encoding', 'params', 'parts', and +# 'size'. Defaults to returning a dictionary of +# properties. +# +# Results: +# Returns the properties of a MIME part + +proc ::mime::getproperty {token {property {}}} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + switch -- $property { + {} { + array set properties [list content $state(content) \ + encoding $state(encoding) \ + params $state(params) \ + size [getsize $token]] + if {[info exists state(parts)]} { + set properties(parts) $state(parts) + } + + return [array get properties] + } + + -names { + set names [list content encoding params] + if {[info exists state(parts)]} { + lappend names parts + } + + return $names + } + + content + - + encoding + - + params { + return $state($property) + } + + parts { + if {![info exists state(parts)]} { + error {MIME part is a leaf} + } + + return $state(parts) + } + + size { + return [getsize $token] + } + + default { + error "unknown property $property" + } + } +} + +# ::mime::getsize -- +# +# Determine the size (in bytes) of a MIME part/token +# +# Arguments: +# token The MIME token to parse. +# +# Results: +# Returns the size in bytes of the MIME token. + +proc ::mime::getsize {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + switch -- $state(value)/$state(canonicalP) { + file/0 { + set size $state(count) + } + + file/1 { + return [file size $state(file)] + } + + parts/0 + - + parts/1 { + set size 0 + foreach part $state(parts) { + incr size [getsize $part] + } + + return $size + } + + string/0 { + set size [string length $state(string)] + } + + string/1 { + return [string length $state(string)] + } + default { + error "Unknown combination \"$state(value)/$state(canonicalP)\"" + } + } + + if {$state(encoding) eq {base64}} { + set size [expr {($size * 3 + 2) / 4}] + } + + return $size +} + + +proc ::mime::getContentType token { + variable $token + upvar 0 $token state + set boundary {} + set res $state(content) + foreach {k v} $state(params) { + set boundary $v + append res ";\n $k=\"$v\"" + } + if {([string match multipart/* $state(content)]) \ + && ($boundary eq {})} { + # we're doing everything in one pass... + set key [clock seconds]$token[info hostname][array get state] + set seqno 8 + while {[incr seqno -1] >= 0} { + set key [md5 -- $key] + } + set boundary "----- =_[string trim [base64 -mode encode -- $key]]" + + append res ";\n boundary=\"$boundary\"" + } + return $res +} + +# ::mime::getheader -- +# +# mime::getheader returns the header of a MIME part. +# +# A header consists of zero or more key/value pairs. Each value is a +# list containing one or more strings. +# +# If mime::getheader is invoked with the name of a specific key, then +# a list containing the corresponding value(s) is returned; instead, +# if -names is specified, a list of all keys is returned; otherwise, a +# dictionary is returned. Note that when a +# key is specified (e.g., "Subject"), the list returned usually +# contains exactly one string; however, some keys (e.g., "Received") +# often occur more than once in the header, accordingly the list +# returned usually contains more than one string. +# +# Arguments: +# token The MIME token to parse. +# key Either a key or '-names'. If it is '-names' a list +# of all keys is returned. +# +# Results: +# Returns the header of a MIME part. + +proc ::mime::getheader {token {key {}}} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + array set header $state(header) + switch -- $key { + {} { + set result {} + lappend result MIME-Version $state(version) + foreach lower $state(lowerL) mixed $state(mixedL) { + foreach value $header($lower) { + lappend result $mixed $value + } + } + set tencoding [getTransferEncoding $token] + if {$tencoding ne {}} { + lappend result Content-Transfer-Encoding $tencoding + } + lappend result Content-Type [getContentType $token] + return $result + } + + -names { + return $state(mixedL) + } + + default { + set lower [string tolower $key] + + switch $lower { + content-transfer-encoding { + return [getTransferEncoding $token] + } + content-type { + return [list [getContentType $token]] + } + mime-version { + return [list $state(version)] + } + default { + if {![info exists header($lower)]} { + error "key $key not in header" + } + return $header($lower) + } + } + } + } +} + + +proc ::mime::getTransferEncoding token { + variable $token + upvar 0 $token state + set res {} + if {[set encoding $state(encoding)] eq {}} { + set encoding [encoding $token] + } + if {$encoding ne {}} { + set res $encoding + } + switch -- $encoding { + base64 + - + quoted-printable { + set converter $encoding + } + 7bit - 8bit - binary - {} { + # Bugfix for [#477088], also [#539952] + # Go ahead + } + default { + error "Can't handle content encoding \"$encoding\"" + } + } + return $res +} + +# ::mime::setheader -- +# +# mime::setheader writes, appends to, or deletes the value associated +# with a key in the header. +# +# The value for -mode is one of: +# +# write: the key/value is either created or overwritten (the +# default); +# +# append: a new value is appended for the key (creating it as +# necessary); or, +# +# delete: all values associated with the key are removed (the +# "value" parameter is ignored). +# +# Regardless, mime::setheader returns the previous value associated +# with the key. +# +# Arguments: +# token The MIME token to parse. +# key The name of the key whose value should be set. +# value The value for the header key to be set to. +# args An optional argument of the form: +# ?-mode "write" | "append" | "delete"? +# +# Results: +# Returns previous value associated with the specified key. + +proc ::mime::setheader {token key value args} { + # FRINK: nocheck + variable internal + variable $token + upvar 0 $token state + + array set options [list -mode write] + array set options $args + + set lower [string tolower $key] + array set header $state(header) + if {[set x [lsearch -exact $state(lowerL) $lower]] < 0} { + #TODO: this code path is not tested + if {$options(-mode) eq {delete}} { + error "key $key not in header" + } + + lappend state(lowerL) $lower + lappend state(mixedL) $key + + set result {} + } else { + set result $header($lower) + } + switch -- $options(-mode) { + append - write { + if {!$internal} { + switch -- $lower { + content-md5 + - + content-type + - + content-transfer-encoding + - + mime-version { + set values [getheader $token $lower] + if {$value ni $values} { + error "key $key may not be set" + } + } + default {# Skip key} + } + } + switch -- $options(-mode) { + append { + lappend header($lower) $value + } + write { + set header($lower) [list $value] + } + } + } + delete { + unset header($lower) + set state(lowerL) [lreplace $state(lowerL) $x $x] + set state(mixedL) [lreplace $state(mixedL) $x $x] + } + + default { + error "unknown value for -mode $options(-mode)" + } + } + + set state(header) [array get header] + return $result +} + +# ::mime::getbody -- +# +# mime::getbody returns the body of a leaf MIME part in canonical form. +# +# If the -command option is present, then it is repeatedly invoked +# with a fragment of the body as this: +# +# uplevel #0 $callback [list "data" $fragment] +# +# (The -blocksize option, if present, specifies the maximum size of +# each fragment passed to the callback.) +# When the end of the body is reached, the callback is invoked as: +# +# uplevel #0 $callback "end" +# +# Alternatively, if an error occurs, the callback is invoked as: +# +# uplevel #0 $callback [list "error" reason] +# +# Regardless, the return value of the final invocation of the callback +# is propagated upwards by mime::getbody. +# +# If the -command option is absent, then the return value of +# mime::getbody is a string containing the MIME part's entire body. +# +# Arguments: +# token The MIME token to parse. +# args Optional arguments of the form: +# ?-decode? ?-command callback ?-blocksize octets? ? +# +# Results: +# Returns a string containing the MIME part's entire body, or +# if '-command' is specified, the return value of the command +# is returned. + +proc ::mime::getbody {token args} { + global errorCode errorInfo + # FRINK: nocheck + variable $token + upvar 0 $token state + + set decode 0 + if {[set pos [lsearch -exact $args -decode]] >= 0} { + set decode 1 + set args [lreplace $args $pos $pos] + } + + array set options [list -command [ + list mime::getbodyaux $token] -blocksize 4096] + array set options $args + if {$options(-blocksize) < 1} { + error "-blocksize expects a positive integer, not $options(-blocksize)" + } + + set code 0 + set ecode {} + set einfo {} + + switch -- $state(value)/$state(canonicalP) { + file/0 { + set fd [open $state(file) RDONLY] + + set code [catch { + fconfigure $fd -translation binary + seek $fd [set pos $state(offset)] start + set last [expr {$state(offset) + $state(count) - 1}] + + set fragment {} + while {$pos <= $last} { + if {[set cc [ + expr {($last - $pos) + 1}]] > $options(-blocksize)} { + set cc $options(-blocksize) + } + incr pos [set len [ + string length [set chunk [read $fd $cc]]]] + switch -exact -- $state(encoding) { + base64 + - + quoted-printable { + if {([set x [string last \n $chunk]] > 0) \ + && ($x + 1 != $len)} { + set chunk [string range $chunk 0 $x] + seek $fd [incr pos [expr {($x + 1) - $len}]] start + } + set chunk [ + $state(encoding) -mode decode -- $chunk] + } + 7bit - 8bit - binary - {} { + # Bugfix for [#477088] + # Go ahead, leave chunk alone + } + default { + error "Can't handle content encoding \"$state(encoding)\"" + } + } + append fragment $chunk + + set cc [expr {$options(-blocksize) - 1}] + while {[string length $fragment] > $options(-blocksize)} { + uplevel #0 $options(-command) [ + list data [string range $fragment 0 $cc]] + + set fragment [ + string range $fragment $options(-blocksize) end] + } + } + if {[string length $fragment] > 0} { + uplevel #0 $options(-command) [list data $fragment] + } + } result] + set ecode $errorCode + set einfo $errorInfo + + catch {close $fd} + } + + file/1 { + set fd [open $state(file) RDONLY] + + set code [catch { + fconfigure $fd -translation binary + + while {[string length [ + set fragment [read $fd $options(-blocksize)]]] > 0} { + uplevel #0 $options(-command) [list data $fragment] + } + } result] + set ecode $errorCode + set einfo $errorInfo + + catch {close $fd} + } + + parts/0 + - + parts/1 { + error {MIME part isn't a leaf} + } + + string/0 + - + string/1 { + switch -- $state(encoding)/$state(canonicalP) { + base64/0 + - + quoted-printable/0 { + set fragment [ + $state(encoding) -mode decode -- $state(string)] + } + + default { + # Not a bugfix for [#477088], but clarification + # This handles no-encoding, 7bit, 8bit, and binary. + set fragment $state(string) + } + } + + set code [catch { + set cc [expr {$options(-blocksize) -1}] + while {[string length $fragment] > $options(-blocksize)} { + uplevel #0 $options(-command) [ + list data [string range $fragment 0 $cc]] + + set fragment [ + string range $fragment $options(-blocksize) end] + } + if {[string length $fragment] > 0} { + uplevel #0 $options(-command) [list data $fragment] + } + } result] + set ecode $errorCode + set einfo $errorInfo + } + default { + error "Unknown combination \"$state(value)/$state(canonicalP)\"" + } + } + + set code [catch { + if {$code} { + uplevel #0 $options(-command) [list error $result] + } else { + uplevel #0 $options(-command) [list end] + } + } result] + set ecode $errorCode + set einfo $errorInfo + + if {$code} { + return -code $code -errorinfo $einfo -errorcode $ecode $result + } + + if {$decode} { + array set params [mime::getproperty $token params] + + if {[info exists params(charset)]} { + set charset $params(charset) + } else { + set charset US-ASCII + } + + set enc [reversemapencoding $charset] + if {$enc ne {}} { + set result [::encoding convertfrom $enc $result] + } else { + return -code error "-decode failed: can't reversemap charset $charset" + } + } + + return $result +} + +# ::mime::getbodyaux -- +# +# Builds up the body of the message, fragment by fragment. When +# the entire message has been retrieved, it is returned. +# +# Arguments: +# token The MIME token to parse. +# reason One of 'data', 'end', or 'error'. +# fragment The section of data data fragment to extract a +# string from. +# +# Results: +# Returns nothing, except when called with the 'end' argument +# in which case it returns a string that contains all of the +# data that 'getbodyaux' has been called with. Will throw an +# error if it is called with the reason of 'error'. + +proc ::mime::getbodyaux {token reason {fragment {}}} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + switch $reason { + data { + append state(getbody) $fragment + return {} + } + + end { + if {[info exists state(getbody)]} { + set result $state(getbody) + unset state(getbody) + } else { + set result {} + } + + return $result + } + + error { + catch {unset state(getbody)} + error $reason + } + + default { + error "Unknown reason \"$reason\"" + } + } +} + +# ::mime::copymessage -- +# +# mime::copymessage copies the MIME part to the specified channel. +# +# mime::copymessage operates synchronously, and uses fileevent to +# allow asynchronous operations to proceed independently. +# +# Arguments: +# token The MIME token to parse. +# channel The channel to copy the message to. +# +# Results: +# Returns nothing unless an error is thrown while the message +# is being written to the channel. + +proc ::mime::copymessage {token channel} { + global errorCode errorInfo + # FRINK: nocheck + variable $token + upvar 0 $token state + + set openP [info exists state(fd)] + + set code [catch {mime::copymessageaux $token $channel} result] + set ecode $errorCode + set einfo $errorInfo + + if {!$openP && [info exists state(fd)]} { + if {![info exists state(root)]} { + catch {close $state(fd)} + } + unset state(fd) + } + + return -code $code -errorinfo $einfo -errorcode $ecode $result +} + +# ::mime::copymessageaux -- +# +# mime::copymessageaux copies the MIME part to the specified channel. +# +# Arguments: +# token The MIME token to parse. +# channel The channel to copy the message to. +# +# Results: +# Returns nothing unless an error is thrown while the message +# is being written to the channel. + +proc ::mime::copymessageaux {token channel} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + array set header $state(header) + + set boundary {} + + set result {} + foreach {mixed value} [getheader $token] { + puts $channel "$mixed: $value" + } + + foreach {k v} $state(params) { + if {$k eq {boundary}} { + set boundary $v + } + } + + set converter {} + set encoding {} + if {$state(value) ne {parts}} { + if {$state(canonicalP)} { + if {[set encoding $state(encoding)] eq {}} { + set encoding [encoding $token] + } + if {$encoding ne {}} { + puts $channel "Content-Transfer-Encoding: $encoding" + } + switch -- $encoding { + base64 + - + quoted-printable { + set converter $encoding + } + 7bit - 8bit - binary - {} { + # Bugfix for [#477088], also [#539952] + # Go ahead + } + default { + error "Can't handle content encoding \"$encoding\"" + } + } + } + } elseif {([string match multipart/* $state(content)]) \ + && ($boundary eq {})} { + # we're doing everything in one pass... + set key [clock seconds]$token[info hostname][array get state] + set seqno 8 + while {[incr seqno -1] >= 0} { + set key [md5 -- $key] + } + set boundary "----- =_[string trim [base64 -mode encode -- $key]]" + + puts $channel ";\n boundary=\"$boundary\"" + } + + if {[info exists state(error)]} { + unset state(error) + } + + switch -- $state(value) { + file { + set closeP 1 + if {[info exists state(root)]} { + # FRINK: nocheck + variable $state(root) + upvar 0 $state(root) root + + if {[info exists root(fd)]} { + set fd $root(fd) + set closeP 0 + } else { + set fd [set state(fd) [open $state(file) RDONLY]] + } + set size $state(count) + } else { + set fd [set state(fd) [open $state(file) RDONLY]] + # read until eof + set size -1 + } + seek $fd $state(offset) start + if {$closeP} { + fconfigure $fd -translation binary + } + + puts $channel {} + + while {$size != 0 && ![eof $fd]} { + if {$size < 0 || $size > 32766} { + set X [read $fd 32766] + } else { + set X [read $fd $size] + } + if {$size > 0} { + set size [expr {$size - [string length $X]}] + } + if {$converter eq {}} { + puts -nonewline $channel $X + } else { + puts -nonewline $channel [$converter -mode encode -- $X] + } + } + + if {$closeP} { + catch {close $state(fd)} + unset state(fd) + } + } + + parts { + if { + ![info exists state(root)] + && + [info exists state(file)] + } { + set state(fd) [open $state(file) RDONLY] + fconfigure $state(fd) -translation binary + } + + switch -glob -- $state(content) { + message/* { + puts $channel {} + foreach part $state(parts) { + mime::copymessage $part $channel + break + } + } + + default { + # Note RFC 2046: See buildmessageaux for details. + # + # The boundary delimiter MUST occur at the + # beginning of a line, i.e., following a CRLF, and + # the initial CRLF is considered to be attached to + # the boundary delimiter line rather than part of + # the preceding part. + # + # - The above means that the CRLF before $boundary + # is needed per the RFC, and the parts must not + # have a closing CRLF of their own. See Tcllib bug + # 1213527, and patch 1254934 for the problems when + # both file/string branches added CRLF after the + # body parts. + + + foreach part $state(parts) { + puts $channel \n--$boundary + mime::copymessage $part $channel + } + puts $channel \n--$boundary-- + } + } + + if {[info exists state(fd)]} { + catch {close $state(fd)} + unset state(fd) + } + } + + string { + if {[catch {fconfigure $channel -buffersize} blocksize]} { + set blocksize 4096 + } elseif {$blocksize < 512} { + set blocksize 512 + } + set blocksize [expr {($blocksize / 4) * 3}] + + # [893516] + fconfigure $channel -buffersize $blocksize + + puts $channel {} + + #TODO: tests don't cover these paths + if {$converter eq {}} { + puts -nonewline $channel $state(string) + } else { + puts -nonewline $channel [$converter -mode encode -- $state(string)] + } + } + default { + error "Unknown value \"$state(value)\"" + } + } + + flush $channel + + if {[info exists state(error)]} { + error $state(error) + } +} + +# ::mime::buildmessage -- +# +# Like copymessage, but produces a string rather than writing the message into a channel. +# +# Arguments: +# token The MIME token to parse. +# +# Results: +# The message. + +proc ::mime::buildmessage token { + global errorCode errorInfo + # FRINK: nocheck + variable $token + upvar 0 $token state + + set openP [info exists state(fd)] + + set code [catch {mime::buildmessageaux $token} result] + if {![info exists errorCode]} { + set ecode {} + } else { + set ecode $errorCode + } + set einfo $errorInfo + + if {!$openP && [info exists state(fd)]} { + if {![info exists state(root)]} { + catch {close $state(fd)} + } + unset state(fd) + } + + return -code $code -errorinfo $einfo -errorcode $ecode $result +} + + +proc ::mime::buildmessageaux token { + set chan [tcl::chan::memchan] + chan configure $chan -translation crlf + copymessageaux $token $chan + seek $chan 0 + chan configure $chan -translation binary + set res [read $chan] + close $chan + return $res +} + +# ::mime::encoding -- +# +# Determines how a token is encoded. +# +# Arguments: +# token The MIME token to parse. +# +# Results: +# Returns the encoding of the message (the null string, base64, +# or quoted-printable). + +proc ::mime::encoding {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + switch -glob -- $state(content) { + audio/* + - + image/* + - + video/* { + return base64 + } + + message/* + - + multipart/* { + return {} + } + default {# Skip} + } + + set asciiP 1 + set lineP 1 + switch -- $state(value) { + file { + set fd [open $state(file) RDONLY] + fconfigure $fd -translation binary + + while {[gets $fd line] >= 0} { + if {$asciiP} { + set asciiP [encodingasciiP $line] + } + if {$lineP} { + set lineP [encodinglineP $line] + } + if {(!$asciiP) && (!$lineP)} { + break + } + } + + catch {close $fd} + } + + parts { + return {} + } + + string { + foreach line [split $state(string) "\n"] { + if {$asciiP} { + set asciiP [encodingasciiP $line] + } + if {$lineP} { + set lineP [encodinglineP $line] + } + if {(!$asciiP) && (!$lineP)} { + break + } + } + } + default { + error "Unknown value \"$state(value)\"" + } + } + + switch -glob -- $state(content) { + text/* { + if {!$asciiP} { + #TODO: this path is not covered by tests + foreach {k v} $state(params) { + if {$k eq "charset"} { + set v [string tolower $v] + if {($v ne "us-ascii") \ + && (![string match {iso-8859-[1-8]} $v])} { + return base64 + } + + break + } + } + } + + if {!$lineP} { + return quoted-printable + } + } + + + default { + if {(!$asciiP) || (!$lineP)} { + return base64 + } + } + } + + return {} +} + +# ::mime::encodingasciiP -- +# +# Checks if a string is a pure ascii string, or if it has a non-standard +# form. +# +# Arguments: +# line The line to check. +# +# Results: +# Returns 1 if \r only occurs at the end of lines, and if all +# characters in the line are between the ASCII codes of 32 and 126. + +proc ::mime::encodingasciiP {line} { + foreach c [split $line {}] { + switch -- $c { + { } - \t - \r - \n { + } + + default { + binary scan $c c c + if {($c < 32) || ($c > 126)} { + return 0 + } + } + } + } + if { + [set r [string first \r $line]] < 0 + || + $r == {[string length $line] - 1} + } { + return 1 + } + + return 0 +} + +# ::mime::encodinglineP -- +# +# Checks if a string is a line is valid to be processed. +# +# Arguments: +# line The line to check. +# +# Results: +# Returns 1 the line is less than 76 characters long, the line +# contains more characters than just whitespace, the line does +# not start with a '.', and the line does not start with 'From '. + +proc ::mime::encodinglineP {line} { + if {([string length $line] > 76) \ + || ($line ne [string trimright $line]) \ + || ([string first . $line] == 0) \ + || ([string first {From } $line] == 0)} { + return 0 + } + + return 1 +} + +# ::mime::fcopy -- +# +# Appears to be unused. +# +# Arguments: +# +# Results: +# + +proc ::mime::fcopy {token count {error {}}} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + if {$error ne {}} { + set state(error) $error + } + set state(doneP) 1 +} + +# ::mime::scopy -- +# +# Copy a portion of the contents of a mime token to a channel. +# +# Arguments: +# token The token containing the data to copy. +# channel The channel to write the data to. +# offset The location in the string to start copying +# from. +# len The amount of data to write. +# blocksize The block size for the write operation. +# +# Results: +# The specified portion of the string in the mime token is +# copied to the specified channel. + +proc ::mime::scopy {token channel offset len blocksize} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + if {$len <= 0} { + set state(doneP) 1 + fileevent $channel writable {} + return + } + + if {[set cc $len] > $blocksize} { + set cc $blocksize + } + + if {[catch { + puts -nonewline $channel [ + string range $state(string) $offset [expr {$offset + $cc - 1}]] + fileevent $channel writable [ + list mime::scopy $token $channel [ + incr offset $cc] [incr len -$cc] $blocksize] + } result] + } { + set state(error) $result + set state(doneP) 1 + fileevent $channel writable {} + } + return +} + +# ::mime::qp_encode -- +# +# Tcl version of quote-printable encode +# +# Arguments: +# string The string to quote. +# encoded_word Boolean value to determine whether or not encoded words +# (RFC 2047) should be handled or not. (optional) +# +# Results: +# The properly quoted string is returned. + +proc ::mime::qp_encode {string {encoded_word 0} {no_softbreak 0}} { + # 8.1+ improved string manipulation routines used. + # Replace outlying characters, characters that would normally + # be munged by EBCDIC gateways, and special Tcl characters "[\]{} + # with =xx sequence + + if {$encoded_word} { + # Special processing for encoded words (RFC 2047) + set regexp {[\x00-\x08\x0B-\x1E\x21-\x24\x3D\x40\x5B-\x5E\x60\x7B-\xFF\x09\x5F\x3F]} + lappend mapChars { } _ + } else { + set regexp {[\x00-\x08\x0B-\x1E\x21-\x24\x3D\x40\x5B-\x5E\x60\x7B-\xFF]} + } + regsub -all -- $regexp $string {[format =%02X [scan "\\&" %c]]} string + + # Replace the format commands with their result + + set string [subst -novariables $string] + + # soft/hard newlines and other + # Funky cases for SMTP compatibility + lappend mapChars " \n" =20\n \t\n =09\n \n\.\n =2E\n "\nFrom " "\n=46rom " + + set string [string map $mapChars $string] + + # Break long lines - ugh + + # Implementation of FR #503336 + if {$no_softbreak} { + set result $string + } else { + set result {} + foreach line [split $string \n] { + while {[string length $line] > 72} { + set chunk [string range $line 0 72] + if {[regexp -- (=|=.)$ $chunk dummy end]} { + + # Don't break in the middle of a code + + set len [expr {72 - [string length $end]}] + set chunk [string range $line 0 $len] + incr len + set line [string range $line $len end] + } else { + set line [string range $line 73 end] + } + append result $chunk=\n + } + append result $line\n + } + + # Trim off last \n, since the above code has the side-effect + # of adding an extra \n to the encoded string and return the + # result. + set result [string range $result 0 end-1] + } + + # If the string ends in space or tab, replace with =xx + + set lastChar [string index $result end] + if {$lastChar eq { }} { + set result [string replace $result end end =20] + } elseif {$lastChar eq "\t"} { + set result [string replace $result end end =09] + } + + return $result +} + +# ::mime::qp_decode -- +# +# Tcl version of quote-printable decode +# +# Arguments: +# string The quoted-printable string to decode. +# encoded_word Boolean value to determine whether or not encoded words +# (RFC 2047) should be handled or not. (optional) +# +# Results: +# The decoded string is returned. + +proc ::mime::qp_decode {string {encoded_word 0}} { + # 8.1+ improved string manipulation routines used. + # Special processing for encoded words (RFC 2047) + + if {$encoded_word} { + # _ == \x20, even if SPACE occupies a different code position + set string [string map [list _ \u0020] $string] + } + + # smash the white-space at the ends of lines since that must've been + # generated by an MUA. + + regsub -all -- {[ \t]+\n} $string \n string + set string [string trimright $string " \t"] + + # Protect the backslash for later subst and + # smash soft newlines, has to occur after white-space smash + # and any encoded word modification. + + #TODO: codepath not tested + set string [string map [list \\ {\\} =\n {}] $string] + + # Decode specials + + regsub -all -nocase {=([a-f0-9][a-f0-9])} $string {\\u00\1} string + + # process \u unicode mapped chars + + return [subst -novariables -nocommands $string] +} + +# ::mime::parseaddress -- +# +# This was originally written circa 1982 in C. we're still using it +# because it recognizes virtually every buggy address syntax ever +# generated! +# +# mime::parseaddress takes a string containing one or more 822-style +# address specifications and returns a list of dictionaries, for each +# address specified in the argument. +# +# Each dictionary contains these properties: +# +# property value +# ======== ===== +# address local@domain +# comment 822-style comment +# domain the domain part (rhs) +# error non-empty on a parse error +# group this address begins a group +# friendly user-friendly rendering +# local the local part (lhs) +# memberP this address belongs to a group +# phrase the phrase part +# proper 822-style address specification +# route 822-style route specification (obsolete) +# +# Note that one or more of these properties may be empty. +# +# Arguments: +# string The address string to parse +# +# Results: +# Returns a list of dictionaries, one element for each address +# specified in the argument. + +proc ::mime::parseaddress {string} { + global errorCode errorInfo + + variable mime + + set token [namespace current]::[incr mime(uid)] + # FRINK: nocheck + variable $token + upvar 0 $token state + + set code [catch {mime::parseaddressaux $token $string} result] + set ecode $errorCode + set einfo $errorInfo + + foreach name [array names state] { + unset state($name) + } + # FRINK: nocheck + catch {unset $token} + + return -code $code -errorinfo $einfo -errorcode $ecode $result +} + +# ::mime::parseaddressaux -- +# +# This was originally written circa 1982 in C. we're still using it +# because it recognizes virtually every buggy address syntax ever +# generated! +# +# mime::parseaddressaux does the actually parsing for mime::parseaddress +# +# Each dictionary contains these properties: +# +# property value +# ======== ===== +# address local@domain +# comment 822-style comment +# domain the domain part (rhs) +# error non-empty on a parse error +# group this address begins a group +# friendly user-friendly rendering +# local the local part (lhs) +# memberP this address belongs to a group +# phrase the phrase part +# proper 822-style address specification +# route 822-style route specification (obsolete) +# +# Note that one or more of these properties may be empty. +# +# Arguments: +# token The MIME token to work from. +# string The address string to parse +# +# Results: +# Returns a list of dictionaries, one for each address specified in the +# argument. + +proc ::mime::parseaddressaux {token string} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + variable addrtokenL + variable addrlexemeL + + set state(input) $string + set state(glevel) 0 + set state(buffer) {} + set state(lastC) LX_END + set state(tokenL) $addrtokenL + set state(lexemeL) $addrlexemeL + + set result {} + while {[addr_next $token]} { + if {[set tail $state(domain)] ne {}} { + set tail @$state(domain) + } else { + set tail @[info hostname] + } + if {[set address $state(local)] ne {}} { + #TODO: this path is not covered by tests + append address $tail + } + + if {$state(phrase) ne {}} { + #TODO: this path is not covered by tests + set state(phrase) [string trim $state(phrase) \"] + foreach t $state(tokenL) { + if {[string first $t $state(phrase)] >= 0} { + #TODO: is this quoting robust enough? + set state(phrase) \"$state(phrase)\" + break + } + } + + set proper "$state(phrase) <$address>" + } else { + set proper $address + } + + if {[set friendly $state(phrase)] eq {}} { + #TODO: this path is not covered by tests + if {[set note $state(comment)] ne {}} { + if {[string first ( $note] == 0} { + set note [string trimleft [string range $note 1 end]] + } + if { + [string last ) $note] + == [set len [expr {[string length $note] - 1}]] + } { + set note [string range $note 0 [expr {$len - 1}]] + } + set friendly $note + } + + if { + $friendly eq {} + && + [set mbox $state(local)] ne {} + } { + #TODO: this path is not covered by tests + set mbox [string trim $mbox \"] + + if {[string first / $mbox] != 0} { + set friendly $mbox + } elseif {[set friendly [addr_x400 $mbox PN]] ne {}} { + } elseif { + [set friendly [addr_x400 $mbox S]] ne {} + && + [set g [addr_x400 $mbox G]] ne {} + } { + set friendly "$g $friendly" + } + + if {$friendly eq {}} { + set friendly $mbox + } + } + } + set friendly [string trim $friendly \"] + + lappend result [list address $address \ + comment $state(comment) \ + domain $state(domain) \ + error $state(error) \ + friendly $friendly \ + group $state(group) \ + local $state(local) \ + memberP $state(memberP) \ + phrase $state(phrase) \ + proper $proper \ + route $state(route)] + + } + + unset {*}{ + state(input) + state(glevel) + state(buffer) + state(lastC) + state(tokenL) + state(lexemeL) + } + + return $result +} + +# ::mime::addr_next -- +# +# Locate the next address in a mime token. +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns 1 if there is another address, and 0 if there is not. + +proc ::mime::addr_next {token} { + global errorCode errorInfo + # FRINK: nocheck + variable $token + upvar 0 $token state + set nocomplain [package vsatisfies [package provide Tcl] 8.4] + foreach prop {comment domain error group local memberP phrase route} { + if {$nocomplain} { + unset -nocomplain state($prop) + } else { + if {[catch {unset state($prop)}]} {set ::errorInfo {}} + } + } + + switch -- [set code [catch {mime::addr_specification $token} result]] { + 0 { + if {!$result} { + return 0 + } + + switch -- $state(lastC) { + LX_COMMA + - + LX_END { + } + default { + # catch trailing comments... + set lookahead $state(input) + mime::parselexeme $token + set state(input) $lookahead + } + } + } + + 7 { + set state(error) $result + + while {1} { + switch -- $state(lastC) { + LX_COMMA + - + LX_END { + break + } + + default { + mime::parselexeme $token + } + } + } + } + + default { + set ecode $errorCode + set einfo $errorInfo + + return -code $code -errorinfo $einfo -errorcode $ecode $result + } + } + + foreach prop {comment domain error group local memberP phrase route} { + if {![info exists state($prop)]} { + set state($prop) {} + } + } + + return 1 +} + +# ::mime::addr_specification -- +# +# Uses lookahead parsing to determine whether there is another +# valid e-mail address or not. Throws errors if unrecognized +# or invalid e-mail address syntax is used. +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns 1 if there is another address, and 0 if there is not. + +proc ::mime::addr_specification {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + set lookahead $state(input) + switch -- [parselexeme $token] { + LX_ATOM + - + LX_QSTRING { + set state(phrase) $state(buffer) + } + + LX_SEMICOLON { + if {[incr state(glevel) -1] < 0} { + return -code 7 "extraneous semi-colon" + } + + catch {unset state(comment)} + return [addr_specification $token] + } + + LX_COMMA { + catch {unset state(comment)} + return [addr_specification $token] + } + + LX_END { + return 0 + } + + LX_LBRACKET { + return [addr_routeaddr $token] + } + + LX_ATSIGN { + set state(input) $lookahead + return [addr_routeaddr $token 0] + } + + default { + return -code 7 [ + format "unexpected character at beginning (found %s)" \ + $state(buffer)] + } + } + + switch -- [parselexeme $token] { + LX_ATOM + - + LX_QSTRING { + append state(phrase) " " $state(buffer) + + return [addr_phrase $token] + } + + LX_LBRACKET { + return [addr_routeaddr $token] + } + + LX_COLON { + return [addr_group $token] + } + + LX_DOT { + set state(local) "$state(phrase)$state(buffer)" + unset state(phrase) + mime::addr_routeaddr $token 0 + mime::addr_end $token + } + + LX_ATSIGN { + set state(memberP) $state(glevel) + set state(local) $state(phrase) + unset state(phrase) + mime::addr_domain $token + mime::addr_end $token + } + + LX_SEMICOLON + - + LX_COMMA + - + LX_END { + set state(memberP) $state(glevel) + if { + $state(lastC) eq "LX_SEMICOLON" + && + ([incr state(glevel) -1] < 0) + } { + #TODO: this path is not covered by tests + return -code 7 "extraneous semi-colon" + } + + set state(local) $state(phrase) + unset state(phrase) + } + + default { + return -code 7 [ + format "expecting mailbox (found %s)" $state(buffer)] + } + } + + return 1 +} + +# ::mime::addr_routeaddr -- +# +# Parses the domain portion of an e-mail address. Finds the '@' +# sign and then calls mime::addr_route to verify the domain. +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns 1 if there is another address, and 0 if there is not. + +proc ::mime::addr_routeaddr {token {checkP 1}} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + set lookahead $state(input) + if {[parselexeme $token] eq "LX_ATSIGN"} { + #TODO: this path is not covered by tests + mime::addr_route $token + } else { + set state(input) $lookahead + } + + mime::addr_local $token + + switch -- $state(lastC) { + LX_ATSIGN { + mime::addr_domain $token + } + + LX_SEMICOLON + - + LX_RBRACKET + - + LX_COMMA + - + LX_END { + } + + default { + return -code 7 [ + format "expecting at-sign after local-part (found %s)" \ + $state(buffer)] + } + } + + if {($checkP) && ($state(lastC) ne "LX_RBRACKET")} { + return -code 7 [ + format "expecting right-bracket (found %s)" $state(buffer)] + } + + return 1 +} + +# ::mime::addr_route -- +# +# Attempts to parse the portion of the e-mail address after the @. +# Tries to verify that the domain definition has a valid form. +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns nothing if successful, and throws an error if invalid +# syntax is found. + +proc ::mime::addr_route {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + set state(route) @ + + while 1 { + switch -- [parselexeme $token] { + LX_ATOM + - + LX_DLITERAL { + append state(route) $state(buffer) + } + + default { + return -code 7 \ + [format "expecting sub-route in route-part (found %s)" \ + $state(buffer)] + } + } + + switch -- [parselexeme $token] { + LX_COMMA { + append state(route) $state(buffer) + while 1 { + switch -- [parselexeme $token] { + LX_COMMA { + } + + LX_ATSIGN { + append state(route) $state(buffer) + break + } + + default { + return -code 7 \ + [format "expecting at-sign in route (found %s)" \ + $state(buffer)] + } + } + } + } + + LX_ATSIGN + - + LX_DOT { + append state(route) $state(buffer) + } + + LX_COLON { + append state(route) $state(buffer) + return + } + + default { + return -code 7 [ + format "expecting colon to terminate route (found %s)" \ + $state(buffer)] + } + } + } +} + +# ::mime::addr_domain -- +# +# Attempts to parse the portion of the e-mail address after the @. +# Tries to verify that the domain definition has a valid form. +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns nothing if successful, and throws an error if invalid +# syntax is found. + +proc ::mime::addr_domain {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + while 1 { + switch -- [parselexeme $token] { + LX_ATOM + - + LX_DLITERAL { + append state(domain) $state(buffer) + } + + default { + return -code 7 [ + format "expecting sub-domain in domain-part (found %s)" \ + $state(buffer)] + } + } + + switch -- [parselexeme $token] { + LX_DOT { + append state(domain) $state(buffer) + } + + LX_ATSIGN { + append state(local) % $state(domain) + unset state(domain) + } + + default { + return + } + } + } +} + +# ::mime::addr_local -- +# +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns nothing if successful, and throws an error if invalid +# syntax is found. + +proc ::mime::addr_local {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + set state(memberP) $state(glevel) + + while 1 { + switch -- [parselexeme $token] { + LX_ATOM + - + LX_QSTRING { + append state(local) $state(buffer) + } + + default { + return -code 7 \ + [format "expecting mailbox in local-part (found %s)" \ + $state(buffer)] + } + } + + switch -- [parselexeme $token] { + LX_DOT { + append state(local) $state(buffer) + } + + default { + return + } + } + } +} + +# ::mime::addr_phrase -- +# +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns nothing if successful, and throws an error if invalid +# syntax is found. + + +proc ::mime::addr_phrase {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + while {1} { + switch -- [parselexeme $token] { + LX_ATOM + - + LX_QSTRING { + append state(phrase) " " $state(buffer) + } + + default { + break + } + } + } + + switch -- $state(lastC) { + LX_LBRACKET { + return [addr_routeaddr $token] + } + + LX_COLON { + return [addr_group $token] + } + + LX_DOT { + append state(phrase) $state(buffer) + return [addr_phrase $token] + } + + default { + return -code 7 [ + format "found phrase instead of mailbox (%s%s)" \ + $state(phrase) $state(buffer)] + } + } +} + +# ::mime::addr_group -- +# +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns nothing if successful, and throws an error if invalid +# syntax is found. + +proc ::mime::addr_group {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + if {[incr state(glevel)] > 1} { + return -code 7 [ + format "nested groups not allowed (found %s)" $state(phrase)] + } + + set state(group) $state(phrase) + unset state(phrase) + + set lookahead $state(input) + while 1 { + switch -- [parselexeme $token] { + LX_SEMICOLON + - + LX_END { + set state(glevel) 0 + return 1 + } + + LX_COMMA { + } + + default { + set state(input) $lookahead + return [addr_specification $token] + } + } + } +} + +# ::mime::addr_end -- +# +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns nothing if successful, and throws an error if invalid +# syntax is found. + +proc ::mime::addr_end {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + switch -- $state(lastC) { + LX_SEMICOLON { + if {[incr state(glevel) -1] < 0} { + return -code 7 "extraneous semi-colon" + } + } + + LX_COMMA + - + LX_END { + } + + default { + return -code 7 [ + format "junk after local@domain (found %s)" $state(buffer)] + } + } +} + +# ::mime::addr_x400 -- +# +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns nothing if successful, and throws an error if invalid +# syntax is found. + +proc ::mime::addr_x400 {mbox key} { + if {[set x [string first /$key= [string toupper $mbox]]] < 0} { + return {} + } + set mbox [string range $mbox [expr {$x + [string length $key] + 2}] end] + + if {[set x [string first / $mbox]] > 0} { + set mbox [string range $mbox 0 [expr {$x - 1}]] + } + + return [string trim $mbox \"] +} + +# ::mime::parsedatetime -- +# +# Fortunately the clock command in the Tcl 8.x core does all the heavy +# lifting for us (except for timezone calculations). +# +# mime::parsedatetime takes a string containing an 822-style date-time +# specification and returns the specified property. +# +# The list of properties and their ranges are: +# +# property range +# ======== ===== +# clock raw result of "clock scan" +# hour 0 .. 23 +# lmonth January, February, ..., December +# lweekday Sunday, Monday, ... Saturday +# mday 1 .. 31 +# min 0 .. 59 +# mon 1 .. 12 +# month Jan, Feb, ..., Dec +# proper 822-style date-time specification +# rclock elapsed seconds between then and now +# sec 0 .. 59 +# wday 0 .. 6 (Sun .. Mon) +# weekday Sun, Mon, ..., Sat +# yday 1 .. 366 +# year 1900 ... +# zone -720 .. 720 (minutes east of GMT) +# +# Arguments: +# value Either a 822-style date-time specification or '-now' +# if the current date/time should be used. +# property The property (from the list above) to return +# +# Results: +# Returns the string value of the 'property' for the date/time that was +# specified in 'value'. + +namespace eval ::mime { + variable WDAYS_SHORT [list Sun Mon Tue Wed Thu Fri Sat] + variable WDAYS_LONG [list Sunday Monday Tuesday Wednesday Thursday \ + Friday Saturday] + + # Counting months starts at 1, so just insert a dummy element + # at index 0. + variable MONTHS_SHORT [list {} \ + Jan Feb Mar Apr May Jun \ + Jul Aug Sep Oct Nov Dec] + variable MONTHS_LONG [list {} \ + January February March April May June July \ + August Sepember October November December] +} +proc ::mime::parsedatetime {value property} { + if {$value eq "-now"} { + set clock [clock seconds] + } elseif {[regexp {^(.*) ([+-])([0-9][0-9])([0-9][0-9])$} $value \ + -> value zone_sign zone_hour zone_min] + } { + set clock [clock scan $value -gmt 1] + if {[info exists zone_min]} { + set zone_min [scan $zone_min %d] + set zone_hour [scan $zone_hour %d] + set zone [expr {60 * ($zone_min + 60 * $zone_hour)}] + if {$zone_sign eq "+"} { + set zone -$zone + } + incr clock $zone + } + } else { + set clock [clock scan $value] + } + + switch -- $property { + clock { + return $clock + } + + hour { + set value [clock format $clock -format %H] + } + + lmonth { + variable MONTHS_LONG + return [lindex $MONTHS_LONG \ + [scan [clock format $clock -format %m] %d]] + } + + lweekday { + variable WDAYS_LONG + return [lindex $WDAYS_LONG [clock format $clock -format %w]] + } + + mday { + set value [clock format $clock -format %d] + } + + min { + set value [clock format $clock -format %M] + } + + mon { + set value [clock format $clock -format %m] + } + + month { + variable MONTHS_SHORT + return [lindex $MONTHS_SHORT [ + scan [clock format $clock -format %m] %d]] + } + + proper { + set gmt [clock format $clock -format "%Y-%m-%d %H:%M:%S" -gmt true] + if {[set diff [expr {($clock-[clock scan $gmt]) / 60}]] < 0} { + set s - + set diff [expr {-($diff)}] + } else { + set s + + } + set zone [format %s%02d%02d $s [ + expr {$diff / 60}] [expr {$diff % 60}]] + + variable WDAYS_SHORT + set wday [lindex $WDAYS_SHORT [clock format $clock -format %w]] + variable MONTHS_SHORT + set mon [lindex $MONTHS_SHORT [ + scan [clock format $clock -format %m] %d]] + + return [ + clock format $clock -format "$wday, %d $mon %Y %H:%M:%S $zone"] + } + + rclock { + #TODO: these paths are not covered by tests + if {$value eq "-now"} { + return 0 + } else { + return [expr {[clock seconds] - $clock}] + } + } + + sec { + set value [clock format $clock -format %S] + } + + wday { + return [clock format $clock -format %w] + } + + weekday { + variable WDAYS_SHORT + return [lindex $WDAYS_SHORT [clock format $clock -format %w]] + } + + yday { + set value [clock format $clock -format %j] + } + + year { + set value [clock format $clock -format %Y] + } + + zone { + set value [string trim [string map [list \t { }] $value]] + if {[set x [string last { } $value]] < 0} { + return 0 + } + set value [string range $value [expr {$x + 1}] end] + switch -- [set s [string index $value 0]] { + + - - { + if {$s eq "+"} { + #TODO: This path is not covered by tests + set s {} + } + set value [string trim [string range $value 1 end]] + if {( + [string length $value] != 4) + || + [scan $value %2d%2d h m] != 2 + || + $h > 12 + || + $m > 59 + || + ($h == 12 && $m > 0) + } { + error "malformed timezone-specification: $value" + } + set value $s[expr {$h * 60 + $m}] + } + + default { + set value [string toupper $value] + set z1 [list UT GMT EST EDT CST CDT MST MDT PST PDT] + set z2 [list 0 0 -5 -4 -6 -5 -7 -6 -8 -7] + if {[set x [lsearch -exact $z1 $value]] < 0} { + error "unrecognized timezone-mnemonic: $value" + } + set value [expr {[lindex $z2 $x] * 60}] + } + } + } + + date2gmt + - + date2local + - + dst + - + sday + - + szone + - + tzone + - + default { + error "unknown property $property" + } + } + + if {[set value [string trimleft $value 0]] eq {}} { + #TODO: this path is not covered by tests + set value 0 + } + return $value +} + +# ::mime::uniqueID -- +# +# Used to generate a 'globally unique identifier' for the content-id. +# The id is built from the pid, the current time, the hostname, and +# a counter that is incremented each time a message is sent. +# +# Arguments: +# +# Results: +# Returns the a string that contains the globally unique identifier +# that should be used for the Content-ID of an e-mail message. + +proc ::mime::uniqueID {} { + variable mime + + return <[pid].[clock seconds].[incr mime(cid)]@[info hostname]> +} + +# ::mime::parselexeme -- +# +# Used to implement a lookahead parser. +# +# Arguments: +# token The MIME token to operate on. +# +# Results: +# Returns the next token found by the parser. + +proc ::mime::parselexeme {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + set state(input) [string trimleft $state(input)] + + set state(buffer) {} + if {$state(input) eq {}} { + set state(buffer) end-of-input + return [set state(lastC) LX_END] + } + + set c [string index $state(input) 0] + set state(input) [string range $state(input) 1 end] + + if {$c eq "("} { + set noteP 0 + set quoteP 0 + + while 1 { + append state(buffer) $c + + #TODO: some of these paths are not covered by tests + switch -- $c/$quoteP { + (/0 { + incr noteP + } + + \\/0 { + set quoteP 1 + } + + )/0 { + if {[incr noteP -1] < 1} { + if {[info exists state(comment)]} { + append state(comment) { } + } + append state(comment) $state(buffer) + + return [parselexeme $token] + } + } + + default { + set quoteP 0 + } + } + + if {[set c [string index $state(input) 0]] eq {}} { + set state(buffer) "end-of-input during comment" + return [set state(lastC) LX_ERR] + } + set state(input) [string range $state(input) 1 end] + } + } + + if {$c eq "\""} { + set firstP 1 + set quoteP 0 + + while 1 { + append state(buffer) $c + + switch -- $c/$quoteP { + "\\/0" { + set quoteP 1 + } + + "\"/0" { + if {!$firstP} { + return [set state(lastC) LX_QSTRING] + } + set firstP 0 + } + + default { + set quoteP 0 + } + } + + if {[set c [string index $state(input) 0]] eq {}} { + set state(buffer) "end-of-input during quoted-string" + return [set state(lastC) LX_ERR] + } + set state(input) [string range $state(input) 1 end] + } + } + + if {$c eq {[}} { + set quoteP 0 + + while 1 { + append state(buffer) $c + + switch -- $c/$quoteP { + \\/0 { + set quoteP 1 + } + + ]/0 { + return [set state(lastC) LX_DLITERAL] + } + + default { + set quoteP 0 + } + } + + if {[set c [string index $state(input) 0]] eq {}} { + set state(buffer) "end-of-input during domain-literal" + return [set state(lastC) LX_ERR] + } + set state(input) [string range $state(input) 1 end] + } + } + + if {[set x [lsearch -exact $state(tokenL) $c]] >= 0} { + append state(buffer) $c + + return [set state(lastC) [lindex $state(lexemeL) $x]] + } + + while 1 { + append state(buffer) $c + + switch -- [set c [string index $state(input) 0]] { + {} - " " - "\t" - "\n" { + break + } + + default { + if {[lsearch -exact $state(tokenL) $c] >= 0} { + break + } + } + } + + set state(input) [string range $state(input) 1 end] + } + + return [set state(lastC) LX_ATOM] +} + +# ::mime::mapencoding -- +# +# mime::mapencodings maps tcl encodings onto the proper names for their +# MIME charset type. This is only done for encodings whose charset types +# were known. The remaining encodings return {} for now. +# +# Arguments: +# enc The tcl encoding to map. +# +# Results: +# Returns the MIME charset type for the specified tcl encoding, or {} +# if none is known. + +proc ::mime::mapencoding {enc} { + + variable encodings + + if {[info exists encodings($enc)]} { + return $encodings($enc) + } + return {} +} + +# ::mime::reversemapencoding -- +# +# mime::reversemapencodings maps MIME charset types onto tcl encoding names. +# Those that are unknown return {}. +# +# Arguments: +# mimeType The MIME charset to convert into a tcl encoding type. +# +# Results: +# Returns the tcl encoding name for the specified mime charset, or {} +# if none is known. + +proc ::mime::reversemapencoding {mimeType} { + + variable reversemap + + set lmimeType [string tolower $mimeType] + if {[info exists reversemap($lmimeType)]} { + return $reversemap($lmimeType) + } + return {} +} + +# ::mime::word_encode -- +# +# Word encodes strings as per RFC 2047. +# +# Arguments: +# charset The character set to encode the message to. +# method The encoding method (base64 or quoted-printable). +# string The string to encode. +# ?-charset_encoded 0 or 1 Whether the data is already encoded +# in the specified charset (default 1) +# ?-maxlength maxlength The maximum length of each encoded +# word to return (default 66) +# +# Results: +# Returns a word encoded string. + +proc ::mime::word_encode {charset method string {args}} { + + variable encodings + + if {![info exists encodings($charset)]} { + error "unknown charset '$charset'" + } + + if {$encodings($charset) eq {}} { + error "invalid charset '$charset'" + } + + if {$method ne "base64" && $method ne "quoted-printable"} { + error "unknown method '$method', must be base64 or quoted-printable" + } + + # default to encoded and a length that won't make the Subject header to long + array set options [list -charset_encoded 1 -maxlength 66] + array set options $args + + if {$options(-charset_encoded)} { + set unencoded_string [::encoding convertfrom $charset $string] + } else { + set unencoded_string $string + } + + set string_length [string length $unencoded_string] + + if {!$string_length} { + return {} + } + + set string_bytelength [string bytelength $unencoded_string] + + # the 7 is for =?, ?Q?, ?= delimiters of the encoded word + set maxlength [expr {$options(-maxlength) - [string length $encodings($charset)] - 7}] + switch -exact -- $method { + base64 { + if {$maxlength < 4} { + error "maxlength $options(-maxlength) too short for chosen charset and encoding" + } + set count 0 + set maxlength [expr {($maxlength / 4) * 3}] + while {$count < $string_length} { + set length 0 + set enc_string {} + while {$length < $maxlength && $count < $string_length} { + set char [string range $unencoded_string $count $count] + set enc_char [::encoding convertto $charset $char] + if {$length + [string length $enc_char] > $maxlength} { + set length $maxlength + } else { + append enc_string $enc_char + incr count + incr length [string length $enc_char] + } + } + set encoded_word [string map [ + list \n {}] [base64 -mode encode -- $enc_string]] + append result "=?$encodings($charset)?B?$encoded_word?=\n " + } + # Trim off last "\n ", since the above code has the side-effect + # of adding an extra "\n " to the encoded string. + + set result [string range $result 0 end-2] + } + quoted-printable { + if {$maxlength < 1} { + error "maxlength $options(-maxlength) too short for chosen charset and encoding" + } + set count 0 + while {$count < $string_length} { + set length 0 + set encoded_word {} + while {$length < $maxlength && $count < $string_length} { + set char [string range $unencoded_string $count $count] + set enc_char [::encoding convertto $charset $char] + set qp_enc_char [qp_encode $enc_char 1] + set qp_enc_char_length [string length $qp_enc_char] + if {$qp_enc_char_length > $maxlength} { + error "maxlength $options(-maxlength) too short for chosen charset and encoding" + } + if { + $length + [string length $qp_enc_char] > $maxlength + } { + set length $maxlength + } else { + append encoded_word $qp_enc_char + incr count + incr length [string length $qp_enc_char] + } + } + append result "=?$encodings($charset)?Q?$encoded_word?=\n " + } + # Trim off last "\n ", since the above code has the side-effect + # of adding an extra "\n " to the encoded string. + + set result [string range $result 0 end-2] + } + {} { + # Go ahead + } + default { + error "Can't handle content encoding \"$method\"" + } + } + return $result +} + +# ::mime::word_decode -- +# +# Word decodes strings that have been word encoded as per RFC 2047. +# +# Arguments: +# encoded The word encoded string to decode. +# +# Results: +# Returns the string that has been decoded from the encoded message. + +proc ::mime::word_decode {encoded} { + + variable reversemap + + if {[regexp -- {=\?([^?]+)\?(.)\?([^?]*)\?=} $encoded \ + - charset method string] != 1 + } { + error "malformed word-encoded expression '$encoded'" + } + + set enc [reversemapencoding $charset] + if {$enc eq {}} { + error "unknown charset '$charset'" + } + + switch -exact -- $method { + b - + B { + set method base64 + } + q - + Q { + set method quoted-printable + } + default { + error "unknown method '$method', must be B or Q" + } + } + + switch -exact -- $method { + base64 { + set result [base64 -mode decode -- $string] + } + quoted-printable { + set result [qp_decode $string 1] + } + {} { + # Go ahead + } + default { + error "Can't handle content encoding \"$method\"" + } + } + + return [list $enc $method $result] +} + +# ::mime::field_decode -- +# +# Word decodes strings that have been word encoded as per RFC 2047 +# and converts the string from the original encoding/charset to UTF. +# +# Arguments: +# field The string to decode +# +# Results: +# Returns the decoded string in UTF. + +proc ::mime::field_decode {field} { + # ::mime::field_decode is broken. Here's a new version. + # This code is in the public domain. Don Libes + + # Step through a field for mime-encoded words, building a new + # version with unencoded equivalents. + + # Sorry about the grotesque regexp. Most of it is sensible. One + # notable fudge: the final $ is needed because of an apparent bug + # in the regexp engine where the preceding .* otherwise becomes + # non-greedy - perhaps because of the earlier ".*?", sigh. + + while {[regexp {(.*?)(=\?(?:[^?]+)\?(?:.)\?(?:[^?]*)\?=)(.*)$} $field \ + ignore prefix encoded field] + } { + # don't allow whitespace between encoded words per RFC 2047 + if {{} ne $prefix} { + if {![string is space $prefix]} { + append result $prefix + } + } + + set decoded [word_decode $encoded] + foreach {charset - string} $decoded break + + append result [::encoding convertfrom $charset $string] + } + append result $field + return $result +} + +## One-Shot Initialization + +::apply {{} { + variable encList + variable encAliasList + variable reversemap + + foreach {enc mimeType} $encList { + if {$mimeType eq {}} continue + set reversemap([string tolower $mimeType]) $enc + } + + foreach {enc mimeType} $encAliasList { + set reversemap([string tolower $mimeType]) $enc + } + + # Drop the helper variables + unset encList encAliasList + +} ::mime} + + +variable ::mime::internal 0 diff --git a/src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/cap-0.1.0.tm b/src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/cap-0.1.0.tm index 34bed4c..4cc6f30 100644 --- a/src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/cap-0.1.0.tm +++ b/src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/cap-0.1.0.tm @@ -14,20 +14,36 @@ # @@ Meta End +#*** !doctools +#[manpage_begin punk::cap 0 0.1.0] +#[copyright "2023 JMNoble - BSD licensed"] +#[titledesc {Module API}] +#[moddesc {punk capabilities plugin system}] +#[require punk::cap] +#[description] +#[list_begin definitions] # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Requirements ##e.g package require frobz +package require oolib + -#concepts: -# A capability may be something like providing a folder of files, or just a data dictionary, and/or an API -# -# capability handler - a package/namespace which may provide validation and standardised ways of looking up provider data -# registered (or not) using register_capabilityname -# capability provider - a package which registers as providing one or more capablities. -# registered using register_package -# the capabilitylist is a list of 2-element lists where the first element is the capabilityname and the second element is a (possibly empty) dict of data relevant to that capability -# A capabilityname may appear multiple times. ie a package may register that it provides the capability with multiple datasets. + +# mkdoc markdown +#' --- +#' author: JMNoble +#' --- +#' ## Concepts: +#' > A **capability** may be something like providing a folder of files, or just a data dictionary, and/or an API +#' +#' > **capability handler** - a package/namespace which may provide validation and standardised ways of looking up provider data +#' registered (or not) using register_capabilityname +#' +#' > **capability provider** - a package which registers as providing one or more capablities. +#' registered using register_package +#' the capabilitylist is a list of 2-element lists where the first element is the capabilityname and the second element is a (possibly empty) dict of data relevant to that capability +#' A capabilityname may appear multiple times. ie a package may register that it provides the capability with multiple datasets. # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ @@ -35,32 +51,99 @@ namespace eval punk::cap { variable pkgcapsdeclared [dict create] variable pkgcapsaccepted [dict create] variable caps [dict create] - if {[info commands [namespace current]::interface_caphandler.registry] eq ""} { - oo::class create [namespace current]::interface_caphandler.registry { - method pkg_register {pkg capname capdict fullcapabilitylist} { - #handler may override and return 0 (indicating don't register)e.g if pkg capdict data wasn't valid - #overridden handler must be able to handle multiple calls for same pkg - but it may return 1 or 0 as it wishes. - return 1 ;#default to permit - } - method pkg_unregister {pkg} { - return ;#unregistration return is ignored - review + + namespace eval class { + if {[info commands [namespace current]::interface_caphandler.registry] eq ""} { + #Handler classes + oo::class create [namespace current]::interface_caphandler.registry { + method pkg_register {pkg capname capdict fullcapabilitylist} { + #*** + #[call [class interface_caphandler.registry] [method pkg_register] [arg pkg] [arg capname] [arg capdict] [arg fullcapabilitylist]] + #handler may override and return 0 (indicating don't register)e.g if pkg capdict data wasn't valid + #overridden handler must be able to handle multiple calls for same pkg - but it may return 1 or 0 as it wishes. + return 1 ;#default to permit + } + method pkg_unregister {pkg} { + #*** + #[call [class interface_caphandler.registry] [method pkg_unregister] [arg pkg]] + return ;#unregistration return is ignored - review + } } - } + oo::class create [namespace current]::interface_caphandler.sysapi { - oo::class create [namespace current]::interface_capprovider.registration { - method get_declarations {} { - error "interface_capprovider.registration not implemented by provider" } - } - oo::class create [namespace current]::interface_capprovider.provider { - method register {{capabilityname_glob *}} { + + #Provider classes + oo::class create [namespace current]::interface_capprovider.registration { + method get_declarations {} { + #*** + #[call [class interface_capprovider.registration] [method pkg_unregister] [arg pkg]] + error "interface_capprovider.registration not implemented by provider" + } } - method capabilities {} { + oo::class create [namespace current]::interface_capprovider.provider { + variable provider_pkg + variable registrationobj + constructor {providerpkg} { + variable provider_pkg + if {$providerpkg in [list "" "::"]} { + error "interface_capprovider.provider constructor error. Invalid provider '$providerpkg'" + } + if {![namespace exists ::$providerpkg]} { + error "interface_capprovider.provider constructor error. Invalid provider '$providerpkg' - matching namespace not found" + } + + set registrationobj ::${providerpkg}::capsystem::capprovider.registration + if {[info commands $registrationobj] eq ""} { + error "capprovider.provider constructor error. Missing capprovider.registration interface at '$obj' (command not found) interface_capprovider.regstration instantiation must precede interface_capprovider.provider" + } + + set provider_pkg [string trim $providerpkg ""] + } + method register {{capabilityname_glob *}} { + #*** + #[call [class interface_capprovider.provider] [method register] [opt capabilityname_glob]] + variable provider_pkg + set all_decls [$registrationobj get_declarations] + set register_decls [lsearch -all -inline -index 0 $all_decls $capabilityname_glob] + punk::cap::register_package $provider_pkg $register_decls + } + method capabilities {} { + #*** + #[call [class interface_capprovider.provider] [method capabilities]] + variable provider_pkg + variable registrationobj + + set capabilities [list] + set decls [$registrationobj get_declarations] + foreach decl $decls { + lassign $decl capname capdict + if {$capname ni $capabilities} { + lappend capabilities $capname + } + } + return $capname + } } } + } ;# end namespace class + namespace eval capsystem { + proc get_caphandler_registry {capname} { + set ns [::punk::cap::get_handler $capname]::capsystem + if {[namespace exists ${ns}]} { + if {[info command ${ns}::caphandler.registry] ne ""} { + if {[info object isa object ${ns}::caphandler.registry]} { + return ${ns}::caphandler.registry + } + } + } + return "" + } } + + #Not all capabilities have to be registered. #A package registering as a provider using register_package can include capabilitynames in it's capabilitylist which have no associated capnamespace (handler). #such unregistered capabilitynames may be used just to flag something, or have datamembers significant to callers cooperatively interested in that capname. @@ -88,7 +171,7 @@ namespace eval punk::cap { } if {[llength [set providers [dict get $caps $capname providers]]]} { #some provider(s) were in place before the handler was registered - if {[set capreg [get_caphandler_registry $capname]] ne ""} { + if {[set capreg [punk::cap::capsystem::get_caphandler_registry $capname]] ne ""} { foreach pkg $providers { set fullcapabilitylist [dict get $pkgcapsdeclared $pkg] foreach capspec $fullcapabilitylist { @@ -131,10 +214,31 @@ namespace eval punk::cap { } } proc exists {capname} { + #*** !doctools + # [call [fun exists] [arg capname]] + # Return a boolean indicating if the named capability exists (0|1) + + # mkdoc markdown + #' + #' ## **exists(capname)** + #' + #' > return a boolean indicating the existence of a capability + #' + #' > Arguments: + #' + #' > - *capname* - string indicating the name of the capability + #' + #' > Returns: 0|1 + #' variable caps return [dict exists $caps $capname] } proc has_handler {capname} { + #*** !doctools + # [call [fun has_handler] [arg capname]] + # Return a boolean indicating if the named capability has a handler package installed (0|1) + + variable caps return [expr {[dict exists $caps $capname handler] && [dict get $caps $capname handler] ne ""}] } @@ -157,20 +261,9 @@ namespace eval punk::cap { if {[set handler [get_handler $capname]] eq ""} { error "punk::cap::call_handler $capname $args - no handler registered for capability $capname" } - set obj ${handler}::$capname + set obj ${handler}::api_$capname $obj [lindex $args 0] {*}[lrange $args 1 end] } - proc get_caphandler_registry {capname} { - set ns [get_handler $capname]::capsystem - if {[namespace exists ${ns}]} { - if {[info command ${ns}::caphandler.registry] ne ""} { - if {[info object isa object ${ns}::caphandler.registry]} { - return ${ns}::caphandler.registry - } - } - } - return "" - } proc get_providers {capname} { variable caps if {[dict exists $caps $capname]} { @@ -188,6 +281,11 @@ namespace eval punk::cap { if {[string match ::* $pkg]} { set pkg [string range $pkg 2 end] } + if {[dict exists $pkgcapsaccepted $pkg]} { + set pkg_already_accepted [dict get $pkgcapsaccepted $pkg] + } else { + set pkg_already_accepted [list] + } #for each capability # - ensure 1st element is a single word # - ensure that if 2nd element (capdict) is present - it is dict shaped @@ -199,6 +297,11 @@ namespace eval punk::cap { if {[expr {[llength $capdict] %2 != 0}]} { error "register_package error. pkg:'$pkg' The second element for capname:'$capname' doesn't appear to be a valid dict. Problematic entry: '$capspec'" } + if {$capspec in $pkg_already_accepted} { + #review - multiple handlers? if so - will need to record which handler(s) accepted the capspec + puts stderr "register_package pkg $pkg already has capspec marked as accepted: $capspec" + continue + } if {[dict exists $caps $capname]} { set cap_pkgs [dict get $caps $capname providers] } else { @@ -207,7 +310,7 @@ namespace eval punk::cap { } #todo - if there's a caphandler - call it's init/validation callback for the pkg set do_register 1 ;#default assumption unless vetoed by handler - if {[set capreg [get_caphandler_registry $capname]] ne ""} { + if {[set capreg [punk::cap::capsystem::get_caphandler_registry $capname]] ne ""} { #Note that the interface_caphandler.registry instance must be able to handle multiple calls for same pkg set do_register [$capreg pkg_register $pkg $capname $capdict $capabilitylist] } @@ -219,17 +322,23 @@ namespace eval punk::cap { dict lappend pkgcapsaccepted $pkg $capspec ;#if pkg is being registered prior to handler-registration - the handler may undo this entry } } - #another call to register_pkg with same pkg may have been made (most likely with different capname) so we must append + #another call to register_pkg with same pkg may have been made (most likely with different capname) so we must append - but check not already present #dict lappend pkgcapsdeclared $pkg $capabilitylist if {[dict exists $pkgcapsdeclared $pkg]} { - set caps [dict get $pkgcapsdeclared $pkg] - lappend caps {*}$capabilitylist - dict set pkgcapsdeclared $pkg $caps + set capspecs [dict get $pkgcapsdeclared $pkg] + foreach spec $capspecs { + if {$spec ni $capspecs} { + lappend capspecs $spec + } + } + dict set pkgcapsdeclared $pkg $capspecs } else { dict set pkgcapsdeclared $pkg $capabilitylist } } - proc unregister_package {pkg} { + + #todo! + proc unregister_package {pkg {capname *}} { variable pkgcapsdeclared variable caps if {[string match ::* $pkg]} { @@ -245,13 +354,13 @@ namespace eval punk::cap { set pkglist [dict get $cap_info providers] set posn [lsearch $pkglist $pkg] if {$posn >= 0} { - if {[set capreg [get_caphandler_registry $capname]] ne ""} { + if {[set capreg [punk::cap::capsystem::get_caphandler_registry $capname]] ne ""} { #review # it seems not useful to allow the callback to block this unregister action #the pkg may have multiple datasets for each capname so callback will only be called for first dataset we encounter #vetoing unregister would make this more complex for no particular advantage - #if per capability deregistration required this should probably be a separate thing (e.g disable_capability?) - $capreg pkg_unregister $pkg + #if per dataset deregistration required this should probably be a separate thing + $capreg pkg_unregister $pkg $capname } set pkglist [lreplace $pkglist $posn $posn] dict set caps $capname providers $pkglist @@ -398,21 +507,22 @@ namespace eval punk::cap { - - - - - - - - - - - # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::cap [namespace eval punk::cap { variable version + variable pkg punk::cap set version 0.1.0 + variable README.md [string map [list %pkg% $pkg %ver% $version] { + # punk capabilities system + ## pkg: %pkg% version: %ver% + + punk::cap base namespace + }] + return $version }] -return \ No newline at end of file +return + +#*** !doctools +#[list_end] +#[manpage_end] diff --git a/src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/cap/handlers/templates-0.1.0.tm b/src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/cap/handlers/templates-0.1.0.tm index 28a25e6..75a925d 100644 --- a/src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/cap/handlers/templates-0.1.0.tm +++ b/src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/cap/handlers/templates-0.1.0.tm @@ -35,10 +35,14 @@ namespace eval punk::cap::handlers::templates { namespace eval capsystem { #interfaces for punk::cap to call into if {[info commands caphandler.registry] eq ""} { - punk::cap::interface_caphandler.registry create caphandler.registry + punk::cap::class::interface_caphandler.registry create caphandler.registry oo::objdefine caphandler.registry { method pkg_register {pkg capname capdict caplist} { #caplist may not be complete set - which somewhat reduces its utility here regarding any decisions based on the context of this capname/capdict (review - remove this arg?) + + # -- --- --- --- --- --- --- ---- --- + # validation of capdict + # -- --- --- --- --- --- --- ---- --- if {![dict exists $capdict relpath]} { puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of '$capname' capability, but is missing 'relpath' key" return 0 @@ -52,16 +56,28 @@ namespace eval punk::cap::handlers::templates { set tpath [file normalize [file join $tmfile [dict get $capdict relpath]]] ;#relpath is relative to the tm *file* - not it's containing folder if {![file isdirectory $tpath]} { puts stderr "punk::cap::handlers::templates::capsystem pkg_register WARNING - unable to validate relpath location [dict get $capdict relpath] ($tpath) for package '$pkg' which is attempting to register with punk::cap as a provider of '$capname' capability" + return 0 } + + + # -- --- --- --- --- --- --- ---- --- + # update package internal data + # -- --- --- --- --- --- --- ---- --- if {$capname ni $::punk::cap::handlers::templates::handled_caps} { lappend ::punk::cap::handlers::templates::handled_caps $capname } - if {[info commands punk::cap::handlers::templates::$capname] eq ""} { - punk::cap::handlers::templates::api create ::punk::cap::handlers::templates::$capname $capname - } set cname [string map [list . _] $capname] upvar ::punk::cap::handlers::templates::pkg_folders_$cname pfolders dict lappend pfolders $pkg $tpath + + + # -- --- --- --- --- --- --- ---- --- + # instantiation of api at punk::cap::handlers::templates::api_$capname + # -- --- --- --- --- --- --- ---- --- + if {[info commands ::punk::cap::handlers::templates::$capname] eq ""} { + punk::cap::handlers::templates::class::api create ::punk::cap::handlers::templates::api_$capname $capname + } + return 1 } method pkg_unregister {pkg} { @@ -84,36 +100,38 @@ namespace eval punk::cap::handlers::templates { #handler api for clients of this capability - called via punk::cap::call_handler ?args? # -- --- --- --- --- --- --- namespace export * - - oo::class create api { - #return a dict keyed on folder with source pkg as value - constructor {capname} { - variable capabilityname - variable cname - set cname [string map [list . _] $capname] - set capabilityname $capname - } - method folders {} { - variable capabilityname - variable cname - upvar punk::cap::handlers::templates::pkg_folders_$cname pkg_folders - package require punk::cap - set capinfo [punk::cap::capability $capabilityname] - # e.g {punk.templates {handler punk::mix::templates providers ::somepkg}} - - #use the order of pkgs as registered with punk::cap - may have been modified with punk::cap::promote_package/demote_package - set pkgs [dict get $capinfo providers] - set folderdict [dict create] - foreach pkg $pkgs { - foreach pfolder [dict get $pkg_folders $pkg] { - dict set folderdict $pfolder [list source $pkg sourcetype package] + namespace eval class { + oo::class create api { + #return a dict keyed on folder with source pkg as value + constructor {capname} { + variable capabilityname + variable cname + set cname [string map [list . _] $capname] + set capabilityname $capname + } + method folders {} { + variable capabilityname + variable cname + upvar punk::cap::handlers::templates::pkg_folders_$cname pkg_folders + package require punk::cap + set capinfo [punk::cap::capability $capabilityname] + # e.g {punk.templates {handler punk::mix::templates providers ::somepkg}} + + #use the order of pkgs as registered with punk::cap - may have been modified with punk::cap::promote_package/demote_package + set pkgs [dict get $capinfo providers] + set folderdict [dict create] + foreach pkg $pkgs { + foreach pfolder [dict get $pkg_folders $pkg] { + dict set folderdict $pfolder [list source $pkg sourcetype package] + } } + return $folderdict } - return $folderdict } } + } diff --git a/src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/mix-0.2.tm b/src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/mix-0.2.tm index d09dfca..482c79a 100644 --- a/src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/mix-0.2.tm +++ b/src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/mix-0.2.tm @@ -5,7 +5,7 @@ package require punk::cap::handlers::templates ;#handler for templates cap punk::cap::register_capabilityname punk.templates ::punk::cap::handlers::templates package require punk::mix::templates ;#registers as provider pkg for 'punk.templates' capability with punk::cap -#punk::mix::templates::provider register * +punk::mix::templates::provider register * package require punk::mix::base package require punk::mix::cli diff --git a/src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/mix/cli-0.3.tm b/src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/mix/cli-0.3.tm index 6967226..790cfc6 100644 --- a/src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/mix/cli-0.3.tm +++ b/src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/mix/cli-0.3.tm @@ -170,7 +170,8 @@ namespace eval punk::mix::cli { } cd $sourcefolder #use run so that stdout visible as it goes - if {![catch {run --timeout=5000 -debug [info nameofexecutable] $sourcefolder/make.tcl {*}$args} exitinfo]} { + if {![catch {run --timeout=55000 -debug [info nameofexecutable] $sourcefolder/make.tcl {*}$args} exitinfo]} { + #todo - notify if exit because of timeout! puts stderr "exitinfo: $exitinfo" set exitcode [dict get $exitinfo exitcode] } else { diff --git a/src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/mix/commandset/doc-0.1.0.tm b/src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/mix/commandset/doc-0.1.0.tm index 6184a38..0b7c292 100644 --- a/src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/mix/commandset/doc-0.1.0.tm +++ b/src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/mix/commandset/doc-0.1.0.tm @@ -18,7 +18,11 @@ ## Requirements ##e.g package require frobz - +package require punk ;# for treefilenames +package require punk::repo +package require punk::docgen ;#inline doctools - generate doctools .man files at src/docgen prior to using kettle to producing .html .md etc +package require punk::mix::cli ;#punk::mix::cli::lib used for kettle_call +package require punk::mix::util ;#for path_relative # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ @@ -38,6 +42,30 @@ namespace eval punk::mix::commandset::doc { puts stderr "No current project dir - unable to build docs" return } + #user may delete the comment containing "--- punk::docgen::overwrites" and then manually edit, and we won't overwrite + #we still generate output in src/docgen so user can diff and manually update if thats what they prefer + set oldfiles [glob -nocomplain -dir $projectdir/src/doc -type f _module_*] + foreach maybedoomed $oldfiles { + set fd [open $maybedoomed r] + set data [read $fd] + close $fd + if {[string match "*--- punk::docgen overwrites *" $data]} { + file delete -force $maybedoomed + } + } + set generated [lib::do_docgen modules] + if {[dict get $generated count] > 0} { + #review + set doclist [dict get $generated docs] + foreach dinfo $doclist { + lassign $dinfo module fpath + set target $projectdir/src/doc/_module_[file tail $fpath] + if {![file exists $target]} { + file copy $fpath $target + } + } + } + if {[file exists $projectdir/src/doc]} { set original_wd [pwd] cd $projectdir/src @@ -125,6 +153,7 @@ namespace eval punk::mix::commandset::doc { cd $original_wd } proc validate {} { + #todo - run and validate punk::docgen output set projectdir [punk::repo::find_project] if {$projectdir eq ""} { puts stderr "No current project dir - unable to check doc status" @@ -154,6 +183,49 @@ namespace eval punk::mix::commandset::doc { namespace eval lib { variable pkg set pkg punk::mix::commandset::doc + proc do_docgen {{project_subpath modules}} { + set projectdir [punk::repo::find_project] + set outdir [file join $projectdir src docgen] + set subpath [file join $projectdir $project_subpath] + if {![file isdirectory $subpath]} { + puts stderr "WARNING punk::mix::commandset::doc unable to find subpath $subpath during do_docgen - skipping inline doctools generation" + return + } + if {[file isdirectory $outdir]} { + if {[catch { + file delete -force $outdir + }]} { + error "do_docgen failed to delete existing $outdir" + } + } + file mkdir $outdir + + set matched_paths [punk::treefilenames $subpath *.tm] + set count 0 + set newdocs [list] + set docgen_header_comments "" + append docgen_header_comments {[comment {--- punk::docgen generated from inline doctools comments ---}]} \n + append docgen_header_comments {[comment {--- punk::docgen DO NOT EDIT DOCS HERE UNLESS YOU REMOVE THESE COMMENT LINES ---}]} \n + append docgen_header_comments {[comment {--- punk::docgen overwrites this file ---}]} \n + foreach fullpath $matched_paths { + set relpath [punk::mix::util::path_relative $subpath $fullpath] + set tailsegs [file split $relpath] + set module_fullname [join $tailsegs ::] + set docname [string map [list :: _] $module_fullname].man ;#todo - something better - need to ensure unique + set doctools [punk::docgen::get_doctools_comments $fullpath] + if {$doctools ne ""} { + puts stdout "generating doctools output from file $relpath" + set outfile [file join $outdir $docname] + set fd [open $outfile w] + fconfigure $fd -translation binary + puts -nonewline $fd $docgen_header_comments$doctools + close $fd + incr count + lappend newdocs [list $module_fullname $outfile] + } + } + return [list count $count docs $newdocs] + } } } diff --git a/src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/mix/templates-0.1.0.tm b/src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/mix/templates-0.1.0.tm index 8d52517..46065bd 100644 --- a/src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/mix/templates-0.1.0.tm +++ b/src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/mix/templates-0.1.0.tm @@ -26,17 +26,19 @@ namespace eval punk::mix::templates { variable pkg punk::mix::templates variable cap_provider - punk::cap::register_package punk::mix::templates [list\ - {punk.templates {relpath ../templates}}\ - ] + #punk::cap::register_package punk::mix::templates [list\ + # {punk.templates {relpath ../templates}}\ + #] + namespace eval capsystem { if {[info commands capprovider.registration] eq ""} { - punk::cap::interface_capprovider.registration create capprovider.registration + punk::cap::class::interface_capprovider.registration create capprovider.registration oo::objdefine capprovider.registration { method get_declarations {} { set decls [list] - lappend decls punk.templates {relpath ../templates} - lappend decls punk.templates {relpath ../templates2} + lappend decls [list punk.templates {relpath ../templates}] + lappend decls [list punk.templates {relpath ../templates2}] + lappend decls [list punk.test {something blah}] return $decls } } @@ -44,7 +46,7 @@ namespace eval punk::mix::templates { } if {[info commands provider] eq ""} { - punk::cap::interface_capprovider.provider create provider + punk::cap::class::interface_capprovider.provider create provider punk::mix::templates oo::objdefine provider { method register {{capabilityname_glob *}} { #puts registering punk::mix::templates $capabilityname diff --git a/src/mixtemplates/layouts/basic/src/bootsupport/modules/punkcheck-0.1.0.tm b/src/mixtemplates/layouts/basic/src/bootsupport/modules/punkcheck-0.1.0.tm index 41d8759..0dc9523 100644 --- a/src/mixtemplates/layouts/basic/src/bootsupport/modules/punkcheck-0.1.0.tm +++ b/src/mixtemplates/layouts/basic/src/bootsupport/modules/punkcheck-0.1.0.tm @@ -1078,7 +1078,7 @@ namespace eval punkcheck { } proc install_non_tm_files {srcdir basedir args} { #set keys [dict keys $args] - #adjust the default anti_glob_dir_core entries so that .fossil-custom, .fossil-settings are copied + #adjust the default antiglob_dir_core entries so that .fossil-custom, .fossil-settings are copied set antiglob_dir_core [punkcheck::default_antiglob_dir_core] set posn [lsearch $antiglob_dir_core ".fossil*"] if {$posn >=0} { @@ -1168,7 +1168,7 @@ namespace eval punkcheck { -antiglob_file "" \ -antiglob_dir_core "\uFFFF"\ -antiglob_dir {}\ - -unpublish_paths {}\ + -antiglob_paths {}\ -overwrite no-targets\ -source_checksum comparestore\ -punkcheck_folder target\ @@ -1225,8 +1225,8 @@ namespace eval punkcheck { # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_antiglob_dir [dict get $opts -antiglob_dir] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- - set opt_unpublish_paths [dict get $opts -unpublish_paths] ;#todo - combine with config file in source tree .punkcheckpublish (?) - set unpublish_paths_matched [list] + set opt_antiglob_paths [dict get $opts -antiglob_paths] ;#todo - combine with config file in source tree .punkcheckpublish (?) + set antiglob_paths_matched [list] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set known_whats [list no-targets newer-targets older-targets all-targets installedsourcechanged-targets synced-targets] set overwrite_what [string tolower [dict get $opts -overwrite]]; #accept any case for value to allow emphasis by caller e.g -overwrite NEWER-TARGETS @@ -1347,11 +1347,11 @@ namespace eval punkcheck { if {$target_relative_to_punkcheck_dir eq "."} { set target_relative_to_punkcheck_dir "" } - foreach unpub $opt_unpublish_paths { + foreach unpub $opt_antiglob_paths { #puts "testing folder - globmatchpath $unpub $relative_source_dir" if {[globmatchpath $unpub $relative_source_dir]} { - lappend unpublish_paths_matched $current_source_dir - return [list files_copied {} files_skipped {} sources_unchanged {} punkcheck_records $punkcheck_records unpublish_paths_matched $unpublish_paths_matched srcdir $srcdir tgtdir $tgtdir punkcheck_folder $punkcheck_folder] + lappend antiglob_paths_matched $current_source_dir + return [list files_copied {} files_skipped {} sources_unchanged {} punkcheck_records $punkcheck_records antiglob_paths_matched $antiglob_paths_matched srcdir $srcdir tgtdir $tgtdir punkcheck_folder $punkcheck_folder] } } @@ -1418,16 +1418,16 @@ namespace eval punkcheck { set relative_target_path [file join $relative_target_dir $m] set relative_source_path [file join $relative_source_dir $m] set punkcheck_target_relpath [file join $target_relative_to_punkcheck_dir $m] - set is_unpublished 0 - foreach unpub $opt_unpublish_paths { - #puts "testing file - globmatchpath $unpub vs $relative_source_path" - if {[globmatchpath $unpub $relative_source_path]} { - lappend unpublish_paths_matched $current_source_dir - set is_unpublished 1 + set is_antipath 0 + foreach antipath $opt_antiglob_paths { + #puts "testing file - globmatchpath $antipath vs $relative_source_path" + if {[globmatchpath $antipath $relative_source_path]} { + lappend antiglob_paths_matched $current_source_dir + set is_antipath 1 break } } - if {$is_unpublished} { + if {$is_antipath} { continue } #puts stdout " checking file : $current_source_dir/$m" @@ -1642,7 +1642,7 @@ namespace eval punkcheck { lappend files_copied {*}[dict get $sub_result files_copied] lappend files_skipped {*}[dict get $sub_result files_skipped] lappend sources_unchanged {*}[dict get $sub_result sources_unchanged] - lappend unpublish_paths_matched {*}[dict get $sub_result unpublish_paths_matched] + lappend antiglob_paths_matched {*}[dict get $sub_result antiglob_paths_matched] set punkcheck_records [dict get $sub_result punkcheck_records] } @@ -1664,7 +1664,7 @@ namespace eval punkcheck { } } - return [list files_copied $files_copied files_skipped $files_skipped sources_unchanged $sources_unchanged unpublish_paths_matched $unpublish_paths_matched punkcheck_records $punkcheck_records punkcheck_folder $punkcheck_folder srcdir $srcdir tgtdir $tgtdir] + return [list files_copied $files_copied files_skipped $files_skipped sources_unchanged $sources_unchanged antiglob_paths_matched $antiglob_paths_matched punkcheck_records $punkcheck_records punkcheck_folder $punkcheck_folder srcdir $srcdir tgtdir $tgtdir] } proc summarize_install_resultdict {resultdict} { set msg "" diff --git a/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil-0.9.tm b/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil-0.9.tm new file mode 100644 index 0000000..5925851 --- /dev/null +++ b/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil-0.9.tm @@ -0,0 +1,80 @@ +# textutil.tcl -- +# +# Utilities for manipulating strings, words, single lines, +# paragraphs, ... +# +# Copyright (c) 2000 by Ajuba Solutions. +# Copyright (c) 2000 by Eric Melski +# Copyright (c) 2002 by Joe English +# Copyright (c) 2001-2006 by Andreas Kupries +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: textutil.tcl,v 1.17 2006/09/21 06:46:24 andreas_kupries Exp $ + +# ### ### ### ######### ######### ######### +## Requirements + +package require Tcl 8.2 + +namespace eval ::textutil {} + +# ### ### ### ######### ######### ######### +## API implementation +## All through sub-packages imported here. + +package require textutil::string +package require textutil::repeat +package require textutil::adjust +package require textutil::split +package require textutil::tabify +package require textutil::trim +package require textutil::wcswidth + +namespace eval ::textutil { + # Import the miscellaneous string command for public export + + namespace import -force string::chop string::tail + namespace import -force string::cap string::uncap string::capEachWord + namespace import -force string::longestCommonPrefix + namespace import -force string::longestCommonPrefixList + + # Import the repeat commands for public export + + namespace import -force repeat::strRepeat repeat::blank + + # Import the adjust commands for public export + + namespace import -force adjust::adjust adjust::indent adjust::undent + + # Import the split commands for public export + + namespace import -force split::splitx split::splitn + + # Import the trim commands for public export + + namespace import -force trim::trim trim::trimleft trim::trimright + namespace import -force trim::trimPrefix trim::trimEmptyHeading + + # Import the tabify commands for public export + + namespace import -force tabify::tabify tabify::untabify + namespace import -force tabify::tabify2 tabify::untabify2 + + # Re-export all the imported commands + + namespace export chop tail cap uncap capEachWord + namespace export longestCommonPrefix longestCommonPrefixList + namespace export strRepeat blank + namespace export adjust indent undent + namespace export splitx splitn + namespace export trim trimleft trimright trimPrefix trimEmptyHeading + namespace export tabify untabify tabify2 untabify2 +} + + +# ### ### ### ######### ######### ######### +## Ready + +package provide textutil 0.9 diff --git a/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/adjust-0.7.3.tm b/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/adjust-0.7.3.tm new file mode 100644 index 0000000..d47c82f --- /dev/null +++ b/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/adjust-0.7.3.tm @@ -0,0 +1,761 @@ +# trim.tcl -- +# +# Various ways of trimming a string. +# +# Copyright (c) 2000 by Ajuba Solutions. +# Copyright (c) 2000 by Eric Melski +# Copyright (c) 2002-2004 by Johannes-Heinrich Vogeler +# Copyright (c) 2001-2006 by Andreas Kupries +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: adjust.tcl,v 1.16 2011/12/13 18:12:56 andreas_kupries Exp $ + +# ### ### ### ######### ######### ######### +## Requirements + +package require Tcl 8.2 +package require textutil::repeat +package require textutil::string + +namespace eval ::textutil::adjust {} + +# ### ### ### ######### ######### ######### +## API implementation + +namespace eval ::textutil::adjust { + namespace import -force ::textutil::repeat::strRepeat +} + +proc ::textutil::adjust::adjust {text args} { + if {[string length [string trim $text]] == 0} { + return "" + } + + Configure $args + Adjust text newtext + + return $newtext +} + +proc ::textutil::adjust::Configure {args} { + variable Justify left + variable Length 72 + variable FullLine 0 + variable StrictLength 0 + variable Hyphenate 0 + variable HyphPatterns ; # hyphenation patterns (TeX) + + set args [ lindex $args 0 ] + foreach { option value } $args { + switch -exact -- $option { + -full { + if { ![ string is boolean -strict $value ] } then { + error "expected boolean but got \"$value\"" + } + set FullLine [ string is true $value ] + } + -hyphenate { + # the word exceeding the length of line is tried to be + # hyphenated; if a word cannot be hyphenated to fit into + # the line processing stops! The length of the line should + # be set to a reasonable value! + + if { ![ string is boolean -strict $value ] } then { + error "expected boolean but got \"$value\"" + } + set Hyphenate [string is true $value] + if { $Hyphenate && ![info exists HyphPatterns(_LOADED_)]} { + error "hyphenation patterns not loaded!" + } + } + -justify { + set lovalue [ string tolower $value ] + switch -exact -- $lovalue { + left - + right - + center - + plain { + set Justify $lovalue + } + default { + error "bad value \"$value\": should be center, left, plain or right" + } + } + } + -length { + if { ![ string is integer $value ] } then { + error "expected positive integer but got \"$value\"" + } + if { $value < 1 } then { + error "expected positive integer but got \"$value\"" + } + set Length $value + } + -strictlength { + # the word exceeding the length of line is moved to the + # next line without hyphenation; words longer than given + # line length are cut into smaller pieces + + if { ![ string is boolean -strict $value ] } then { + error "expected boolean but got \"$value\"" + } + set StrictLength [ string is true $value ] + } + default { + error "bad option \"$option\": must be -full, -hyphenate, \ + -justify, -length, or -strictlength" + } + } + } + + return "" +} + +# ::textutil::adjust::Adjust +# +# History: +# rewritten on 2004-04-13 for bugfix tcllib-bugs-882402 (jhv) + +proc ::textutil::adjust::Adjust { varOrigName varNewName } { + variable Length + variable FullLine + variable StrictLength + variable Hyphenate + + upvar $varOrigName orig + upvar $varNewName text + + set pos 0; # Cursor after writing + set line "" + set text "" + + + if {!$FullLine} { + regsub -all -- "(\n)|(\t)" $orig " " orig + regsub -all -- " +" $orig " " orig + regsub -all -- "(^ *)|( *\$)" $orig "" orig + } + + set words [split $orig] + set numWords [llength $words] + set numline 0 + + for {set cnt 0} {$cnt < $numWords} {incr cnt} { + + set w [lindex $words $cnt] + set wLen [string length $w] + + # the word $w doesn't fit into the present line + # case #1: we try to hyphenate + + if {$Hyphenate && ($pos+$wLen >= $Length)} { + # Hyphenation instructions + set w2 [textutil::adjust::Hyphenation $w] + + set iMax [llength $w2] + if {$iMax == 1 && [string length $w] > $Length} { + # word cannot be hyphenated and exceeds linesize + + error "Word \"$w2\" can\'t be hyphenated\ + and exceeds linesize $Length!" + } else { + # hyphenating of $w was successfull, but we have to look + # that every sylable would fit into the line + + foreach x $w2 { + if {[string length $x] >= $Length} { + error "Word \"$w\" can\'t be hyphenated\ + to fit into linesize $Length!" + } + } + } + + for {set i 0; set w3 ""} {$i < $iMax} {incr i} { + set syl [lindex $w2 $i] + if {($pos+[string length " $w3$syl-"]) > $Length} {break} + append w3 $syl + } + for {set w4 ""} {$i < $iMax} {incr i} { + set syl [lindex $w2 $i] + append w4 $syl + } + + if {[string length $w3] && [string length $w4]} { + # hyphenation was successfull: redefine + # list of words w => {"$w3-" "$w4"} + + set x [lreplace $words $cnt $cnt "$w4"] + set words [linsert $x $cnt "$w3-"] + set w [lindex $words $cnt] + set wLen [string length $w] + incr numWords + } + } + + # the word $w doesn't fit into the present line + # case #2: we try to cut the word into pieces + + if {$StrictLength && ([string length $w] > $Length)} { + # cut word into two pieces + set w2 $w + + set over [expr {$pos+2+$wLen-$Length}] + + incr Length -1 + set w3 [string range $w2 0 $Length] + incr Length + set w4 [string range $w2 $Length end] + + set x [lreplace $words $cnt $cnt $w4] + set words [linsert $x $cnt $w3 ] + set w [lindex $words $cnt] + set wLen [string length $w] + incr numWords + } + + # continuing with the normal procedure + + if {($pos+$wLen < $Length)} { + # append word to current line + + if {$pos} {append line " "; incr pos} + append line $w + incr pos $wLen + } else { + # line full => write buffer and begin a new line + + if {[string length $text]} {append text "\n"} + append text [Justification $line [incr numline]] + set line $w + set pos $wLen + } + } + + # write buffer and return! + + if {[string length $text]} {append text "\n"} + append text [Justification $line end] + return $text +} + +# ::textutil::adjust::Justification +# +# justify a given line +# +# Parameters: +# line text for justification +# index index for line in text +# +# Returns: +# the justified line +# +# Remarks: +# Only lines with size not exceeding the max. linesize provided +# for text formatting are justified!!! + +proc ::textutil::adjust::Justification { line index } { + variable Justify + variable Length + variable FullLine + + set len [string length $line]; # length of current line + + if { $Length <= $len } then { + # the length of current line ($len) is equal as or greater than + # the value provided for text formatting ($Length) => to avoid + # inifinite loops we leave $line unchanged and return! + + return $line + } + + # Special case: + # for the last line, and if the justification is set to 'plain' + # the real justification is 'left' if the length of the line + # is less than 90% (rounded) of the max length allowed. This is + # to avoid expansion of this line when it is too small: without + # it, the added spaces will 'unbeautify' the result. + # + + set justify $Justify + if { ( "$index" == "end" ) && \ + ( "$Justify" == "plain" ) && \ + ( $len < round($Length * 0.90) ) } then { + set justify left + } + + # For a left justification, nothing to do, but to + # add some spaces at the end of the line if requested + + if { "$justify" == "left" } then { + set jus "" + if { $FullLine } then { + set jus [strRepeat " " [ expr { $Length - $len } ]] + } + return "${line}${jus}" + } + + # For a right justification, just add enough spaces + # at the beginning of the line + + if { "$justify" == "right" } then { + set jus [strRepeat " " [ expr { $Length - $len } ]] + return "${jus}${line}" + } + + # For a center justification, add half of the needed spaces + # at the beginning of the line, and the rest at the end + # only if needed. + + if { "$justify" == "center" } then { + set mr [ expr { ( $Length - $len ) / 2 } ] + set ml [ expr { $Length - $len - $mr } ] + set jusl [strRepeat " " $ml] + set jusr [strRepeat " " $mr] + if { $FullLine } then { + return "${jusl}${line}${jusr}" + } else { + return "${jusl}${line}" + } + } + + # For a plain justification, it's a little bit complex: + # + # if some spaces are missing, then + # + # 1) sort the list of words in the current line by decreasing size + # 2) foreach word, add one space before it, except if it's the + # first word, until enough spaces are added + # 3) rebuild the line + + if { "$justify" == "plain" } then { + set miss [ expr { $Length - [ string length $line ] } ] + + # Bugfix tcllib-bugs-860753 (jhv) + + set words [split $line] + set numWords [llength $words] + + if {$numWords < 2} { + # current line consists of less than two words - we can't + # insert blanks to achieve a plain justification => leave + # $line unchanged and return! + + return $line + } + + for {set i 0; set totalLen 0} {$i < $numWords} {incr i} { + set w($i) [lindex $words $i] + if {$i > 0} {set w($i) " $w($i)"} + set wLen($i) [string length $w($i)] + set totalLen [expr {$totalLen+$wLen($i)}] + } + + set miss [expr {$Length - $totalLen}] + + # len walks through all lengths of words of the line under + # consideration + + for {set len 1} {$miss > 0} {incr len} { + for {set i 1} {($i < $numWords) && ($miss > 0)} {incr i} { + if {$wLen($i) == $len} { + set w($i) " $w($i)" + incr wLen($i) + incr miss -1 + } + } + } + + set line "" + for {set i 0} {$i < $numWords} {incr i} { + set line "$line$w($i)" + } + + # End of bugfix + + return "${line}" + } + + error "Illegal justification key \"$justify\"" +} + +proc ::textutil::adjust::SortList { list dir index } { + + if { [ catch { lsort -integer -$dir -index $index $list } sl ] != 0 } then { + error "$sl" + } + + return $sl +} + +# Hyphenation utilities based on Knuth's algorithm +# +# Copyright (C) 2001-2003 by Dr.Johannes-Heinrich Vogeler (jhv) +# These procedures may be used as part of the tcllib + +# textutil::adjust::Hyphenation +# +# Hyphenate a string using Knuth's algorithm +# +# Parameters: +# str string to be hyphenated +# +# Returns: +# the hyphenated string + +proc ::textutil::adjust::Hyphenation { str } { + + # if there are manual set hyphenation marks e.g. "Recht\-schrei\-bung" + # use these for hyphenation and return + + if {[regexp {[^\\-]*[\\-][.]*} $str]} { + regsub -all {(\\)(-)} $str {-} tmp + return [split $tmp -] + } + + # Don't hyphenate very short words! Minimum length for hyphenation + # is set to 3 characters! + + if { [string length $str] < 4 } then { return $str } + + # otherwise follow Knuth's algorithm + + variable HyphPatterns; # hyphenation patterns (TeX) + + set w ".[string tolower $str]."; # transform to lower case + set wLen [string length $w]; # and add delimiters + + # Initialize hyphenation weights + + set s {} + for {set i 0} {$i < $wLen} {incr i} { + lappend s 0 + } + + for {set i 0} {$i < $wLen} {incr i} { + set kmax [expr {$wLen-$i}] + for {set k 1} {$k < $kmax} {incr k} { + set sw [string range $w $i [expr {$i+$k}]] + if {[info exists HyphPatterns($sw)]} { + set hw $HyphPatterns($sw) + set hwLen [string length $hw] + for {set l1 0; set l2 0} {$l1 < $hwLen} {incr l1} { + set c [string index $hw $l1] + if {[string is digit $c]} { + set sPos [expr {$i+$l2}] + if {$c > [lindex $s $sPos]} { + set s [lreplace $s $sPos $sPos $c] + } + } else { + incr l2 + } + } + } + } + } + + # Replace all even hyphenation weigths by zero + + for {set i 0} {$i < [llength $s]} {incr i} { + set c [lindex $s $i] + if {!($c%2)} { set s [lreplace $s $i $i 0] } + } + + # Don't start with a hyphen! Take also care of words enclosed in quotes + # or that someone has forgotten to put a blank between a punctuation + # character and the following word etc. + + for {set i 1} {$i < ($wLen-1)} {incr i} { + set c [string range $w $i end] + if {[regexp {^[:alpha:][.]*} $c]} { + for {set k 1} {$k < ($i+1)} {incr k} { + set s [lreplace $s $k $k 0] + } + break + } + } + + # Don't separate the last character of a word with a hyphen + + set max [expr {[llength $s]-2}] + if {$max} {set s [lreplace $s $max end 0]} + + # return the syllabels of the hyphenated word as a list! + + set ret "" + set w ".$str." + for {set i 1} {$i < ($wLen-1)} {incr i} { + if {[lindex $s $i]} { append ret - } + append ret [string index $w $i] + } + return [split $ret -] +} + +# textutil::adjust::listPredefined +# +# Return the names of the hyphenation files coming with the package. +# +# Parameters: +# None. +# +# Result: +# List of filenames (without directory) + +proc ::textutil::adjust::listPredefined {} { + variable here + return [glob -type f -directory $here -tails *.tex] +} + +# textutil::adjust::getPredefined +# +# Retrieve the full path for a predefined hyphenation file +# coming with the package. +# +# Parameters: +# name Name of the predefined file. +# +# Results: +# Full path to the file, or an error if it doesn't +# exist or is matching the pattern *.tex. + +proc ::textutil::adjust::getPredefined {name} { + variable here + + if {![string match *.tex $name]} { + return -code error \ + "Illegal hyphenation file \"$name\"" + } + set path [file join $here $name] + if {![file exists $path]} { + return -code error \ + "Unknown hyphenation file \"$path\"" + } + return $path +} + +# textutil::adjust::readPatterns +# +# Read hyphenation patterns from a file and store them in an array +# +# Parameters: +# filNam name of the file containing the patterns + +proc ::textutil::adjust::readPatterns { filNam } { + + variable HyphPatterns; # hyphenation patterns (TeX) + + # HyphPatterns(_LOADED_) is used as flag for having loaded + # hyphenation patterns from the respective file (TeX format) + + if {[info exists HyphPatterns(_LOADED_)]} { + unset HyphPatterns(_LOADED_) + } + + # the array xlat provides translation from TeX encoded characters + # to those of the ISO-8859-1 character set + + set xlat(\"s) \337; # 223 := sharp s " + set xlat(\`a) \340; # 224 := a, grave + set xlat(\'a) \341; # 225 := a, acute + set xlat(\^a) \342; # 226 := a, circumflex + set xlat(\"a) \344; # 228 := a, diaeresis " + set xlat(\`e) \350; # 232 := e, grave + set xlat(\'e) \351; # 233 := e, acute + set xlat(\^e) \352; # 234 := e, circumflex + set xlat(\`i) \354; # 236 := i, grave + set xlat(\'i) \355; # 237 := i, acute + set xlat(\^i) \356; # 238 := i, circumflex + set xlat(\~n) \361; # 241 := n, tilde + set xlat(\`o) \362; # 242 := o, grave + set xlat(\'o) \363; # 243 := o, acute + set xlat(\^o) \364; # 244 := o, circumflex + set xlat(\"o) \366; # 246 := o, diaeresis " + set xlat(\`u) \371; # 249 := u, grave + set xlat(\'u) \372; # 250 := u, acute + set xlat(\^u) \373; # 251 := u, circumflex + set xlat(\"u) \374; # 252 := u, diaeresis " + + set fd [open $filNam RDONLY] + set status 0 + + while {[gets $fd line] >= 0} { + + switch -exact $status { + PATTERNS { + if {[regexp {^\}[.]*} $line]} { + # End of patterns encountered: set status + # and ignore that line + set status 0 + continue + } else { + # This seems to be pattern definition line; to process it + # we have first to do some editing + # + # 1) eat comments in a pattern definition line + # 2) eat braces and coded linefeeds + + set z [string first "%" $line] + if {$z > 0} { set line [string range $line 0 [expr {$z-1}]] } + + regsub -all {(\\n|\{|\})} $line {} tmp + set line $tmp + + # Now $line should consist only of hyphenation patterns + # separated by white space + + # Translate TeX encoded characters to ISO-8859-1 characters + # using the array xlat defined above + + foreach x [array names xlat] { + regsub -all {$x} $line $xlat($x) tmp + set line $tmp + } + + # split the line and create a lookup array for + # the repective hyphenation patterns + + foreach item [split $line] { + if {[string length $item]} { + if {![string match {\\} $item]} { + # create index for hyphenation patterns + + set var $item + regsub -all {[0-9]} $var {} idx + # store hyphenation patterns as elements of an array + + set HyphPatterns($idx) $item + } + } + } + } + } + EXCEPTIONS { + if {[regexp {^\}[.]*} $line]} { + # End of patterns encountered: set status + # and ignore that line + set status 0 + continue + } else { + # to be done in the future + } + } + default { + if {[regexp {^\\endinput[.]*} $line]} { + # end of data encountered, stop processing and + # ignore all the following text .. + break + } elseif {[regexp {^\\patterns[.]*} $line]} { + # begin of patterns encountered: set status + # and ignore that line + set status PATTERNS + continue + } elseif {[regexp {^\\hyphenation[.]*} $line]} { + # some particular cases to be treated separately + set status EXCEPTIONS + continue + } else { + set status 0 + } + } + } + } + + close $fd + set HyphPatterns(_LOADED_) 1 + + return +} + +####################################################### + +# @c The specified block is indented +# @c by ing each line. The first +# @c lines ares skipped. +# +# @a text: The paragraph to indent. +# @a prefix: The string to use as prefix for each line +# @a prefix: of with. +# @a skip: The number of lines at the beginning to leave untouched. +# +# @r Basically , but indented a certain amount. +# +# @i indent +# @n This procedure is not checked by the testsuite. + +proc ::textutil::adjust::indent {text prefix {skip 0}} { + set text [string trimright $text] + + set res [list] + foreach line [split $text \n] { + if {[string compare "" [string trim $line]] == 0} { + lappend res {} + } else { + set line [string trimright $line] + if {$skip <= 0} { + lappend res $prefix$line + } else { + lappend res $line + } + } + if {$skip > 0} {incr skip -1} + } + return [join $res \n] +} + +# Undent the block of text: Compute LCP (restricted to whitespace!) +# and remove that from each line. Note that this preverses the +# shaping of the paragraph (i.e. hanging indent are _not_ flattened) +# We ignore empty lines !! + +proc ::textutil::adjust::undent {text} { + + if {$text == {}} {return {}} + + set lines [split $text \n] + set ne [list] + foreach l $lines { + if {[string length [string trim $l]] == 0} continue + lappend ne $l + } + set lcp [::textutil::string::longestCommonPrefixList $ne] + + if {[string length $lcp] == 0} {return $text} + + regexp "^(\[\t \]*)" $lcp -> lcp + + if {[string length $lcp] == 0} {return $text} + + set len [string length $lcp] + + set res [list] + foreach l $lines { + if {[string length [string trim $l]] == 0} { + lappend res {} + } else { + lappend res [string range $l $len end] + } + } + return [join $res \n] +} + +# ### ### ### ######### ######### ######### +## Data structures + +namespace eval ::textutil::adjust { + variable here [file dirname [info script]] + + variable Justify left + variable Length 72 + variable FullLine 0 + variable StrictLength 0 + variable Hyphenate 0 + variable HyphPatterns + + namespace export adjust indent undent +} + +# ### ### ### ######### ######### ######### +## Ready + +package provide textutil::adjust 0.7.3 diff --git a/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/dehypht.tex b/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/dehypht.tex new file mode 100644 index 0000000..8f1dfb0 --- /dev/null +++ b/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/dehypht.tex @@ -0,0 +1,902 @@ +% This is `dehypht.tex' as of 03 March 1999. +% +% Copyright (C) 1988,1991 Rechenzentrum der Ruhr-Universitaet Bochum +% [german hyphen patterns] +% Copyright (C) 1993,1994,1999 Bernd Raichle/DANTE e.V. +% [macros, adaption for TeX 2] +% +% ----------------------------------------------------------------- +% IMPORTANT NOTICE: +% +% This program can be redistributed and/or modified under the terms +% of the LaTeX Project Public License Distributed from CTAN +% archives in directory macros/latex/base/lppl.txt; either +% version 1 of the License, or any later version. +% ----------------------------------------------------------------- +% +% +% This file contains german hyphen patterns following traditional +% hyphenation rules and includes umlauts and sharp s, but without +% `c-k' and triple consonants. It is based on hyphen patterns +% containing 5719 german hyphen patterns with umlauts in the +% recommended version of September 27, 1990. +% +% For use with TeX generated by +% +% Norbert Schwarz +% Rechenzentrum Ruhr-Universitaet Bochum +% Universitaetsstrasse 150 +% D-44721 Bochum, FRG +% +% +% Adaption of these patterns for TeX, Version 2.x and 3.x and +% all fonts in T1/`Cork'/EC/DC and/or OT1/CM encoding by +% +% Bernd Raichle +% Stettener Str. 73 +% D-73732 Esslingen, FRG +% Email: raichle@Informatik.Uni-Stuttgart.DE +% +% +% Error reports in case of UNCHANGED versions to +% +% DANTE e.V., Koordinator `german.sty' +% Postfach 10 18 40 +% D-69008 Heidelberg, FRG +% Email: german@Dante.DE +% +% or one of the addresses given above. +% +% +% Changes: +% 1990-09-27 First version of `ghyphen3.tex' (Norbert Schwarz) +% 1991-02-13 PC umlauts changed to ^^xx (Norbert Schwarz) +% 1993-08-27 Umlauts/\ss changed to "a/\3 macros, added macro +% definitions and additional logic to select correct +% patterns/encoding (Bernd Raichle) +% 1994-02-13 Release of `ghyph31.tex' V3.1a (Bernd Raichle) +% 1999-03-03 Renamed file to `dehypht.tex' according to the +% naming scheme using the ISO country code `de', the +% common part `hyph' for all hyphenation patterns files, +% and the additional postfix `t' for traditional, +% removed wrong catcode change of ^^e (the comment +% character %) and ^^f (the character &), +% do _not_ change \catcode, \lccode, \uccode to avoid +% problems with other hyphenation pattern files, +% changed code to distinguish TeX 2.x/3.x, +% changed license conditions to LPPL (Bernd Raichle) +% +% +% For more information see the additional documentation +% at the end of this file. +% +% ----------------------------------------------------------------- +% +\message{German Traditional Hyphenation Patterns % + `dehypht' Version 3.2a <1999/03/03>} +\message{(Formerly known under the name `ghyph31' and `ghyphen'.)} +% +% +% Next we define some commands which are used inside the patterns. +% To keep them local, we enclose the rest of the file in a group +% (The \patterns command globally changes the hyphenation trie!). +% +\begingroup +% +% +% Make sure that doublequote is not active: +\catcode`\"=12 +% +% +% Because ^^e4 is used in the following macros which is read by +% TeX 2.x as ^^e or %, the comment character of TeX, some trick +% has to be found to avoid this problem. The same is true for the +% character ^^f or & in the TeX 2.x code. +% Therefore in the code the exclamationmark ! is used instead of +% the circumflex ^ and its \catcode is set appropriately +% (normally \catcode`\!=12, in the code \catcode`\!=7). +% +% The following \catcode, \lccode assignments and macro definitions +% are defined in such a way that the following \pattern{...} list +% can be used for both, TeX 2.x and TeX 3.x. +% +% We first change the \lccode of ^^Y to make sure that we can +% include this character in the hyphenation patterns. +% +\catcode`\^^Y=11 \lccode`\^^Y=`\^^Y +% +% Then we have to define some macros depending on the TeX version. +% Therefore we have to distinguish TeX version 2.x and 3.x: +% +\ifnum`\@=`\^^40 % true => TeX 3.x + % + % For TeX 3: + % ---------- + % + % Assign appropriate \catcode and \lccode values for all + % accented characters used in the patterns (\uccode changes are + % not used within \patterns{...} and thus not necessary): + % + \catcode"E4=11 \catcode"C4=11 % \"a \"A + \catcode"F6=11 \catcode"D6=11 % \"o \"O + \catcode"FC=11 \catcode"DC=11 % \"u \"U + \catcode"FF=11 \catcode"DF=11 % \ss SS + % + \lccode"C4="E4 \uccode"C4="C4 \lccode"E4="E4 \uccode"E4="C4 + \lccode"D6="F6 \uccode"D6="D6 \lccode"F6="F6 \uccode"F6="D6 + \lccode"DC="FC \uccode"DC="DC \lccode"FC="FC \uccode"FC="DC + \lccode"DF="FF \uccode"DF="DF \lccode"FF="FF \uccode"FF="DF + % + % In the following definitions we use ??xy instead of ^^xy + % to avoid errors when reading the following macro definitions + % with TeX 2.x (remember ^^e(4) is the comment character): + % + \catcode`\?=7 + % + % Define the accent macro " in such a way that it + % expands to single letters in font encoding T1. + \catcode`\"=13 + \def"#1{\ifx#1a??e4\else \ifx#1o??f6\else \ifx#1u??fc\else + \errmessage{Hyphenation pattern file corrupted!}% + \fi\fi\fi} + % + % - patterns with umlauts are ok + \def\n#1{#1} + % + % For \ss which exists in T1 _and_ OT1 encoded fonts but with + % different glyph codes, duplicated patterns for both encodings + % are included. Thus you can use these hyphenation patterns for + % T1 and OT1 encoded fonts: + % - define \3 to be code `\^^ff (\ss in font encoding T1) + % - define \9 to be code `\^^Y (\ss in font encoding OT1) + \def\3{??ff} + \def\9{??Y} + % - duplicated patterns to support font encoding OT1 are ok + \def\c#1{#1} + % >>>>>> UNCOMMENT the next line, if you do not want + % >>>>>> to use fonts in font encoding OT1 + %\def\c#1{} + % + \catcode`\?=12 + % +\else + % + % For TeX 2: + % ---------- + % + % Define the accent macro " to throw an error message. + \catcode`\"=13 + \def"#1{\errmessage{Hyphenation pattern file corrupted!}} + % + % - ignore all patterns with umlauts + \def\n#1{} + % + % With TeX 2 fonts in encoding T1 can be used, but all glyphs + % in positions > 127 can not be used in hyphenation patterns. + % Thus only patterns with glyphs in OT1 positions are included: + % - define \3 to be code ^^Y (\ss in CM font encoding) + % - define \9 to throw an error message + \def\3{^^Y} + \def\9{\errmessage{Hyphenation pattern file corrupted!}} + % - ignore all duplicated patterns with \ss in T1 encoding + \def\c#1{} + % +\fi +% +% +\patterns{% +.aa6l .ab3a4s .ab3ei .abi2 .ab3it .ab1l .ab1r .ab3u .ad3o4r .alti6 +.ana3c .an5alg .an1e .ang8s .an1s .ap1p .ar6sc .ar6ta .ar6tei .as2z +.au2f1 .au2s3 .be5erb .be3na .ber6t5r .bie6r5 .bim6s5t .brot3 .bru6s +.ch6 .che6f5 .da8c .da2r .dar5in .dar5u .den6ka .de5r6en .des6pe +.de8spo .de3sz .dia3s4 .dien4 .dy2s1 .ehren5 .eine6 .ei6n5eh .ei8nen +.ein5sa .en6der .en6d5r .en3k4 .en8ta8 .en8tei .en4t3r .epo1 .er6ban +.er6b5ei .er6bla .er6d5um .er3ei .er5er .er3in .er3o4b .erwi5s .es1p +.es8t .ex1a2 .ex3em .fal6sc .fe6st5a .flu4g3 .furch8 .ga6ner .ge3n4a +\n{.ge5r"o} .ges6 .halb5 .halbe6 .hal6br .haup4 .hau4t .heima6 .he4r3e +.her6za .he5x .hin3 .hir8sc .ho4c .hu3sa .hy5o .ibe5 .ima6ge .in1 +.ini6 .is5chi .jagd5 .kal6k5o .ka6ph .ki4e .kop6f3 .kraf6 \n{.k"u5ra} +.lab6br .liie6 .lo6s5k \n{.l"o4s3t} .ma5d .mi2t1 .no6th .no6top +.obe8ri .ob1l .obs2 .ob6st5e .or3c .ort6s5e .ost3a .oste8r .pe4re +.pe3ts .ph6 .po8str .rau4m3 .re5an .ro8q .ru5the \n{.r"u5be} +\n{.r"u8stet} .sch8 .se6e .se5n6h .se5ra .si2e .spi6ke .st4 .sy2n +.tages5 .tan6kl .ta8th .te6e .te8str .to6der .to8nin .to6we .um1 +.umpf4 .un1 .une6 .unge5n .ur1c .ur5en .ve6rin .vora8 .wah6l5 .we8ges +.wo6r .wor3a .wun4s .zi4e .zuch8 \n{."ande8re} \n{."och8} aa1c aa2gr +aal5e aa6r5a a5arti aa2s1t aat2s 6aba ab3art 1abdr 6abel aben6dr +ab5erk ab5err ab5esse 1abf 1abg \n{1abh"a} ab1ir 1abko a1bl ab1la +5ablag a6bla\3 \c{a6bla\9} ab4ler ab1lu \n{a8bl"a} \n{5a6bl"o} abma5c +1abn ab1ra ab1re 5a6brec ab1ro ab1s ab8sk abs2z 3abtei ab1ur 1abw +5abze 5abzu \n{ab1"an} \n{ab"au8} a4ce. a5chal ach5art ach5au a1che +a8chent ach6er. a6ch5erf a1chi ach1l ach3m ach5n a1cho ach3re a1chu +ach1w a1chy \n{ach5"af} ack1o acks6t ack5sta a1d 8ad. a6d5ac ad3ant +ad8ar 5addi a8dein ade5o8 adi5en 1adj 1adle ad1op a2dre 3adres adt1 +1adv \n{a6d"a} a1e2d ae1r a1er. 1aero 8afa a3fal af1an a5far a5fat +af1au a6fentl a2f1ex af1fr af5rau af1re 1afri af6tent af6tra aft5re +a6f5um \n{8af"a} ag5abe 5a4gent ag8er ages5e 1aggr ag5las ag1lo a1gn +ag2ne 1agog a6g5und a1ha a1he ah5ein a4h3erh a1hi ahl1a ah1le ah4m3ar +ahn1a a5ho ahra6 ahr5ab ah1re ah8rei ahren8s ahre4s3 ahr8ti ah1ru a1hu +\n{ah8"o} ai3d2s ai1e aif6 a3inse ai4re. a5isch. ais8e a3ismu ais6n +aiso6 a1j 1akad a4kade a1ke a1ki 1akko 5akro1 a5lal al5ans 3al8arm +al8beb al8berw alb5la 3album al1c a1le a6l5e6be a4l3ein a8lel a8lerb +a8lerh a6lert 5a6l5eth 1algi al4gli al3int al4lab al8lan al4l3ar +alle3g a1lo a4l5ob al6schm al4the altist5 al4t3re 8a1lu alu5i a6lur +alu3ta \n{a1l"a} a6mate 8ame. 5a6meise am6m5ei am6mum am2n ampf3a +am6schw am2ta a1mu \n{a1m"a} a3nac a1nad anadi5e an3ako an3alp 3analy +an3ame an3ara a1nas an5asti a1nat anat5s an8dent ande4s3 an1ec an5eis +an1e2k 4aner. a6n5erd a8nerf a6n5erke 1anfa 5anfert \n{1anf"a} 3angab +5angebo an3gli ang6lis an2gn 3angri ang5t6 \n{5anh"a} ani5g ani4ka +an5i8on an1kl an6kno an4kro 1anl anma5c anmar4 3annah anne4s3 a1no +5a6n1o2d 5a6n3oma 5a6nord 1anr an1sa 5anschl an4soz an1st 5anstal +an1s2z 5antenn an1th \n{5anw"a} a5ny an4z3ed 5anzeig 5anzieh 3anzug +\n{an1"a} \n{5an"as} \n{a1n"o} \n{an"o8d} a1os a1pa 3apfel a2ph1t +\n{aph5"a6} a1pi 8apl apo1c apo1s a6poste a6poth 1appa ap1pr a1pr +\n{a5p"a} \n{a3p"u} a1ra a4r3af ar3all 3arbei 2arbt ar1c 2a1re ar3ein +ar2gl 2a1ri ari5es ar8kers ar6les ar4nan ar5o6ch ar1o2d a1rol ar3ony +a8ror a3ros ar5ox ar6schl 8artei ar6t5ri a1ru a1ry 1arzt arz1w +\n{ar8z"a} \n{ar"a8m} \n{ar"o6} \n{ar5"om} \n{ar1"u2} a1sa a6schec +asch5l asch3m a6schn a3s4hi as1pa asp5l a8steb as5tev 1asth a6stoc +a1str ast3re 8a1ta ata5c ata3la a6tapf ata5pl a1te a6teli aten5a +ate5ran 6atf 6atg a1th at3hal 1athl 2a1ti 5atlant 3atlas 8atmus 6atn +a1to a6t5ops ato6ra a6t5ort. 4a1tr a6t5ru at2t1h \n{at5t6h"a} 6a1tu +atz1w \n{a1t"a} \n{a1t"u} au1a au6bre auch3a au1e aue4l 5aufent +\n{3auff"u} 3aufga 1aufn auf1t 3auftr 1aufw 3auge. au4kle aule8s 6aum +au8mar aum5p 1ausb 3ausd 1ausf 1ausg au8sin 3auss au4sta 1ausw 1ausz +aut5eng au1th 1auto au\3e8 \c{au\9e8} a1v ave5r6a aver6i a1w a6wes a1x +a2xia a6xio a1ya a1z azi5er. 8a\3 \c{8a\9} 1ba 8ba8del ba1la ba1na +ban6k5r ba5ot bardi6n ba1ro basten6 bau3sp 2b1b bb6le b2bli 2b1c 2b1d +1be be1a be8at. be1ch 8becht 8becke. be5el be1en bee8rei be5eta bef2 +8beff be1g2 \n{beh"o8} bei1s 6b5eisen bei3tr b8el bel8o belu3t be3nac +bend6o be6ners be6nerw be4nor ben4se6 bens5el \n{be1n"a} \n{be1n"u} +be1o2 b8er. be1ra be8rac ber8gab. ber1r \n{be1r"u} bes8c bes5erh +bes2p be5tha bet5sc be1un be1ur 8bex be6zwec 2b1f8 bfe6st5e 2b1g2 +bga2s5 bge1 2b1h bhole6 1bi bi1bl b6ie bi1el bi1la \n{bil"a5} bi1na +bi4nok bi5str bi6stu bi5tr bit4t5r b1j 2b1k2 \n{bk"u6} bl8 b6la. +6b1lad 6blag 8blam 1blat b8latt 3blau. b6lav 3ble. b1leb b1led +8b1leg 8b1leh 8bleid 8bleih 6b3lein blei3s ble4m3o 4blich b4lind +8bling b2lio 5blit b4litz b1loh 8b1los 1blu 5blum 2blun blut3a blut5sc +\n{3bl"a} \n{bl"as5c} \n{5bl"o} \n{3bl"u} \n{bl"u8sc} 2b1m 2b1n 1bo +bo1ch bo5d6s boe5 8boff 8bonk bo1ra b1ort 2b1p2 b1q 1br brail6 brast8 +bre4a b5red 8bref 8b5riem b6riga bro1s b1rup b2ruz \n{8br"oh} +\n{br"os5c} 8bs b1sa b8sang b2s1ar b1sc bs3erl bs3erz b8sof b1s2p +bst1h b3stru \n{b5st"a} b6sun 2b1t b2t1h 1bu bu1ie bul6k b8ure bu6sin +6b1v 2b1w 1by1 by6te. 8b1z bzi1s \n{1b"a} \n{b5"a6s5} \n{1b"u} +\n{b6"u5bere} \n{b"uge6} \n{b"ugel5e} \n{b"ur6sc} 1ca cag6 ca5la ca6re +ca5y c1c 1ce celi4c celich5 ce1ro c8h 2ch. 1chae ch1ah ch3akt cha6mer +8chanz 5chara 3chari 5chato 6chb 1chef 6chei ch3eil ch3eis 6cherkl +6chf 4chh 5chiad 5chias 6chins 8chj chl6 5chlor 6ch2m 2chn6 ch8nie +5cho. 8chob choi8d 6chp ch3ren ch6res \n{ch3r"u} 2chs 2cht cht5ha +cht3hi 5chthon ch6tin 6chuh chu4la 6ch3unt chut6t 8chw 1ci ci5tr c2k +2ck. ck1ei 4ckh ck3l ck3n ck5o8f ck1r 2cks ck5stra ck6s5u c2l 1c8o +con6ne 8corb cos6t c3q 1c6r 8c1t 1cu 1cy \n{5c"a1} \n{c"o5} 1da. +8daas 2dabg 8dabr 6dabt 6dabw 1dac da2gr 6d5alk 8d5amt dan6ce. +dani5er dan8ker 2danl danla6 6dans 8danzi 6danzu d1ap da2r1a8 2d1arb +d3arc dar6men 4d3art 8darz 1dat 8datm 2d1auf 2d1aus 2d1b 2d1c 2d1d +d5de d3d2h \n{dd"amme8} 1de 2deal de5an de3cha de1e defe6 6deff 2d1ehr +5d4eic de5isc de8lar del6s5e del6spr de4mag de8mun de8nep dene6r +8denge. 8dengen de5o6d 2deol de5ram 8derdb der5ein de1ro der1r d8ers +der5um de4s3am de4s3an de4sau de6sil de4sin de8sor de4spr de2su 8deul +de5us. 2d1f df2l 2d1g 2d1h 1di dia5c di5ara dice5 di3chr di5ena di1gn +di1la dil8s di1na 8dind 6dinf 4d3inh 2d1ins di5o6d di3p4t di8sen dis1p +di5s8per di6s5to dis5tra di8tan di8tin d1j 6dje 2dju 2d1k 2d1l 2d1m +2d1n6 dni6 dnje6 1do 6d5obe do6berf 6d5ony do3ran 6dord 2d1org dor4t3h +do6ste 6doth dott8e 2d1p d5q dr4 1drah 8drak d5rand 6dre. 4drech +d6reck 4d3reg 8d3reic d5reife 8drem 8d1ren 2drer 8dres. 6d5rh 1dria +d1ric 8drind droi6 dro5x 1dru 8drut \n{dr"os5c} \n{1dr"u} \n{dr"u5b} +\n{dr"u8sc} 2ds d1sa d6san dsat6 d1sc 5d6scha. 5dschik dse8e d8serg +8dsl d1sp d4spak ds2po \n{d8sp"a} d1st \n{d1s"u} 2dt d1ta d1te d1ti +d1to dt1s6 d1tu \n{d5t"a} 1du du5als du1b6 du1e duf4t3r 4d3uh du5ie +8duml 8dumw 2d1und du8ni 6d5unt dur2c durch3 6durl 6dursa 8durt du1s +du8schr 2d1v 2d1w dwa8l 2d1z \n{1d"a} \n{6d"ah} \n{8d"and} \n{d"a6r} +\n{d"o8bl} \n{d5"ol} \n{d"or6fl} \n{d"o8sc} \n{d5"o4st} \n{d"os3te} +\n{1d"u} ea4ben e1ac e1ah e1akt e1al. e5alf e1alg e5a8lin e1alk e1all +e5alp e1alt e5alw e1am e1and ea6nim e1ar. e5arf e1ark e5arm e3art +e5at. e6ate e6a5t6l e8ats e5att e6au. e1aus e1b e6b5am ebens5e +eb4lie eb4ser eb4s3in e1che e8cherz e1chi ech3m 8ech3n ech1r ech8send +ech4su e1chu eck5an e5cl e1d ee5a ee3e ee5g e1ei ee5isc eei4s3t +ee6lend e1ell \n{ee5l"o} e1erd ee3r4e ee8reng eere6s5 \n{ee5r"a} +ee6tat e1ex e1f e6fau e8fe8b 3effek ef3rom ege6ra eglo6si 1egy e1ha +e6h5ach eh5ans e6hap eh5auf e1he e1hi ehl3a eh1le ehl5ein eh1mu ehn5ec +e1ho ehr1a eh1re ehre6n eh1ri eh1ru ehr5um e1hu eh1w e1hy \n{e1h"a} +\n{e1h"o} \n{e3h"ut} ei1a eia6s ei6bar eich3a eich5r ei4dar ei6d5ei +ei8derf ei3d4sc ei1e 8eifen 3eifri 1eign eil1d ei6mab ei8mag ein1a4 +ei8nat ei8nerh ei8ness ei6nete ein1g e8ini ein1k ei6n5od ei8nok ei4nor +\n{e3ins"a} ei1o e1irr ei5ru ei8sab ei5schn ei6s5ent ei8sol ei4t3al +eit3ar eit1h ei6thi ei8tho eit8samt ei6t5um e1j 1ekd e1ke e1ki e1k2l +e1kn ekni4 e1la e2l1al 6elan e6lanf e8lanl e6l5ans el3arb el3arm +e6l3art 5e6lasti e6lauge elbst5a e1le 6elef ele6h e6l5ehe e8leif +e6l5einh 1elek e8lel 3eleme e6lemen e6lente el5epi e4l3err e6l5ersc +elf2l elg2 e6l5ins ell8er 4e1lo e4l3ofe el8soh el8tent 5eltern e1lu +elut2 \n{e1l"a} \n{e1l"u} em8dei em8meis 4emo emo5s 1emp1f 1empt 1emto +e1mu emurk4 emurks5 \n{e1m"a} en5a6ben en5achs en5ack e1nad en5af +en5all en3alt en1am en3an. en3ant en3anz en1a6p en1ar en1a6s 6e1nat +en3auf en3aus en2ce enda6l end5erf end5erg en8dess 4ene. en5eck +e8neff e6n5ehr e6n5eim en3eis 6enem. 6enen e4nent 4ener. e8nerd +e6n3erf e4nerg 5energi e6n5erla en5ers e6nerst en5erw 6enes e6n5ess +e2nex en3glo 2eni enni6s5 ennos4 enns8 e1no e6nober eno8f en5opf +e4n3ord en8sers ens8kl en1sp ens6por en5t6ag enta5go en8terbu en6tid +3entla ent5ric 5entwic 5entwu 1entz enu5i e3ny en8zan \n{en1"of} +\n{e1n"os} \n{e1n"ug} eo1c e5o6fe e5okk e1on. e3onf e5onk e5onl e5onr +e5opf e5ops e5or. e1ord e1org eo5r6h eo1t e1pa e8pee e6p5e6g ep5ent +e1p2f e1pi 5epid e6pidem e1pl 5epos e6pos. ep4p3a e1pr \n{e1p"a} e1q +e1ra. er5aal 8eraba e5rabel er5a6ben e5rabi er3abs er3ach era5e +era5k6l er3all er3amt e3rand e3rane er3ans e5ranz. e1rap er3arc +e3rari er3a6si e1rat erat3s er3auf e3raum 3erbse er1c e1re 4e5re. +er3eck er5egg er5e2h 2erei e3rei. e8reine er5einr 6eren. e4r3enm +4erer. e6r5erm er5ero er5erst e4r3erz er3ess \n{5erf"ul} er8gan. +5ergebn er2g5h \n{5erg"anz} \n{5erh"ohu} 2e1ri eri5ak e6r5iat e4r3ind +e6r5i6n5i6 er5ins e6r5int er5itio er1kl \n{3erkl"a} \n{5erl"os.} +ermen6s er6nab 3ernst 6e1ro. e1rod er1o2f e1rog 6e3roi ero8ide e3rol +e1rom e1ron e3rop8 e2r1or e1ros e1rot er5ox ersch4 5erstat er6t5ein +er2t1h er5t6her 2e1ru eruf4s3 e4r3uhr er3ums e5rus 5erwerb e1ry er5zwa +er3zwu \n{er"a8m} \n{er5"as} \n{er"o8} \n{e3r"os.} \n{e6r1"u2b} e1sa +esa8b e8sap e6s5a6v e1sc esch4l ese1a es5ebe eserve5 e8sh es5ill +es3int es4kop e2sl eso8b e1sp espei6s5 es2po es2pu 5essenz e6stabs +e6staf e6st5ak est3ar e8stob e1str est5res es3ur e2sz \n{e1s"u} e1ta +et8ag etari5e eta8ta e1te eten6te et5hal e5thel e1ti 1etn e1to e1tr +et3rec e8tscha et8se et6tei et2th et2t1r e1tu etu1s et8zent et8zw +\n{e1t"a} \n{e1t"o} \n{e1t"u} eu1a2 eu1e eue8rei eu5fe euin5 euk2 +e1um. eu6nio e5unter eu1o6 eu5p 3europ eu1sp eu5str eu8zo e1v eval6s +eve5r6en ever4i e1w e2wig ex1or 1exp 1extr ey3er. e1z \n{e1"a2} +\n{e5"o8} \n{e1"u} e8\3es \c{e8\9es} fa6ch5i fade8 fa6del fa5el. +fal6lo falt8e fa1na fan4gr 6fanl 6fap far6ba far4bl far6r5a 2f1art +fa1sc fau8str fa3y 2f1b2 6f1c 2f1d 1fe 2f1eck fe6dr feh6lei f6eim +8feins f5eis fel5en 8feltern 8femp fe5rant 4ferd. ferri8 fe8stof +fe6str fe6stum fe8tag fet6ta fex1 2ff f1fa f6f5arm f5fe ffe5in ffe6la +ffe8ler ff1f f1fla ff3lei ff4lie ff8sa ff6s5ta 2f1g2 fgewen6 4f1h 1fi +fid4 fi3ds fieb4 fi1la fi8lei fil4m5a f8in. fi1na 8finf fi8scho fi6u +6f1j 2f1k2 f8lanz fl8e 4f3lein 8flib 4fling f2lix 6f3lon 5flop 1flor +\n{5f8l"ac} \n{3fl"ot} 2f1m 2f1n 1fo foh1 f2on fo6na 2f1op fo5ra +for8mei for8str for8th for6t5r fo5ru 6f5otte 2f1p8 f1q fr6 f5ram +1f8ran f8ra\3 \c{f8ra\9} f8re. frei1 5frei. f3reic f3rest f1rib +8f1ric 6frig 1fris fro8na \n{fr"as5t} 2fs f1sc f2s1er f5str +\n{fs3t"at} 2ft f1tak f1te ft5e6h ftere6 ft1h f1ti f5to f1tr ft5rad +ft1sc ft2so f1tu ftwi3d4 ft1z 1fu 6f5ums 6funf fun4ka fu8\3end +\c{fu8\9end} 6f1v 2f1w 2f1z \n{1f"a} \n{f"a1c} \n{8f"arm} \n{6f"aug} +\n{f"a8\3} \n{\c{f"a8\9}} \n{f"ode3} \n{8f"of} \n{3f"or} \n{1f"u} +\n{f"un4f3u} 1ga ga6bl 6gabw 8gabz g3a4der ga8ho ga5isc 4gak ga1la +6g5amt ga1na gan5erb gan6g5a ga5nj 6ganl 8gansc 6garb 2g1arc 2g1arm +ga5ro 6g3arti ga8sa ga8sc ga6stre 2g1atm 6g5auf gau5fr g5aus 2g1b g5c +6gd g1da 1ge ge1a2 ge6an ge8at. ge1e2 ge6es gef2 8geff ge1g2l ge1im +4g3eise geist5r gel8bra gelt8s \n{ge5l"o} ge8nin gen3k 6g5entf +\n{ge3n"a} ge1or ge1ra ge6rab ger8au \n{8gerh"o} ger8ins ge1ro 6g5erz. +\n{ge1r"a} \n{ge1r"u} ge1s ges2p ge5unt 4g3ex3 2g1f8 2g1g g1ha 6g1hei +5ghel. g5henn 6g1hi g1ho 1ghr \n{g1h"o} 1gi gi5la gi8me. gi1na +4g3ins gi3str g1j 2g1k 8gl. 1glad g5lag glan4z3 1glas 6glass 5glaub +g3lauf 1gle. g5leb 3gleic g3lein 5gleis 1glem 2gler 8g3leu gli8a +g2lie 3glied 1g2lik 1g2lim g6lio 1gloa 5glom 1glon 1glop g1los g4loss +g5luf 1g2ly \n{1gl"u} 2g1m gn8 6gn. 1gna 8gnach 2gnah g1nas g8neu +g2nie g3nis 1gno 8gnot 1go goe1 8gof 2gog 5gogr 6g5oh goni5e 6gonist +go1ra 8gord 2g1p2 g1q 1gr4 g5rahm gra8m gra4s3t 6g1rec gre6ge 4g3reic +g5reit 8grenn gri4e g5riem 5grif 2grig g5ring 6groh 2grot gro6\3 +\c{gro6\9} 4grut 2gs gs1ab g5sah gs1ak gs1an gs8and gs1ar gs1au g1sc +gs1ef g5seil gs5ein g2s1er gs1in g2s1o gso2r gs1pr g2s1u 2g1t g3te +g2t1h 1gu gu5as gu2e 2gue. 6gued 4g3uh 8gums 6g5unt gu1s gut3h gu2tu +4g1v 2g1w gy1n g1z \n{1g"a} \n{8g"a8m} \n{6g"arm} \n{1g"o} \n{1g"u} +\n{6g"ub} 1haa hab8r ha8del hade4n 8hae ha5el. haf6tr 2hal. ha1la +hal4b5a 6hale 8han. ha1na han6dr han6ge. 2hani h5anth 6hanz 6harb +h3arbe h3arme ha5ro ha2t1h h1atm hau6san ha8\3 \c{ha8\9} h1b2 h1c h1d +he2bl he3cho h3echt he5d6s 5heft h5e6he. hei8ds h1eif 2hein he3ism +he5ist. heit8s3 hek6ta hel8lau 8helt he6mer 1hemm 6h1emp hen5end +hen5klo hen6tri he2nu 8heo he8q her3ab he5rak her3an 4herap her3au +h3erbi he1ro he8ro8b he4r3um her6z5er he4spe he1st heta6 het5am he5th +heu3sc he1xa hey5e h1f2 h1g hgol8 h1h h1iat hie6r5i hi5kt hil1a2 +hil4fr hi5nak hin4ta hi2nu hi5ob hirn5e hir6ner hi1sp hi1th hi5tr +5hitz h1j h6jo h1k2 hlabb4 hla4ga hla6gr h5lai hl8am h1las h1la\3 +\c{h1la\9} hl1c h1led h3lein h5ler. h2lif h2lim h8linf hl5int h2lip +h2lit h4lor h3lose \n{h1l"as} hme5e h2nee h2nei hn3eig h2nel hne8n +hne4p3f hn8erz h6netz h2nip h2nit h1nol hn5sp h2nuc h2nud h2nul hoch1 +1hoh hoh8lei 2hoi ho4l3ar 1holz h2on ho1ra 6horg 5horn. ho3sl hos1p +ho4spi h1p hpi6 h1q 6hr h1rai h8rank h5raum hr1c hrcre8 h1red h3reg +h8rei. h4r3erb h8rert hrg2 h1ric hr5ins h2rom hr6t5erl hr2t1h hr6t5ra +hr8tri h6rum hr1z hs3ach h6s5amt h1sc h6s5ec h6s5erl hs8erle h4sob +h1sp h8spa\3 \c{h8spa\9} h8spel hs6po h4spun h1str h4s3tum hs3und +\n{h1s"u} h5ta. h5tab ht3ac ht1ak ht3ang h5tanz ht1ar ht1at h5taub +h1te h2t1ec ht3eff ht3ehe h4t3eif h8teim h4t3ein ht3eis h6temp h8tentf +hte8ren \n{h6terf"u} h8tergr h4t3erh h6t5ersc h8terst h8tese h8tess +h2t1eu h4t3ex ht1he ht5hu h1ti ht5rak hts3ah ht1sc ht6sex ht8sk ht8so +h1tu htz8 \n{h5t"um} hub5l hu6b5r huh1l h5uhr. huld5a6 hu8lent +\n{hu8l"a} h5up. h1v h5weib h3weis h1z \n{h"a8kl} \n{h"al8s} +\n{h"ama8tu8} \n{h"a8sche.} \n{h"at1s} \n{h"au4s3c} \n{2h"o.} +\n{2h"oe} \n{8h"oi} \n{h"o6s} \n{h"os5c} \n{h"uhne6} \n{h"ul4s3t} +\n{h"utte8re} i5adn i1af i5ak. i1al. i1al1a i1alb i1ald i5alei i1alf +i1alg i3alh i1alk i1all i1alp i1alr i1als i1alt i1alv i5alw i3alz +i1an. ia5na i3and ian8e ia8ne8b i1ang i3ank i5ann i1ant i1anz i6apo +i1ar. ia6rab i5arr i1as. i1asm i1ass i5ast. i1at. i5ats i1au i5azz +i6b5eig i6b5eis ib2le i4blis i6brig i6b5unt \n{i6b"ub} i1che ich5ei +i6cherb i1chi ich5ins ich1l ich3m ich1n i1cho icht5an icht3r i1chu +ich1w ick6s5te ic5l i1d id3arm 3ideal ide8na 3ideol \n{ide5r"o} i6diot +id5rec id1t ie1a ie6b5ar iebe4s3 ie2bl ieb1r ie8bra ie4bre \n{ie8b"a} +ie2dr ie1e8 ie6f5ad ief5f ie2f1l ie4fro ief1t i1ei ie4l3ec ie8lei +ie4lek i3ell i1en. i1end ien6e i3enf i5enn ien6ne. i1enp i1enr +i5ensa ien8stal i5env i1enz ie5o ier3a4b ie4rap i2ere ie4rec ie6r5ein +ie6r5eis ier8er i3ern. ie8rum ie8rund ie6s5che ie6tau ie8tert ie5the +ie6t5ri i1ett ie5un iex5 2if i1fa if5ang i6fau if1fr if5lac i5f6lie +i1fre ift5a if6t5r ig3art 2ige i8gess ig5he i5gla ig2ni i5go ig3rot +ig3s2p i1ha i8ham i8hans i1he i1hi ih1n ih1r i1hu i8hum ih1w 8i1i ii2s +ii2t i1j i1k i6kak i8kerz i6kes ik4ler i6k5unt 2il i5lac i1lag il3ans +i5las i1lau il6auf i1le ile8h i8lel il2fl il3ipp il6l5enn i1lo ilt8e +i1lu \n{i1l"a} i8mart imb2 i8mele i8mid imme6l5a i1mu \n{i1m"a} +\n{i5m"o} ina5he i1nat in1au inau8s 8ind. in4d3an 5index ind2r 3indus +i5nec i2n1ei i8nerw 3infek 1info 5ingeni ing5s6o 5inhab ini5er. 5inj +\n{in8k"at} in8nan i1no inoi8d in3o4ku in5sau in1sp 5inspe 5instit +5instru ins4ze 5intere 5interv in3the in5t2r i5ny \n{in"a2} \n{i1n"ar} +\n{in1"as} \n{in"o8} \n{in5"od} \n{i1n"os} 2io io1a8 io1c iode4 io2di +ioi8 i1ol. i1om. i1on. i5onb ion2s1 i1ont i5ops i5o8pt i1or. +i3oral io3rat i5orc i1os. i1ot. i1o8x 2ip i1pa i1pi i1p2l i1pr i1q +i1ra ir6bl i1re i1ri ir8me8d ir2m1o2 ir8nak i1ro ir5rho ir6schl +ir6sch5r i5rus i5ry \n{i5r"a} i1sa i8samt i6sar i2s1au i8scheh i8schei +isch5m isch3r \n{isch"a8} is8ele ise3ra i4s3erh is3err isi6de i8sind +is4kop ison5e is6por i8s5tum i5sty \n{i5s"o} i1ta it5ab. i2t1a2m +i8tax i1te i8tersc i1thi i1tho i5thr \n{it8h"a} i1ti i8ti8d iti6kl +itmen4 i1to i8tof it3ran it3rau i1tri itri5o it1sc it2se it5spa it8tru +i1tu it6z5erg it6z1w \n{i1t"a} \n{it"a6r5e} \n{it"at2} \n{it"ats5} +\n{i1t"u} i1u iu6r 2i1v i6vad iva8tin i8vei i6v5ene i8verh i2vob i8vur +i1w iwi2 i5xa i1xe i1z ize8n i8zir i6z5w \n{i"a8m} \n{i1"a6r} +\n{i5"at.} \n{i5"av} \n{i1"o8} \n{i"u8} i6\35ers \c{i6\95ers} ja5la +je2t3r 6jm 5jo jo5as jo1ra jou6l ju5cha jugen4 jugend5 jung5s6 ju1s +\n{3j"a} 1ka 8kachs 8kakz ka1la kal5d kam5t ka1na 2kanl 8kapf ka6pl +ka5r6a 6k3arbe ka1ro kar6p5f 4k3arti 8karz \n{ka1r"a} kasi5e ka6teb +kat8ta kauf6s kau3t2 2k1b 2k1c 4k1d kehr6s kehrs5a 8keic 2k1eig 6k5ein +6k5eis ke6lar ke8leis ke8lo 8kemp k5ente. k3entf 8k5ents 6kentz ke1ra +k5erlau 2k1f8 2k1g 2k1h ki5fl 8kik king6s5 6kinh ki5os ki5sp ki5th +\n{8ki8"o} 2k1k2 kl8 1kla 8klac k5lager kle4br k3leib 3kleid kle5isc +4k3leit k3lek 6k5ler. 5klet 2klic 8klig k2lim k2lin 5klip 5klop k3lor +\n{1kl"a} 2k1m kmani5e kn8 6kner k2ni \n{kn"a8} 1k2o ko1a2 ko6de. +ko1i koi8t ko6min ko1op ko1or ko6pht ko3ra kor6d5er ko5ru ko5t6sc k3ou +3kow 6k5ox 2k1p2 k1q 1kr8 4k3rad 2k1rec 4k3reic kre5ie 2krib 6krig +2krip 6kroba 2ks k1sa k6sab ksal8s k8samt k6san k1sc k2s1ex k5spat +k5spe k8spil ks6por k1spr kst8 k2s1uf 2k1t kta8l kt5a6re k8tein kte8re +k2t1h k8tinf kt3rec kt1s 1ku ku1ch kuck8 k3uhr ku5ie kum2s1 kunfts5 +kun2s kunst3 ku8rau ku4ro kurz1 ku1st 4kusti ku1ta ku8\3 \c{ku8\9} +6k1v 2k1w ky5n 2k1z \n{1k"a} \n{k"a4m} \n{4k3"ami} \n{k"ase5} \n{1k"o} +\n{k"o1c} \n{k"o1s} \n{1k"u} \n{k"u1c} \n{k"ur6sc} \n{k"u1s} 1la. +8labf 8labh lab2r 2l1abs lach3r la8dr 5ladu 8ladv 6laff laf5t la2gn +5laken 8lamb la6mer 5lampe. 2l1amt la1na 1land lan4d3a lan4d3r lan4gr +8lanme 6lann 8lanw \n{6lan"a} 8lappa lap8pl lap6pr l8ar. la5ra lar4af +la8rag la8ran la6r5a6s l3arbe la8rei 6larm. la8sa la1sc la8sta lat8i +6l5atm 4lauss 4lauto 1law 2lb l8bab l8bauf l8bede l4b3ins l5blo +lbst5an lbst3e 8lc l1che l8chert l1chi lch3m l5cho lch5w 6ld l4d3ei +ld1re \n{l6d"ub} le2bl le8bre lecht6s5 led2r 6leff le4gas 1lehr lei6br +le8inf 8leinn 5leistu 4lektr le6l5ers lemo2 8lemp l8en. 8lends +6lendun le8nend len8erw 6l5ents 4l3entw 4lentz 8lenzy 8leoz 6lepi +le6pip 8lepo 1ler l6er. 8lerbs 6l5erde le8reis le8rend le4r3er 4l3erg +l8ergr 6lerkl 6l5erzie \n{8ler"o} 8lesel lesi5e le3sko le3tha let1s +5leuc 4leuro leu4s3t le5xe 6lexp l1f 2l1g lgend8 l8gh lglie3 lglied6 +6l1h 1li li1ar li1as 2lick li8dr li1en lien6n li8ers li8ert 2lie\3 +\c{2lie\9} 3lig li8ga8b li1g6n li1l8a 8limb li1na 4l3indu lings5 +4l3inh 6linj link4s3 4linkt 2lint 8linv lion5s6t 4lipp 5lipt 4lisam +livi5e 6l1j 6l1k l8keim l8kj lk2l lko8f lkor8 lk2sa lk2se 6ll l1la +ll3a4be l8labt ll8anl ll1b ll1c ll1d6 l1le l4l3eim l6l5eise ller3a +l4leti l5lip l1lo ll3ort ll5ov ll6spr llte8 l1lu ll3urg \n{l1l"a} +\n{l5l"u} \n{l6l"ub} 2l1m l6m5o6d 6ln l1na l1no 8lobl lo6br 3loch. +l5o4fen 5loge. 5lohn 4l3ohr 1lok l2on 4l3o4per lo1ra 2l1ord 6lorg +4lort lo1ru 1los. lo8sei 3losig lo6ve lowi5 6l1p lp2f l8pho l8pn +lp4s3te l2pt l1q 8l1r 2ls l1sa l6sarm l1sc l8sec l6s5erg l4s3ers l8sh +l5s6la l1sp ls4por ls2pu l1str l8suni \n{l1s"u} 2l1t lt5amp l4t3ein +l5ten l6t5eng l6t5erp l4t3hei lt3her l2t1ho l6t5i6b lti1l \n{l8tr"o} +lt1sc lt6ser lt4s3o lt5ums lu8br lu2dr lu1en8 8lu8fe luft3a luf8tr +lu6g5r 2luh l1uhr lu5it 5luk 2l1umf 2l1umw 1lun 6l5u6nio 4l3unte lu5ol +4lurg 6lurs l3urt lu4sto lu3str lu6st5re lu8su lu6tal lu6t5e6g lu8terg +lu3the lu6t5or lu2t1r lu6\35 \c{lu6\95} l1v lve5r6u 2l1w 1ly lya6 +6lymp ly1no l8zess l8zo8f l3zwei lz5wu \n{3l"and} \n{l"a5on} +\n{l"a6sc} \n{l"at1s} \n{5l"auf} \n{2l"aug} \n{l"au6s5c} \n{l"a5v} +\n{l1"ol} \n{1l"os} \n{l"o1\36t} \n{\c{l"o1\96t}} \n{6l1"ube} 1ma +8mabg ma5chan mad2 ma5el 4magg mag8n ma1la ma8lau mal5d 8malde mali5e +malu8 ma8lut 2m1amp 3man mand2 man3ds 8mangr mani5o 8m5anst 6mappa +4m3arbe mar8kr ma1r4o mar8schm 3mas ma1sc \n{ma1t"o} 4m5auf ma5yo 2m1b +mb6r 2m1c 2m1d \n{md6s"a} 1me me1ch me5isc 5meld mel8sa 8memp me5nal +men4dr men8schl men8schw 8mentsp me1ra mer4gl me1ro 3mes me6s5ei me1th +me8\3 \c{me8\9} 2m1f6 2m1g 2m1h 1mi mi1a mi6ale mi1la 2m1imm mi1na +\n{mi5n"u} mi4s3an mit1h mi5t6ra 3mitt mitta8 mi6\35 \c{mi6\95} 6mj +2m1k8 2m1l 2m1m m6mad m6m5ak m8menth m8mentw mme6ra m2mn mm5sp mm5ums +mmut5s \n{m8m"an} m1n8 m5ni 1mo mo5ar mo4dr 8mof mo8gal mo4kla mol5d +m2on mon8do mo4n3od mont8a 6m5ony mopa6 mo1ra mor8d5a mo1sc mo1sp 5mot +moy5 2mp m1pa mpfa6 mpf3l mphe6 m1pi mpin6 m1pl mp2li m2plu mpo8ste +m1pr \n{mpr"a5} mp8th mput6 mpu5ts \n{m1p"o} 8m1q 2m1r 2ms ms5au m1sc +msch4l ms6po m3spri m1str 2m1t mt1ar m8tein m2t1h mt6se \n{mt8s"a} +mu5e 6m5uh mumi1 1mun mun6dr muse5e mu1ta 2m1v mvol2 mvoll3 2m1w 1my +2m1z \n{m"a6kl} \n{1m"an} \n{m"a1s} \n{m"a5tr} \n{m"au4s3c} \n{3m"a\3} +\n{\c{3m"a\9}} \n{m"ob2} \n{6m"ol} \n{1m"u} \n{5m"un} \n{3m"ut} 1na. +n5ab. 8nabn n1abs n1abz \n{na6b"a} na2c nach3e 3nacht 1nae na5el +n1afr 1nag 1n2ah na8ha na8ho 1nai 6nair na4kol n1akt nal1a 8naly 1nama +na4mer na1mn n1amp 8n1amt 5nanc nan6ce n1and n6and. 2n1ang 1nani +1nann n1ans 8nanw 5napf. 1n2ar. na2ra 2n1arc n8ard 1nari n8ark +6n1arm 5n6ars 2n1art n8arv 6natm nat6s5e 1naue 4nauf n3aug 5naui n5auk +na5um 6nausb 6nauto 1nav 2nax 3naz 1na\3 \c{1na\9} n1b2 nbau5s n1c +nche5e nch5m 2n1d nda8d n2d1ak nd5ans n2d1ei nde8lac ndel6sa n8derhi +nde4se nde8stal n2dj ndnis5 n6d5or6t nd3rec nd3rot nd8samt nd6sau +ndt1h n8dumd 1ne ne5as ne2bl 6n5ebn 2nec 5neei ne5en ne1g4l 2negy +4n1ein 8neis 4n3e4lem 8nemb 2n1emp nen1a 6n5energ nen3k 8nentb +4n3en3th 8nentl 8n5entn 8n5ents ne1ra ne5r8al ne8ras 8nerbi 6n5erde. +nere5i6d nerfor6 \n{6n5erh"o} \n{8nerl"o} 2n1err n8ers. 6n5ertra +2n1erz nesi3e net1h neu4ra neu5sc 8neu\3 \c{8neu\9} n1f nf5f nf2l +nflei8 nf5lin nft8st n8g5ac ng5d ng8en nge8ram ngg2 ng1h n6glic ng3rip +ng8ru ng2se4 ng2si n2g1um n1gy \n{n8g"al} n1h nhe6r5e 1ni ni1bl +\n{ni5ch"a} ni8dee n6ie ni1en nie6s5te niet5h ni8etn 4n3i6gel n6ik +ni1la 2n1imp ni5na 2n1ind 8ninf 6n5inh ni8nit 6n5inn 2n1ins 4n1int +n6is ni3str ni1th ni1tr n1j n6ji n8kad nk5ans n1ke n8kerla n1ki nk5inh +\n{n5kl"o} n1k2n n8k5not nk3rot \n{n8kr"u} nk5spo nk6t5r n8kuh +\n{n6k"ub} n5l6 nli4mi n1m nmen4s n1na n8nerg nni5o n1no nn4t3ak nnt1h +nnu1e n1ny \n{n1n"a} \n{n1n"o} \n{n1n"u} no5a no4b3la 4n3obs 2nobt +noche8 no6die no4dis no8ia no5isc 6n5o6leu no4mal noni6er 2n1onk n1ony +4n3o4per 6nopf 6nopti no3ra no4ram nor6da 4n1org 2n1ort n6os no1st +8nost. no8tan no8ter noty6pe 6n5ox n1p2 n1q n1r \n{nr"os3} 6ns n1sac +ns3ang n1sc n8self n8s5erf n8serg n6serk ns5erw n8sint n1s2pe n1spr +n6s5tat. n5s6te. n6stob n1str n1ta n4t3a4go nt5anh nt3ark nt3art +n1te nt3eis nte5n6ar nte8nei nter3a nte6rei nt1ha nt6har n3ther nt5hie +n3thus n1ti nti1c n8tinh nti1t ntlo6b ntmen8 n1to nt3o4ti n1tr ntra5f +ntra5ut nt8rea nt3rec nt8rep n4t3rin nt8rop n4t3rot \n{n4tr"u} nt1s +nts6an nt2sk n1tu nt1z \n{n1t"a} \n{n1t"o} \n{n8t"ol} \n{n1t"u} 1nu +nu1a nu5el nu5en 4n1uhr nu5ie 8numl 6n5ums 6n5umw 2n1und 6nuni 6n5unr +2n1unt 2nup 2nu6r n5uri nu3skr nu5ta n1v 8n1w 1nys n1za n6zab n2z1ar +n6zaus nzi4ga n8zof n6z5unt n1zw n6zwir \n{1n"ac} \n{5n"ae} \n{5n"ai} +\n{n8"al} \n{n"a6m} \n{n"a6re} \n{n5"arz} \n{5n"aus} \n{n1"ol} +\n{1n"ot} \n{n5"oz} \n{5n"u.} \n{6n1"u2b} \n{5n"u\3} \n{\c{5n"u\9}} +o5ab. oa2l o8ala o1a2m o1an ob1ac obe4ra o6berh 5o4bers o4beru +obe6ser 1obj o1bl o2bli ob5sk 3obst. ob8sta obst5re ob5sz o1che +oche8b o8chec o3chi och1l och3m ocho8f o3chro och3to o3chu och1w o1d +o2d1ag od2dr ode5i ode6n5e od1tr o5e6b o5e6der. oe8du o1ef o1e2l +o1e2p o1er. o5e8x o1fa of8fan 1offi of8fin of6f5la o5fla o1fr 8o1g +og2n o1ha o1he o6h5eis o1hi ohl1a oh1le oh4l3er 5ohm. oh2ni o1ho +oh1re oh1ru o1hu oh1w o1hy \n{o1h"a} o5ia o1id. o8idi oi8dr o5ids +o5isch. oiset6 o1ism o3ist. o5i6tu o1j o1k ok2l ok3lau \n{o8kl"a} +1okta o1la old5am old5r o1le ole5in ole1r ole3u ol6gl ol2kl olk4s1 +ol8lak ol8lauf. ol6lel ol8less o1lo ol1s ol6sk o1lu oly1e2 5olym +o2mab om6an o8mau ombe4 o8merz om5sp o1mu o8munt \n{o1m"a} \n{o1m"o} +o1na ona8m on1ax on8ent o6n5erb 8oni oni5er. on1k on6n5a6b o1no ono1c +o4nokt 1ons onts8 \n{o1n"a} oo8f 1oog oo2pe oo2sa o1pa 3o4pera o3pfli +opf3lo opf3r o1pi o1pl o2pli o5p6n op8pa op6pl o1pr o3p4ter 1opti +\n{o1p"a} \n{o5p"o} o1q o1ra. o3rad o8radd 1oram o6rang o5ras o8rauf +or5cha or4d3a4m or8dei or8deu 1ordn or4dos o1re o5re. ore2h o8r5ein +ore5isc or6enn or8fla or8fli 1orga 5orgel. or2gl o1ri 5o6rient or8nan +\n{or8n"a} o1ro or1r2h or6t5an or8tau or8tere o1rus o1ry \n{o1r"a} +\n{or1"u2} o1sa osa3i 6ose o8serk o1sk o6ske o6ski os2kl os2ko os2kr +osni5e o2s1o2d o3s4per o4stam o6stau o3stra ost3re osu6 o6s5ur o5s6ze +o1ta ot3auf o6taus o1te o6terw o1th othe5u o2th1r o1ti o1to oto1a +ot1re o1tri o1tro ot1sc o3tsu ot6t5erg ot2t3h ot2t5r \n{ot8t"o} o1tu +ou3e ouf1 ou5f6l o5u6gr ou5ie ou6rar ou1t6a o1v o1wa o1we o6wer. o1wi +owid6 o1wo o5wu o1xe oy5al. oy1e oy1i o5yo o1z oza2r 1o2zea ozo3is +\n{o"o8} o\35elt \c{o\95elt} o\31t \c{o\91t} 3paa pa6ce 5pad pag2 1pak +pa1la pa8na8t pani5el pa4nor pan1s2 1pap pap8s pa8rei par8kr paro8n +par5o6ti part8e 5partei 3partn pas6sep pa4tha 1pau 6paug pau3sc p1b +8p5c 4p1d 1pe 4peic pe5isc 2pek pen3k pen8to8 p8er pe1ra pere6 per5ea +per5eb pe4rem 2perr per8ran 3pers 4persi \n{pe3r"u} pe4sta pet2s +p2f1ec p4fei pf1f pf2l 5pflanz pf8leg pf3lei 2pft pf3ta p1g 1ph 2ph. +2p1haf 6phb 8phd 6p5heit ph5eme 6phg phi6e 8phk 6phn p5holl pht2 +ph3tha 4ph3the phu6 6phz pi1en pi5err pi1la pi1na 5pinse pioni8e 1pis +pi1s2k pi1th p1k pl8 5pla p2lau 4plei p3lein 2pler 6p5les 2plig p6lik +6p5ling p2liz plo8min 6p1m p1n 1p2o 8poh 5pol po8lan poly1 po3ny po1ra +2porn por4t3h \n{po5r"o} 5poti p1pa p6p5ei ppe6la pp5f p2p1h p1pi pp1l +ppp6 pp5ren pp1s \n{p5p"o} pr6 3preis 1pres 2p3rig 5prinz 1prob 1prod +5prog pro8pt pro6t5a prote5i 8pro\3 \c{8pro\9} \n{pr"a3l} \n{1pr"as} +\n{pr"ate4} \n{1pr"uf} p5schl 2pst 1p2sy p1t p8to8d pt1s 5p6ty 1pu +pu1b2 2puc pu2dr puf8fr 6p5uh pun8s pu8rei pu5s6h pu1ta p1v p3w 5py +py5l p1z \n{p"a6der} \n{p5"a6m} \n{p"a8nu} \n{8p"ar} \n{p"at5h} +\n{p"at1s} qu6 1qui 8rabk ra6bla 3rable ra2br r1abt 6rabz ra4dan ra2dr +5rafal ra4f3er ra5gla ra2g3n 6raha ral5am 5rald 4ralg ra8lins 2rall +ral5t 8ramei r3anal r6and ran8der ran4dr 8ranf 6ranga 5rangi ran8gli +r3angr rans5pa 8ranw r8anz. ra5or 6rapf ra5pl rap6s5er 2r1arb 1rarh +r1arm ra5ro 2r1art 6r1arz ra8tei ra6t5he 6ratl ra4t3ro r5atta raue4n +6raus. r5austa rau8tel raut5s ray1 r1b rb5lass r6bler rb4lie rbon6n +r8brecht \n{rb6s5t"a} r8ces r1che rch1l rch3m rch3re rch3tr rch1w 8rd +r1da r8dachs r8dap rda5ro rde5ins rdio5 r8dir rd3ost r1dr r8drau 1re. +re1ak 3reakt re3als re6am. re1as 4reben re6bl rech5a r8edi re3er +8reff 3refl 2reh 5reha r4ei. reich6s5 8reier 6reign re5imp 4r3eina +6r3einb 6reing 6r5einn 6reinr 4r3eins r3eint reli3e 8r5elt 6rempf +2remt ren5a6b ren8gl r3enni 1reno 5rente 4r3enth 8rentl 4r3entw 8rentz +ren4zw re1on requi5 1rer rer4bl 6rerbs 4r3erd \n{8rerh"o} 8rerkl +4r3erla \n{8rerl"o} 4r3erns \n{6r5ern"a} rer5o 6r5erreg r5ertr r5erwec +\n{r5er"o} re2sa re8schm 2ress re5u8ni 6rewo 2r1ex r1f r8ferd rf4lie +8r1g r8gah rge4bl rge5na rgest4 rg6ne r2gni2 r8gob r4g3ret rg8sel r1h8 +r2hy 5rhyt ri1ar ri5cha rid2g r2ie rieg4s5 ri8ei ri1el ri6ele ri1en +ri3er. ri5ers. ri6fan ri8fer ri8fr 1r2ig ri8kn ri5la \n{rim"a8} +ri1na r8inde rin4ga rin6gr 1rinn 6rinner rino1 r8insp 4rinst +\n{ri1n"a} ri5o6ch ri1o2d ri3o6st 2r1ir r2is ri3sko ri8spr \n{ri8st"u} +ri5sv r2it 6r5i6tal ri5tr ri6ve. 8r1j 6rk r1ke rkehrs5 r1ki r3klin +r1k2n rk3str rk4t3an rk6to r6kuh \n{rk"a4s3t} r1l r5li rline5a 6r1m +r6manl rma4p r4m3aph r8minf r8mob rm5sa 2rn r1na rna8be r5ne rn2ei +r6neif r6nex r6nh rn1k r1no r6n5oc rn1sp \n{r1n"a} \n{r1n"u} ro6bern +6robs ro1ch 3rock. ro5de ro1e 4rofe ro8hert 1rohr ro5id ro1in ro5isc +6rolym r2on 6roog ro6phan r3ort ro1s2p ro5s6w ro4tau ro1tr ro6ts 5rout +r1p rpe8re rp2f r2ps r2pt r1q 2rr r1ra r1re rrer6 rr6hos \n{r5rh"o} +r1ri r1ro rro8f rr8or rror5a r1ru r3ry \n{r1r"a} \n{r1r"o} \n{r1r"u} +2r1s r6sab r4sanf rse6e rse5na r2sh r6ska r6ski rs2kl r8sko r2sl rs2p +r6stauf r8sterw r8stran rswi3d4 r2sz 2r1t rt3art r8taut r5tei rt5eige +r8tepe r4t3erh r8terla r4t3hei r5t6hu r4t3int rt5reif rt1sc rt6ser +rt6s5o rt6s5u rt5und r8turt rube6 ru1en 1r4uf ruf4st ru1ie 2r1umg +2r1uml 2rums run8der run4d5r 6rundz 6runf 8runs 2r1unt 2r1ur r6us +ru6sta ru3str ru6tr 1ruts r1v rven1 rvi2c r1w r1x r1za rz5ac r6z5al +r8z1ar r8zerd r6z5erf rz8erh rz4t3h r8zum \n{r"a4ste} \n{r"au8sc} +\n{r1"of} \n{5r"ohr} \n{r"o5le} \n{3r"oll} \n{5r"omis} \n{r1"or} +\n{r"o2sc} \n{3r"ump} 1sa. 1saa s3a4ben sa2bl 2s1abs 6s1abt 6sabw +3sack. 6s3a4der 1saf sa1fa 4s1aff sa5fr 1sag 1sai sa1i2k1 4s1akt 1sal +sa1la 4s3alpi 6salter salz3a 1sam s5anb san2c 1sand s5angeh 6sanl +2s1ans 6s3antr 8s1anw s1ap s6aph 8sapo sap5p6 s8ar. 2s1arb 3sarg +s1arm sa5ro 2s1art 6s1arz 1sas 1sat sat8a 2s1atl sa8tom 3s8aue s5auff +sau5i s6aur 2s1aus 5s6ause 2s1b2 2sca s4ce 8sch. 3scha. 5schade +3schaf 3schal sch5ame 8schanc 8schb 1sche 6schef 8schex 2schf 2schg +2schh 1schi 2schk 5schlag 5schlu \n{6schm"a\3} \n{\c{6schm"a\9}} +6schna\3 \c{6schna\9} 1scho 6schord 6schp 3schri 8schric 8schrig +8schrou 6schs 2scht sch3ta sch3tr 1schu 8schunt 6schv 2schz \n{5sch"o} +\n{5sch"u} 2sco scre6 6scu 2s1d 1se se5an se1ap se6ben se5ec see5i6g +se3erl 8seff se6han se8hi \n{se8h"o} 6s5eid. 2s1eig s8eil 5sein. +sei5n6e 6s5einh 3s8eit 3sel. se4lar selb4 6s3e4lem se8lerl 2s1emp +sen3ac se5nec 6s5ents 4sentz s8er. se8reim ser5inn \n{8serm"a} +8s5erzi \n{6ser"of} se1um 8sexa 6sexp 2s1f2 sfal8ler 2s3g2 sge5b2 s1h +s8hew 5s6hip 5s4hop 1si 2siat si1b sicht6s 6s5i6dee siege6s5 si1en +si5err si1f2 si1g2n si6g5r si8kau sik1i si4kin si2kl \n{si8k"u} si1la +sil6br si1na 2s1inf sin5gh 2s1inh sinne6s5 2s1ins si5ru si5str 4s1j +s1k2 6sk. 2skau skel6c skelch5 s6kele 1s2ki. 3s4kin. s6kiz s8kj +6skn 2skow 3skrib 3skrip 2sku \n{8sk"u} s1l s8lal slei3t s4low 2s1m +s1n 6sna 6snot 1so so1ch 2s1odo so4dor 6s5o4fen solo3 s2on so5of 4sope +so1ra 2s1ord 4sorga sou5c so3un 4s3ox sp2 8spaa 5spal 1span 2spap +s2pec s4peis 1spek s6perg 4spers s6pes 2s1pf 8sphi \n{1s2ph"a} 1spi +spi4e 6s5pig 6spinse 2spis 2spla 2spol 5s6pom 6s5pos 6spoti 1spra +3s8prec 6spreis 5spring 6sprob 1spru s2pul 1s2pur 6spy \n{5sp"an} +\n{1sp"u} s1q 2s1r 2s1s2 sse8nu ssini6s ssoi6r 2st. 1sta 4stafe 2stag +sta3la 6stale 4stalg 8stalk 8stamt 6st5anf 4stans 6stanw 6starb sta4te +6staus 2stb 6stc 6std 1ste 4steil 3s2tel st3elb 8stemb 6steppi 8stese +8stesse 6stf 2stg 2sth st1ha st3hei s8t1hi st1ho st5hu 1sti sti4el +4stigm sti3na 6stind 4stinf sti8r 2stk 2stl 2stm 1sto 6stoll. 4st3ope +6stopf. 6stord 6stp 5stra. 4strai 3s4tral 6s5traum 3stra\3 +\c{3stra\9} 3strec 6s3tref 8streib 5streif 6streno 6stres 6strev +5s6tria 6strig 5strik 8strisi 3s4troa s8troma st5rose 4struf 3strum +\n{6str"ag} 2st1s6 2stt 1stu stu5a 4stuc 2stue 8stun. 2stv 2stw s2tyl +6stz \n{1st"a} \n{8st"ag} \n{1st"o} \n{1st"u} \n{8st"uch} \n{4st"ur.} +1su su2b1 3suc su1e su2fe su8mar 6sumfa 8sumk 2s1unt sup1p2 6s5u6ran +6surte 2s1v 2s1w 1sy 8syl. sy5la syn1 sy2na syne4 s1z s4zend 5s6zene. +8szu \n{1s"a} \n{6s5"and} \n{6s"augi} \n{6s"au\3} \n{\c{6s"au\9}} +\n{5s"om} \n{2s1"u2b} \n{1s"uc} \n{s"u8di} \n{1s"un} \n{5s"u\3} +\n{\c{5s"u\9}} taats3 4tab. taba6k ta8ban tab2l ta6bre 4tabs t3absc +8tabz 6t3acht ta6der 6tadr tad6s tad2t 1tafe4 1tag ta6ga6 ta8gei +tage4s tag6s5t tah8 tahl3 tai6ne. ta5ir. tak8ta tal3au 1tale ta8leng +tal5ert 6t5a6mer 6tamp tampe6 2t1amt tan5d6a tan8dr tands5a tani5e +6tanl 2tanr t3ans 8t5antr tanu6 t5anw 8tanwa tan8zw ta8rau 6tarbe +1tari 2tark 2t1arm ta1ro 2tart t3arti 6tarz ta1sc ta6sien ta8stem +ta8sto t5aufb 4taufn 8taus. 5tause 8tausf 6tausg t5ausl 2t1b2 2t1c +t6chu 2t1d te2am tea4s te8ben 5techn 4teff te4g3re te6hau 2tehe te4hel +2t1ehr te5id. teig5l 6teign tei8gr 1teil 4teinh t5einhe 4teis t5eisen +8teiw te8lam te4lar 4telek 8telem te6man te6n5ag ten8erw ten5k tens4p +ten8tro 4t3entw 8tentz te6pli 5teppi ter5a6b te3ral ter5au 8terbar +t5erbe. 6terben 8terbs 4t3erbt t5erde. ter5ebe ter5ein te8rers terf4 +\n{8terh"o} \n{6terkl"a} ter8nor ter6re. t8erscha t5e6sel te8stau +t3euro te1xa tex3e 8texp tex6ta 2t1f2 2t1g2 2th. th6a 5tha. 2thaa +6t1hab 6t5haf t5hah 8thak 3thal. 6thals 6t3hand 2t1hau 1the. 3t4hea +t1heb t5heil t3heit t3helf 1theo 5therap 5therf 6t5herz 1thes 1thet +5thi. 2t1hil t3him 8thir 3this t5hj 2th1l 2th1m th1n t5hob t5hof +4tholz 6thopti 1thr6 4ths t1hum 1thy \n{4t1h"a} \n{2t1h"o} \n{t1h"u} +ti1a2m ti1b tie6fer ti1en ti8gerz tig3l ti8kin ti5lat 1tilg t1ind +tin4k3l ti3spa ti5str 5tite ti5tr ti8vel ti8vr 2t1j 2t1k2 2t1l tl8a +2t1m8 2t1n 3tobe 8tobj to3cha 5tocht 8tock tode4 to8del to8du to1e +6t5o6fen to1in toi6r 5toll. to8mene t2ons 2t1ony to4per 5topf. 6topt +to1ra to1s to6ska tos2l 2toti to1tr t8ou 2t1p2 6t1q tr6 tra5cha +tra8far traf5t 1trag tra6gl tra6gr t3rahm 1trai t6rans tra3sc tra6st +3traue t4re. 2trec t3rech t8reck 6t1red t8ree 4t1reg 3treib 4treif +8t3reis 8trepo tre6t5r t3rev 4t3rez 1trib t6rick tri6er 2trig t8rink +tri6o5d trizi5 tro1a 3troc trocke6 troi8d tro8man. tro3ny 5tropf +6t5rosa t5ro\3 \c{t5ro\9} 5trub 5trup trut5 \n{1tr"ag} \n{6t1r"oh} +\n{5tr"ub} \n{tr"u3bu} \n{t1r"uc} \n{t1r"us} 2ts ts1ab t1sac tsa8d +ts1ak t6s5alt ts1an ts1ar ts3auf t3schr \n{t5sch"a} tse6e tsee5i +tsein6s ts3ent ts1er t8serf t4serk t8sh 5t6sik t4s3int ts5ort. +t5s6por t6sprei t1st t6s5tanz ts1th t6stit t4s3tor 1t2sua t2s1uf +t8sum. t2s1u8n t2s1ur 2t1t tt5eif tte6sa tt1ha tt8ret tt1sc tt8ser +tt5s6z 1tuc tuch5a 1tu1e 6tuh t5uhr tu1i tu6it 1tumh 6t5umr 1tums +8tumt 6tund 6tunf 2t1unt tu5ra tu6rau tu6re. tu4r3er 2t1v 2t1w 1ty1 +ty6a ty8la 8tym 6ty6o 2tz tz5al tz1an tz1ar t8zec tzeh6 tzehn5 t6z5ei. +t6zor t4z3um \n{t6z"au} \n{5t"ag} \n{6t"ah} \n{t5"alt} \n{t8"an} +\n{t"are8} \n{8t"a8st} \n{6t"au\3} \n{\c{6t"au\9}} \n{t5"offen} +\n{8t"o8k} \n{1t"on} \n{4t"ub} \n{t6"u5ber.} \n{5t"uch} \n{1t"ur.} +u3al. u5alb u5alf u3alh u5alk u3alp u3an. ua5na u3and u5ans u5ar. +ua6th u1au ua1y u2bab ubi5er. u6b5rit ubs2k \n{u5b"o} \n{u8b"ub} 2uc +u1che u6ch5ec u1chi uch1l uch3m uch5n uch1r uch5to ucht5re u1chu uch1w +uck1a uck5in u1d ud4a u1ei u6ela uene8 u6ep u1er uer1a ue8rerl uer5o +u8esc u2est u8ev u1fa u2f1ei u4f3ent u8ferh uf1fr uf1l uf1ra uf1re +\n{uf1r"a} \n{uf1r"u} uf1s2p uf1st uft1s u8gabt u8gad u6gap ugeb8 u8gn +ugo3s4 u1ha u1he u1hi uh1le u1ho uh1re u1hu uh1w \n{u1h"a} \n{u1h"o} +6ui ui5en u1ig u3ins uin8tes u5isch. u1j 6uk u1ke u1ki u1kl u8klu +u1k6n u5ky u1la uld8se u1le ul8lac ul6lau ul6le6l ul6lo ulni8 u1lo +ulo6i ult6a ult8e u1lu ul2vr \n{u1l"a} \n{u1l"o} 3umfan 5umlau umo8f +um8pho u1mu umu8s \n{u5m"o} u1n1a un2al un6at unau2 6und. 5undein +un4d3um 3undzw \n{und"u8} \n{un8d"ub} une2b un1ec une2h un3eis 3unfal +\n{1unf"a} 5ungea \n{3ungl"u} ung2s1 \n{un8g"a} 1u2nif un4it un8kro +unk5s u1no unpa2 uns2p unvol4 unvoll5 u5os. u1pa u1pi u1p2l u1pr +up4s3t up2t1a u1q u1ra ur5abs ura8d ur5ah u6rak ur3alt u6rana u6r5ans +u8rap ur5a6ri u8ratt u1re ur3eig ur8gri u1ri ur5ins 3urlau urmen6 +ur8nan u1ro 3ursac ur8sau ur8sei ur4sk 3urtei u1ru uru5i6 uru6r u1ry +ur2za \n{ur6z"a} \n{ur5"a6m} \n{u5r"o} \n{u1r"u} \n{ur"uck3} u1sa +usa4gi u2s1ar u2s1au u8schec usch5wi u2s1ei use8kel u8sl u4st3a4b +us3tau u3s4ter u2s1uf u8surn ut1ac u1tal uta8m u1tan ut1ar u1tas ut1au +u1te u8teic u4tent u8terf u6terin u4t3hei ut5ho ut1hu u1ti utine5 +uti6q u1to uto5c u1tr ut1sa ut1s6p ut6stro u1tu utz5w u1u u1v uve5n +\n{uve3r4"a} u1w u1xe u5ya uy5e6 u1yi u2z1eh u8zerh \n{u5"o} u\3e6n +\c{u\9e6n} u\3en5e \c{u\9en5e} 8vanb 6vang 6varb var8d va6t5a va8tei +va2t1r 2v1b 6v5c 6vd 1ve 6ve5g6 ver1 ver5b verb8l ve2re2 verg8 ve2ru8 +ve1s ve2s3p ve3xe 2v1f 2v1g 6v5h vi6el vie6w5 vi1g4 vi8leh vil6le. +8vint vi1ru vi1tr 2v1k 2v1l 2v1m 4v5n 8vo8f voi6le vol8lend vol8li +v2or1 vo2re vo8rin vo2ro 2v1p 8vra v6re 2v1s 2v1t 2v1v 4v3w 2v1z +waffe8 wa6g5n 1wah wah8n wa5la wal8din wal6ta wan4dr 5ware wa8ru +war4za 1was w5c w1d 5wech we6fl 1weg we8geng weg5h weg3l we2g1r +weh6r5er 5weise weit3r wel2t welt3r we6rat 8werc 5werdu wer4fl 5werk. +wer4ka wer8ku wer4ta wer8term we2sp we8stend we6steu we8str +\n{we8st"o} wet8ta wich6s5t 1wid wi2dr wiede4 wieder5 wik6 wim6ma +win4d3r 5wirt wisch5l 1wj 6wk 2w1l 8w1n wo1c woche6 wol6f wor6t5r 6ws2 +w1sk 6w5t 5wunde. wun6gr wu1sc wu2t1 6w5w wy5a \n{w"arme5} \n{w"a1sc} +1xag x1ak x3a4men 8xamt x1an 8x1b x1c 1xe. x3e4g 1xen xe1ro x1erz +1xes 8xf x1g 8x1h 1xi 8xid xi8so 4xiste x1k 6x1l x1m 8xn 1xo 8x5o6d +8x3p2 x1r x1s6 8x1t x6tak x8terf x2t1h 1xu xu1e x5ul 6x3w x1z 5ya. +y5an. y5ank y1b y1c y6cha y4chia y1d yen6n y5ern y1g y5h y5in y1j +y1k2 y1lak yl1al yla8m y5lax y1le y1lo y5lu y8mn ym1p2 y3mu y1na yno2d +yn1t y1on. y1o4p y5ou ypo1 y1pr y8ps y1r yri3e yr1r2 y1s ys5iat ys8ty +y1t y3w y1z \n{y"a8m} z5a6b zab5l 8za6d 1zah za5is 4z3ak 6z1am 5zange. +8zanl 2z1ara 6z5as z5auf 3zaun 2z1b 6z1c 6z1d 1ze ze4dik 4z3eff 8zein +zei4ta zei8ters ze6la ze8lec zel8th 4zemp 6z5engel zen8zin \n{8zerg"a} +zer8i ze1ro zers8 zerta8 zer8tab zer8tag 8zerz ze8ste zeu6gr 2z1ex +2z1f8 z1g 4z1h 1zi zi1en zi5es. 4z3imp zi1na 6z5inf 6z5inni zin6s5er +8zinsuf zist5r zi5th zi1tr 6z1j 2z1k 2z1l 2z1m 6z1n 1zo zo6gl 4z3oh +zo1on zor6na8 4z1p z5q 6z1r 2z1s8 2z1t z4t3end z4t3hei z8thi 1zu zu3al +zu1b4 zu1f2 6z5uhr zun2a 8zunem zunf8 8zungl zu1o zup8fi zu1s8 zu1z +2z1v zw8 z1wal 5zweck zwei3s z1wel z1wer z6werg 8z5wes 1zwi zwi1s +6z1wo 1zy 2z1z zz8a zzi1s \n{1z"a} \n{1z"o} \n{6z"ol.} \n{z"o1le} +\n{1z"u} \n{2z1"u2b} \n{"a1a6} \n{"ab1l} \n{"a1che} \n{"a3chi} +\n{"ach8sc} \n{"ach8sp} \n{"a5chu} \n{"ack5a} \n{"ad1a} \n{"ad5era} +\n{"a6d5ia} \n{"a1e} \n{"a5fa} \n{"af1l} \n{"aft6s} \n{"ag1h} +\n{"ag3le} \n{"a6g5nan} \n{"ag5str} \n{"a1he} \n{"a1hi} \n{"ah1le} +\n{"ah5ne} \n{1"ahnl} \n{"ah1re} \n{"ah5ri} \n{"ah1ru} \n{"a1hu} +\n{"ah1w} \n{6"ai} \n{"a1isc} \n{"a6ische} \n{"a5ism} \n{"a5j} +\n{"a1k} \n{"al1c} \n{"a1le} \n{"a8lei} \n{"al6schl} \n{"ami1e} +\n{"am8n} \n{"am8s} \n{"a5na} \n{5"anderu} \n{"ane5i8} \n{"ang3l} +\n{"ank5l} \n{"a1no} \n{"an6s5c} \n{"a1pa} \n{"ap6s5c} \n{3"aq} +\n{"ar1c} \n{"a1re} \n{"are8m} \n{5"argern} \n{"ar6gl} \n{"a1ri} +\n{3"armel} \n{"a1ro} \n{"art6s5} \n{"a1ru} \n{3"arztl} \n{"a5r"o} +\n{"a6s5chen} \n{"asen8s} \n{"as1th} \n{"ata8b} \n{"a1te} \n{"ateri4} +\n{"ater5it} \n{"a6thy} \n{"a1ti} \n{3"atk} \n{"a1to} \n{"at8schl} +\n{"ats1p} \n{"a5tu} \n{"aub1l} \n{"au1e} \n{1"aug} \n{"au8ga} +\n{"au5i} \n{"a1um.} \n{"a1us.} \n{1"au\3} \n{\c{1"au\9}} \n{"a1z} +\n{"o1b} \n{"o1che} \n{"o5chi} \n{"och8stei} \n{"och8str} \n{"ocht6} +\n{5"o6dem} \n{5"offn} \n{"o1he} \n{"oh1l8} \n{"oh1re} \n{"o1hu} +\n{"o1is} \n{"o1ke} \n{1"o2ko} \n{1"ol.} \n{"ol6k5l} \n{"ol8pl} +\n{"o1mu} \n{"o5na} \n{"onig6s3} \n{"o1no} \n{"o5o6t} \n{"opf3l} +\n{"op6s5c} \n{"o1re} \n{"or8gli} \n{"o1ri} \n{"or8tr} \n{"o1ru} +\n{5"osterr} \n{"o1te} \n{"o5th} \n{"o1ti} \n{"o1tu} \n{"o1v} \n{"o1w} +\n{"owe8} \n{"o2z} \n{"ub6e2} \n{3"u4ber1} \n{"ub1l} \n{"ub1r} +\n{5"u2bu} \n{"u1che} \n{"u1chi} \n{"u8ch3l} \n{"uch6s5c} \n{"u8ck} +\n{"uck1a} \n{"uck5ers} \n{"ud1a2} \n{"u6deu} \n{"udi8t} \n{"u2d1o4} +\n{"ud5s6} \n{"uge4l5a} \n{"ug1l} \n{"uh5a} \n{"u1he} \n{"u8heh} +\n{"u6h5erk} \n{"uh1le} \n{"uh1re} \n{"uh1ru} \n{"u1hu} \n{"uh1w} +\n{"u3k} \n{"u1le} \n{"ul4l5a} \n{"ul8lo} \n{"ul4ps} \n{"ul6s5c} +\n{"u1lu} \n{"un8da} \n{"un8fei} \n{"unk5l} \n{"un8za} \n{"un6zw} +\n{"u5pi} \n{"u1re} \n{"u8rei} \n{"ur8fl} \n{"ur8fr} \n{"ur8geng} +\n{"u1ri} \n{"u1ro} \n{"ur8sta} \n{"ur8ster} \n{"u1ru} \n{"use8n} +\n{"u8sta} \n{"u8stes} \n{"u6s5tete} \n{"u3ta} \n{"u1te} \n{"u1ti} +\n{"ut8tr} \n{"u1tu} \n{"ut8zei} \n{"u1v} \31a8 \c{\91a8} 5\3a. +\c{5\9a.} \38as \c{\98as} \31b8 \c{\91b8} \31c \c{\91c} \31d \c{\91d} +1\3e \c{1\9e} \35ec \c{\95ec} 8\3e8g \c{8\9e8g} 8\3e8h \c{8\9e8h} +2\31ei \c{2\91ei} 8\3em \c{8\9em} \31f8 \c{\91f8} \31g \c{\91g} \31h +\c{\91h} 1\3i \c{1\9i} \31k \c{\91k} \31l \c{\91l} \31m \c{\91m} +\3mana8 \c{\9mana8} \31n \c{\91n} \31o \c{\91o} \31p8 \c{\91p8} \35q +\c{\95q} \31r \c{\91r} \31s2 \c{\91s2} \3st8 \c{\9st8} \31ta \c{\91ta} +\31te \c{\91te} \3t3hei \c{\9t3hei} \31ti \c{\91ti} \35to \c{\95to} +\31tr \c{\91tr} 1\3u8 \c{1\9u8} 6\35um \c{6\95um} \31v \c{\91v} \31w +\c{\91w} \31z \c{\91z} +}% +\endgroup +\relax\endinput +% +% ----------------------------------------------------------------- +% +% =============== Additional Documentation =============== +% +% +% Older Versions of German Hyphenation Patterns: +% ---------------------------------------------- +% +% All older versions of `ghyphen.tex' distributed as +% +% ghyphen.tex/germhyph.tex as of 1986/11/01 +% ghyphen.min/ghyphen.max as of 1988/10/10 +% ghyphen3.tex as of 1990/09/27 & 1991/02/13 +% ghyph31.tex as of 1994/02/13 +% +% are out of date and it is recommended to replace them +% with the new version `dehypht.tex' as of 1999/03/03. +% +% If you are using `ghyphen.min' (a minor version of `ghyphen') +% because of limited trie memory space, try this version and if +% the space is exceeded get a newer TeX implementation with +% larger or configurable trie memory sizes. +% +% +% +% Trie Memory Requirements/Space for Hyphenation Patterns: +% -------------------------------------------------------- +% +% To load this set of german hyphenation patterns the parameters +% of TeX has to have at least these values: +% +% TeX 3.x: +% IniTeX: trie_size >= 9733 trie_op_size >= 207 +% VirTeX: trie_size >= 8375 trie_op_size >= 207 +% +% TeX 2.x: +% IniTeX: trie_size >= 8675 trie_op_size >= 198 +% VirTeX: trie_size >= 7560 trie_op_size >= 198 +% +% If you want to load more than one set of hyphenation patterns +% (in TeX 3.x), the parameters have to be set to a value larger +% than or equal to the sum of all required values for each set. +% +% +% Setting Trie Memory Parameters: +% ------------------------------- +% +% Some implementations allow the user to change the default value +% of a set of the internal TeX parameters including the trie memory +% size parameter specifying the used memory for the hyphenation +% patterns. +% +% Web2c 7.x (Source), teTeX 0.9 (Unix, Amiga), fpTeX (Win32) +% and newer: +% The used memory size of the true is usually set high enough. +% If needed set the size of the trie using the keyword `trie_size' +% in the configuration file `texmf/web2c/texmf.cnf'. For details +% see the included documentation. +% +% emTeX (OS/2, MS-DOS, Windows 3.x/9x/NT): +% You can set the used memory size of the trie using the +% `-mt' option on the command line or in the +% TEXOPTIONS environment variable. +% +% PasTeX (Amiga): +% The values for the parameters can be set using the keywords +% `triesize', `itriesize' and `trieopsize' in the configuration +% file. +% +% others (binaries only): +% See the documentation of the implementation if it is possible +% and how to change these values without recompilation. +% +% others (with sources) +% If the trie memory is too small, you have to recompile TeX +% using larger values for `trie_size' and `trie_op_size'. +% Modify the change file `tex.ch' and recompile TeX. +% For details see the documentation included in the sources. +% +% +% +% Necessary Settings in TeX macro files: +% -------------------------------------- +% +% \lefthyphenmin, \righthyphenmin: +% You can set both parameters to 2. +% +% \lccode : +% To get correct hyphenation points within words containing +% umlauts or \ss, it's necessary to assign values > 0 to the +% appropriate \lccode positions. +% +% These changes are _not_ done when reading this file and have to +% be included in the language switching mechanism as is done in, +% for example, `german.sty' (\lccode change for ^^Y = \ss in OT1, +% \left-/\righthyphenmin settings). +% +% +%% \CharacterTable +%% {Upper-case \A\B\C\D\E\F\G\H\I\J\K\L\M\N\O\P\Q\R\S\T\U\V\W\X\Y\Z +%% Lower-case \a\b\c\d\e\f\g\h\i\j\k\l\m\n\o\p\q\r\s\t\u\v\w\x\y\z +%% Digits \0\1\2\3\4\5\6\7\8\9 +%% Exclamation \! Double quote \" Hash (number) \# +%% Dollar \$ Percent \% Ampersand \& +%% Acute accent \' Left paren \( Right paren \) +%% Asterisk \* Plus \+ Comma \, +%% Minus \- Point \. Solidus \/ +%% Colon \: Semicolon \; Less than \< +%% Equals \= Greater than \> Question mark \? +%% Commercial at \@ Left bracket \[ Backslash \\ +%% Right bracket \] Circumflex \^ Underscore \_ +%% Grave accent \` Left brace \{ Vertical bar \| +%% Right brace \} Tilde \~} +%% +\endinput +%% +%% End of file `dehypht.tex'. diff --git a/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/eshyph_vo.tex b/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/eshyph_vo.tex new file mode 100644 index 0000000..e15bdc3 --- /dev/null +++ b/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/eshyph_vo.tex @@ -0,0 +1,1104 @@ +.\'a2 +.\'aa2 +.\'ae2 +.\'ai2 +.\'ao2 +.\'au2 +.\'e2 +.\'ea2 +.\'ee2 +.\'ei2 +.\'eo2 +.\'eu2 +.\'i2 +.\'ia2 +.\'ie2 +.\'ii2 +.\'io2 +.\'iu2 +.\'o2 +.\'oa2 +.\'oe2 +.\'oi2 +.\'oo2 +.\'ou2 +.\'u2 +.\'ua2 +.\'ue2 +.\'ui2 +.\'uo2 +.\'uu2 +.a2 +.a\'a2 +.a\'e2 +.a\'i2 +.a\'o2 +.a\'u2 +.aa2 +.ae2 +.ai2 +.ao2 +.au2 +.e2 +.e\'a2 +.e\'e2 +.e\'i2 +.e\'o2 +.e\'u2 +.ea2 +.ee2 +.ei2 +.eo2 +.eu2 +.i2 +.i\'a2 +.i\'e2 +.i\'i2 +.i\'o2 +.i\'u2 +.ia2 +.ie2 +.ii2 +.io2 +.iu2 +.o2 +.o\'a2 +.o\'e2 +.o\'i2 +.o\'o2 +.o\'u2 +.oa2 +.oe2 +.oi2 +.oo2 +.ou2 +.u2 +.u\'a2 +.u\'e2 +.u\'i2 +.u\'o2 +.u\'u2 +.ua2 +.ue2 +.ui2 +.uo2 +.uu2 +2\'a. +2\'aa. +2\'ae. +2\'ai. +2\'ao. +2\'au. +2\'e. +2\'ea. +2\'ee. +2\'ei. +2\'eo. +2\'eu. +2\'i. +2\'ia. +2\'ie. +2\'ii. +2\'io. +2\'iu. +2\'o. +2\'oa. +2\'oe. +2\'oi. +2\'oo. +2\'ou. +2\'u. +2\'ua. +2\'ue. +2\'ui. +2\'uo. +2\'uu. +2\~n1\~n +2\~n1b +2\~n1c +2\~n1d +2\~n1f +2\~n1g +2\~n1h +2\~n1j +2\~n1k +2\~n1m +2\~n1n +2\~n1p +2\~n1q +2\~n1s +2\~n1t +2\~n1v +2\~n1w +2\~n1x +2\~n1y +2\~n1z +2a. +2a\'a. +2a\'e. +2a\'i. +2a\'o. +2a\'u. +2aa. +2ae. +2ai. +2ao. +2au. +2b1\~n +2b1b +2b1c +2b1d +2b1f +2b1g +2b1h +2b1j +2b1k +2b1m +2b1n +2b1p +2b1q +2b1s +2b1t +2b1v +2b1w +2b1x +2b1y +2b1z +2c1\~n +2c1b +2c1c +2c1d +2c1f +2c1g +2c1j +2c1k +2c1m +2c1n +2c1p +2c1q +2c1s +2c1t +2c1v +2c1w +2c1x +2c1y +2c1z +2d1\~n +2d1b +2d1c +2d1d +2d1f +2d1g +2d1h +2d1j +2d1k +2d1m +2d1n +2d1p +2d1q +2d1s +2d1t +2d1v +2d1w +2d1x +2d1y +2d1z +2e. +2e\'a. +2e\'e. +2e\'i. +2e\'o. +2e\'u. +2ea. +2ee. +2ei. +2eo. +2eu. +2f1\~n +2f1b +2f1c +2f1d +2f1f +2f1g +2f1h +2f1j +2f1k +2f1m +2f1n +2f1p +2f1q +2f1s +2f1t +2f1v +2f1w +2f1x +2f1y +2f1z +2g1\~n +2g1b +2g1c +2g1d +2g1f +2g1g +2g1h +2g1j +2g1k +2g1m +2g1n +2g1p +2g1q +2g1s +2g1t +2g1v +2g1w +2g1x +2g1y +2g1z +2h1\~n +2h1b +2h1c +2h1d +2h1f +2h1g +2h1h +2h1j +2h1k +2h1m +2h1n +2h1p +2h1q +2h1s +2h1t +2h1v +2h1w +2h1x +2h1y +2h1z +2i. +2i\'a. +2i\'e. +2i\'i. +2i\'o. +2i\'u. +2ia. +2ie. +2ii. +2io. +2iu. +2j1\~n +2j1b +2j1c +2j1d +2j1f +2j1g +2j1h +2j1j +2j1k +2j1m +2j1n +2j1p +2j1q +2j1s +2j1t +2j1v +2j1w +2j1x +2j1y +2j1z +2k1\~n +2k1b +2k1c +2k1d +2k1f +2k1g +2k1h +2k1j +2k1k +2k1m +2k1n +2k1p +2k1q +2k1s +2k1t +2k1v +2k1w +2k1x +2k1y +2k1z +2l1\~n +2l1b +2l1c +2l1d +2l1f +2l1g +2l1h +2l1j +2l1k +2l1m +2l1n +2l1p +2l1q +2l1s +2l1t +2l1v +2l1w +2l1x +2l1y +2l1z +2m1\~n +2m1b +2m1c +2m1d +2m1f +2m1g +2m1h +2m1j +2m1k +2m1l +2m1m +2m1n +2m1p +2m1q +2m1r +2m1s +2m1t +2m1v +2m1w +2m1x +2m1y +2m1z +2n1\~n +2n1b +2n1c +2n1d +2n1f +2n1g +2n1h +2n1j +2n1k +2n1l +2n1m +2n1n +2n1p +2n1q +2n1r +2n1s +2n1t +2n1v +2n1w +2n1x +2n1y +2n1z +2o. +2o\'a. +2o\'e. +2o\'i. +2o\'o. +2o\'u. +2oa. +2oe. +2oi. +2oo. +2ou. +2p1\~n +2p1b +2p1c +2p1d +2p1f +2p1g +2p1h +2p1j +2p1k +2p1m +2p1n +2p1p +2p1q +2p1s +2p1t +2p1v +2p1w +2p1x +2p1y +2p1z +2q1\~n +2q1b +2q1c +2q1d +2q1f +2q1g +2q1h +2q1j +2q1k +2q1m +2q1n +2q1p +2q1q +2q1s +2q1t +2q1v +2q1w +2q1x +2q1y +2q1z +2r1\~n +2r1b +2r1c +2r1d +2r1f +2r1g +2r1h +2r1j +2r1k +2r1m +2r1n +2r1p +2r1q +2r1s +2r1t +2r1v +2r1w +2r1x +2r1y +2r1z +2s1\~n +2s1b +2s1c +2s1d +2s1f +2s1g +2s1h +2s1j +2s1k +2s1m +2s1n +2s1p +2s1q +2s1s +2s1t +2s1v +2s1w +2s1x +2s1y +2s1z +2t1\~n +2t1b +2t1c +2t1d +2t1f +2t1g +2t1h +2t1j +2t1k +2t1m +2t1n +2t1p +2t1q +2t1s +2t1t +2t1v +2t1w +2t1x +2t1y +2t1z +2u. +2u\'a. +2u\'e. +2u\'i. +2u\'o. +2u\'u. +2ua. +2ue. +2ui. +2uo. +2uu. +2v1\~n +2v1b +2v1c +2v1d +2v1f +2v1g +2v1h +2v1j +2v1k +2v1m +2v1n +2v1p +2v1q +2v1s +2v1t +2v1v +2v1w +2v1x +2v1y +2v1z +2w1\~n +2w1b +2w1c +2w1d +2w1f +2w1g +2w1h +2w1j +2w1k +2w1m +2w1n +2w1p +2w1q +2w1s +2w1t +2w1v +2w1w +2w1x +2w1y +2w1z +2x1\~n +2x1b +2x1c +2x1d +2x1f +2x1g +2x1h +2x1j +2x1k +2x1m +2x1n +2x1p +2x1q +2x1s +2x1t +2x1v +2x1w +2x1x +2x1y +2x1z +2y1\~n +2y1b +2y1c +2y1d +2y1f +2y1g +2y1h +2y1j +2y1k +2y1m +2y1n +2y1p +2y1q +2y1s +2y1t +2y1v +2y1w +2y1x +2y1y +2y1z +2z1\~n +2z1b +2z1c +2z1d +2z1f +2z1g +2z1h +2z1j +2z1k +2z1m +2z1n +2z1p +2z1q +2z1s +2z1t +2z1v +2z1w +2z1x +2z1y +2z1z +\'a1\'i +\'a1\'u +\'a1\~n +\'a1a +\'a1b +\'a1c +\'a1d +\'a1e +\'a1f +\'a1g +\'a1h +\'a1j +\'a1k +\'a1l +\'a1m +\'a1n +\'a1o +\'a1p +\'a1q +\'a1r +\'a1s +\'a1t +\'a1v +\'a1w +\'a1x +\'a1y +\'a1z +\'a2\~n. +\'a2b. +\'a2c. +\'a2d. +\'a2f. +\'a2g. +\'a2h. +\'a2j. +\'a2k. +\'a2l. +\'a2m. +\'a2n. +\'a2p. +\'a2q. +\'a2r. +\'a2s. +\'a2t. +\'a2v. +\'a2w. +\'a2x. +\'a2y. +\'a2z. +\'e1\'i +\'e1\'u +\'e1\~n +\'e1a +\'e1b +\'e1c +\'e1d +\'e1e +\'e1f +\'e1g +\'e1h +\'e1j +\'e1k +\'e1l +\'e1m +\'e1n +\'e1o +\'e1p +\'e1q +\'e1r +\'e1s +\'e1t +\'e1v +\'e1w +\'e1x +\'e1y +\'e1z +\'e2\~n. +\'e2b. +\'e2c. +\'e2d. +\'e2f. +\'e2g. +\'e2h. +\'e2j. +\'e2k. +\'e2l. +\'e2m. +\'e2n. +\'e2p. +\'e2q. +\'e2r. +\'e2s. +\'e2t. +\'e2v. +\'e2w. +\'e2x. +\'e2y. +\'e2z. +\'i1\'a +\'i1\'e +\'i1\'o +\'i1\~n +\'i1a +\'i1b +\'i1c +\'i1d +\'i1e +\'i1f +\'i1g +\'i1h +\'i1j +\'i1k +\'i1l +\'i1m +\'i1n +\'i1o +\'i1p +\'i1q +\'i1r +\'i1s +\'i1t +\'i1v +\'i1w +\'i1x +\'i1y +\'i1z +\'i2\~n. +\'i2b. +\'i2c. +\'i2d. +\'i2f. +\'i2g. +\'i2h. +\'i2j. +\'i2k. +\'i2l. +\'i2m. +\'i2n. +\'i2p. +\'i2q. +\'i2r. +\'i2s. +\'i2t. +\'i2v. +\'i2w. +\'i2x. +\'i2y. +\'i2z. +\'o1\'i +\'o1\'u +\'o1\~n +\'o1a +\'o1b +\'o1c +\'o1d +\'o1e +\'o1f +\'o1g +\'o1h +\'o1j +\'o1k +\'o1l +\'o1m +\'o1n +\'o1o +\'o1p +\'o1q +\'o1r +\'o1s +\'o1t +\'o1v +\'o1w +\'o1x +\'o1y +\'o1z +\'o2\~n. +\'o2b. +\'o2c. +\'o2d. +\'o2f. +\'o2g. +\'o2h. +\'o2j. +\'o2k. +\'o2l. +\'o2m. +\'o2n. +\'o2p. +\'o2q. +\'o2r. +\'o2s. +\'o2t. +\'o2v. +\'o2w. +\'o2x. +\'o2y. +\'o2z. +\'u1\'a +\'u1\'e +\'u1\'o +\'u1\~n +\'u1a +\'u1b +\'u1c +\'u1d +\'u1e +\'u1f +\'u1g +\'u1h +\'u1j +\'u1k +\'u1l +\'u1m +\'u1n +\'u1o +\'u1p +\'u1q +\'u1r +\'u1s +\'u1t +\'u1v +\'u1w +\'u1x +\'u1y +\'u1z +\'u2\~n. +\'u2b. +\'u2c. +\'u2d. +\'u2f. +\'u2g. +\'u2h. +\'u2j. +\'u2k. +\'u2l. +\'u2m. +\'u2n. +\'u2p. +\'u2q. +\'u2r. +\'u2s. +\'u2t. +\'u2v. +\'u2w. +\'u2x. +\'u2y. +\'u2z. +a1\'a +a1\'e +a1\'i +a1\'o +a1\'u +a1\~n +a1a +a1b +a1c +a1d +a1e +a1f +a1g +a1h +a1j +a1k +a1l +a1m +a1n +a1o +a1p +a1q +a1r +a1s +a1t +a1v +a1w +a1x +a1y +a1z +a2\~n. +a2b. +a2c. +a2d. +a2f. +a2g. +a2h. +a2j. +a2k. +a2l. +a2m. +a2n. +a2p. +a2q. +a2r. +a2s. +a2t. +a2v. +a2w. +a2x. +a2y. +a2z. +e1\'a +e1\'e +e1\'i +e1\'o +e1\'u +e1\~n +e1a +e1b +e1c +e1d +e1e +e1f +e1g +e1h +e1j +e1k +e1l +e1m +e1n +e1o +e1p +e1q +e1r +e1s +e1t +e1v +e1w +e1x +e1y +e1z +e2\~n. +e2b. +e2c. +e2d. +e2f. +e2g. +e2h. +e2j. +e2k. +e2l. +e2m. +e2n. +e2p. +e2q. +e2r. +e2s. +e2t. +e2v. +e2w. +e2x. +e2y. +e2z. +i1\~n +i1b +i1c +i1d +i1f +i1g +i1h +i1j +i1k +i1l +i1m +i1n +i1p +i1q +i1r +i1s +i1t +i1v +i1w +i1x +i1y +i1z +i2\~n. +i2b. +i2c. +i2d. +i2f. +i2g. +i2h. +i2j. +i2k. +i2l. +i2m. +i2n. +i2p. +i2q. +i2r. +i2s. +i2t. +i2v. +i2w. +i2x. +i2y. +i2z. +o1\'a +o1\'e +o1\'i +o1\'o +o1\'u +o1\~n +o1a +o1b +o1c +o1d +o1e +o1f +o1g +o1h +o1j +o1k +o1l +o1m +o1n +o1o +o1p +o1q +o1r +o1s +o1t +o1v +o1w +o1x +o1y +o1z +o2\~n. +o2b. +o2c. +o2d. +o2f. +o2g. +o2h. +o2j. +o2k. +o2l. +o2m. +o2n. +o2p. +o2q. +o2r. +o2s. +o2t. +o2v. +o2w. +o2x. +o2y. +o2z. +u1\~n +u1b +u1c +u1d +u1f +u1g +u1h +u1j +u1k +u1l +u1m +u1n +u1p +u1q +u1r +u1s +u1t +u1v +u1w +u1x +u1y +u1z +u2\~n. +u2b. +u2c. +u2d. +u2f. +u2g. +u2h. +u2j. +u2k. +u2l. +u2m. +u2n. +u2p. +u2q. +u2r. +u2s. +u2t. +u2v. +u2w. +u2x. +u2y. +u2z. diff --git a/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/expander-1.3.1.tm b/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/expander-1.3.1.tm new file mode 100644 index 0000000..9ce76d8 --- /dev/null +++ b/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/expander-1.3.1.tm @@ -0,0 +1,1122 @@ +#--------------------------------------------------------------------- +# TITLE: +# expander.tcl +# +# AUTHOR: +# Will Duquette +# +# DESCRIPTION: +# +# An expander is an object that takes as input text with embedded +# Tcl code and returns text with the embedded code expanded. The +# text can be provided all at once or incrementally. +# +# See expander.[e]html for usage info. +# Also expander.n +# +# LICENSE: +# Copyright (C) 2001 by William H. Duquette. See expander_license.txt, +# distributed with this file, for license information. +# +# CHANGE LOG: +# +# 10/31/01: V0.9 code is complete. +# 11/23/01: Added "evalcmd"; V1.0 code is complete. + +# Provide the package. + +# Create the package's namespace. + +namespace eval ::textutil { + namespace eval expander { + # All indices are prefixed by "$exp-". + # + # lb The left bracket sequence + # rb The right bracket sequence + # errmode How to handle macro errors: + # nothing, macro, error, fail. + # evalcmd The evaluation command. + # textcmd The plain text processing command. + # level The context level + # output-$level The accumulated text at this context level. + # name-$level The tag name of this context level + # data-$level-$var A variable of this context level + + variable Info + + # In methods, the current object: + variable This "" + + # Export public commands + namespace export expander + } + + #namespace import expander::* + namespace export expander + + proc expander {name} {uplevel ::textutil::expander::expander [list $name]} +} + +#--------------------------------------------------------------------- +# FUNCTION: +# expander name +# +# INPUTS: +# name A proc name for the new object. If not +# fully-qualified, it is assumed to be relative +# to the caller's namespace. +# +# RETURNS: +# nothing +# +# DESCRIPTION: +# Creates a new expander object. + +proc ::textutil::expander::expander {name} { + variable Info + + # FIRST, qualify the name. + if {![string match "::*" $name]} { + # Get caller's namespace; append :: if not global namespace. + set ns [uplevel 1 namespace current] + if {"::" != $ns} { + append ns "::" + } + + set name "$ns$name" + } + + # NEXT, Check the name + if {"" != [info commands $name]} { + return -code error "command name \"$name\" already exists" + } + + # NEXT, Create the object. + proc $name {method args} [format { + if {[catch {::textutil::expander::Methods %s $method $args} result]} { + return -code error $result + } else { + return $result + } + } $name] + + # NEXT, Initialize the object + Op_reset $name + + return $name +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Methods name method argList +# +# INPUTS: +# name The object's fully qualified procedure name. +# This argument is provided by the object command +# itself. +# method The method to call. +# argList Arguments for the specific method. +# +# RETURNS: +# Depends on the method +# +# DESCRIPTION: +# Handles all method dispatch for a expander object. +# The expander's object command merely passes its arguments to +# this function, which dispatches the arguments to the +# appropriate method procedure. If the method raises an error, +# the method procedure's name in the error message is replaced +# by the object and method names. + +proc ::textutil::expander::Methods {name method argList} { + variable Info + variable This + + switch -exact -- $method { + expand - + lb - + rb - + setbrackets - + errmode - + evalcmd - + textcmd - + cpush - + ctopandclear - + cis - + cname - + cset - + cget - + cvar - + cpop - + cappend - + where - + reset { + # FIRST, execute the method, first setting This to the object + # name; then, after the method has been called, restore the + # old object name. + set oldThis $This + set This $name + + set retval [catch "Op_$method $name $argList" result] + + set This $oldThis + + # NEXT, handle the result based on the retval. + if {$retval} { + regsub -- "Op_$method" $result "$name $method" result + return -code error $result + } else { + return $result + } + } + default { + return -code error "\"$name $method\" is not defined" + } + } +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Get key +# +# INPUTS: +# key A key into the Info array, excluding the +# object name. E.g., "lb" +# +# RETURNS: +# The value from the array +# +# DESCRIPTION: +# Gets the value of an entry from Info for This. + +proc ::textutil::expander::Get {key} { + variable Info + variable This + + return $Info($This-$key) +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Set key value +# +# INPUTS: +# key A key into the Info array, excluding the +# object name. E.g., "lb" +# +# value A Tcl value +# +# RETURNS: +# The value +# +# DESCRIPTION: +# Sets the value of an entry in Info for This. + +proc ::textutil::expander::Set {key value} { + variable Info + variable This + + return [set Info($This-$key) $value] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Var key +# +# INPUTS: +# key A key into the Info array, excluding the +# object name. E.g., "lb" +# +# RETURNS: +# The full variable name, suitable for setting or lappending + +proc ::textutil::expander::Var {key} { + variable Info + variable This + + return ::textutil::expander::Info($This-$key) +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Contains list value +# +# INPUTS: +# list any list +# value any value +# +# RETURNS: +# TRUE if the list contains the value, and false otherwise. + +proc ::textutil::expander::Contains {list value} { + if {[lsearch -exact $list $value] == -1} { + return 0 + } else { + return 1 + } +} + + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_lb ?newbracket? +# +# INPUTS: +# newbracket If given, the new bracket token. +# +# RETURNS: +# The current left bracket +# +# DESCRIPTION: +# Returns the current left bracket token. + +proc ::textutil::expander::Op_lb {name {newbracket ""}} { + if {[string length $newbracket] != 0} { + Set lb $newbracket + } + return [Get lb] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_rb ?newbracket? +# +# INPUTS: +# newbracket If given, the new bracket token. +# +# RETURNS: +# The current left bracket +# +# DESCRIPTION: +# Returns the current left bracket token. + +proc ::textutil::expander::Op_rb {name {newbracket ""}} { + if {[string length $newbracket] != 0} { + Set rb $newbracket + } + return [Get rb] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_setbrackets lbrack rbrack +# +# INPUTS: +# lbrack The new left bracket +# rbrack The new right bracket +# +# RETURNS: +# nothing +# +# DESCRIPTION: +# Sets the brackets as a pair. + +proc ::textutil::expander::Op_setbrackets {name lbrack rbrack} { + Set lb $lbrack + Set rb $rbrack + return +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_errmode ?newErrmode? +# +# INPUTS: +# newErrmode If given, the new error mode. +# +# RETURNS: +# The current error mode +# +# DESCRIPTION: +# Returns the current error mode. + +proc ::textutil::expander::Op_errmode {name {newErrmode ""}} { + if {[string length $newErrmode] != 0} { + if {![Contains "macro nothing error fail" $newErrmode]} { + error "$name errmode: Invalid error mode: $newErrmode" + } + + Set errmode $newErrmode + } + return [Get errmode] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_evalcmd ?newEvalCmd? +# +# INPUTS: +# newEvalCmd If given, the new eval command. +# +# RETURNS: +# The current eval command +# +# DESCRIPTION: +# Returns the current eval command. This is the command used to +# evaluate macros; it defaults to "uplevel #0". + +proc ::textutil::expander::Op_evalcmd {name {newEvalCmd ""}} { + if {[string length $newEvalCmd] != 0} { + Set evalcmd $newEvalCmd + } + return [Get evalcmd] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_textcmd ?newTextCmd? +# +# INPUTS: +# newTextCmd If given, the new text command. +# +# RETURNS: +# The current text command +# +# DESCRIPTION: +# Returns the current text command. This is the command used to +# process plain text. It defaults to {}, meaning identity. + +proc ::textutil::expander::Op_textcmd {name args} { + switch -exact [llength $args] { + 0 {} + 1 {Set textcmd [lindex $args 0]} + default { + return -code error "wrong#args for textcmd: name ?newTextcmd?" + } + } + return [Get textcmd] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_reset +# +# INPUTS: +# none +# +# RETURNS: +# nothing +# +# DESCRIPTION: +# Resets all object values, as though it were brand new. + +proc ::textutil::expander::Op_reset {name} { + variable Info + + if {[info exists Info($name-lb)]} { + foreach elt [array names Info "$name-*"] { + unset Info($elt) + } + } + + set Info($name-lb) "\[" + set Info($name-rb) "\]" + set Info($name-errmode) "fail" + set Info($name-evalcmd) "uplevel #0" + set Info($name-textcmd) "" + set Info($name-level) 0 + set Info($name-output-0) "" + set Info($name-name-0) ":0" + + return +} + +#------------------------------------------------------------------------- +# Context: Every expansion takes place in its own context; however, +# a macro can push a new context, causing the text it returns and all +# subsequent text to be saved separately. Later, a matching macro can +# pop the context, acquiring all text saved since the first command, +# and use that in its own output. + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_cpush cname +# +# INPUTS: +# cname The context name +# +# RETURNS: +# nothing +# +# DESCRIPTION: +# Pushes an empty macro context onto the stack. All expanded text +# will be added to this context until it is popped. + +proc ::textutil::expander::Op_cpush {name cname} { + # FRINK: nocheck + incr [Var level] + # FRINK: nocheck + set [Var output-[Get level]] {} + # FRINK: nocheck + set [Var name-[Get level]] $cname + + # The first level is init'd elsewhere (Op_expand) + if {[set [Var level]] < 2} return + + # Initialize the location information, inherit from the outer + # context. + + LocInit $cname + catch {LocSet $cname [LocGet $name]} + return +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_cis cname +# +# INPUTS: +# cname A context name +# +# RETURNS: +# true or false +# +# DESCRIPTION: +# Returns true if the current context has the specified name, and +# false otherwise. + +proc ::textutil::expander::Op_cis {name cname} { + return [expr {[string compare $cname [Op_cname $name]] == 0}] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_cname +# +# INPUTS: +# none +# +# RETURNS: +# The context name +# +# DESCRIPTION: +# Returns the name of the current context. + +proc ::textutil::expander::Op_cname {name} { + return [Get name-[Get level]] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_cset varname value +# +# INPUTS: +# varname The name of a context variable +# value The new value for the context variable +# +# RETURNS: +# The value +# +# DESCRIPTION: +# Sets a variable in the current context. + +proc ::textutil::expander::Op_cset {name varname value} { + Set data-[Get level]-$varname $value +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_cget varname +# +# INPUTS: +# varname The name of a context variable +# +# RETURNS: +# The value +# +# DESCRIPTION: +# Returns the value of a context variable. It's an error if +# the variable doesn't exist. + +proc ::textutil::expander::Op_cget {name varname} { + if {![info exists [Var data-[Get level]-$varname]]} { + error "$name cget: $varname doesn't exist in this context ([Get level])" + } + return [Get data-[Get level]-$varname] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_cvar varname +# +# INPUTS: +# varname The name of a context variable +# +# RETURNS: +# The index to the variable +# +# DESCRIPTION: +# Returns the index to a context variable, for use with set, +# lappend, etc. + +proc ::textutil::expander::Op_cvar {name varname} { + if {![info exists [Var data-[Get level]-$varname]]} { + error "$name cvar: $varname doesn't exist in this context" + } + + return [Var data-[Get level]-$varname] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_cpop cname +# +# INPUTS: +# cname The expected context name. +# +# RETURNS: +# The accumulated output in this context +# +# DESCRIPTION: +# Returns the accumulated output for the current context, first +# popping the context from the stack. The expected context name +# must match the real name, or an error occurs. + +proc ::textutil::expander::Op_cpop {name cname} { + variable Info + + if {[Get level] == 0} { + error "$name cpop underflow on '$cname'" + } + + if {[string compare [Op_cname $name] $cname] != 0} { + error "$name cpop context mismatch: expected [Op_cname $name], got $cname" + } + + set result [Get output-[Get level]] + # FRINK: nocheck + set [Var output-[Get level]] "" + # FRINK: nocheck + set [Var name-[Get level]] "" + + foreach elt [array names "Info data-[Get level]-*"] { + unset Info($elt) + } + + # FRINK: nocheck + incr [Var level] -1 + return $result +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_ctopandclear +# +# INPUTS: +# None. +# +# RETURNS: +# The accumulated output in the topmost context, clears the context, +# but does not pop it. +# +# DESCRIPTION: +# Returns the accumulated output for the current context, first +# popping the context from the stack. The expected context name +# must match the real name, or an error occurs. + +proc ::textutil::expander::Op_ctopandclear {name} { + variable Info + + if {[Get level] == 0} { + error "$name cpop underflow on '[Op_cname $name]'" + } + + set result [Get output-[Get level]] + Set output-[Get level] "" + return $result +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_cappend text +# +# INPUTS: +# text Text to add to the output +# +# RETURNS: +# The accumulated output +# +# DESCRIPTION: +# Appends the text to the accumulated output in the current context. + +proc ::textutil::expander::Op_cappend {name text} { + # FRINK: nocheck + append [Var output-[Get level]] $text +} + +#------------------------------------------------------------------------- +# Macro-expansion: The following code is the heart of the module. +# Given a text string, and the current variable settings, this code +# returns an expanded string, with all macros replaced. + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_expand inputString ?brackets? +# +# INPUTS: +# inputString The text to expand. +# brackets A list of two bracket tokens. +# +# RETURNS: +# The expanded text. +# +# DESCRIPTION: +# Finds all embedded macros in the input string, and expands them. +# If ?brackets? is given, it must be list of length 2, containing +# replacement left and right macro brackets; otherwise the default +# brackets are used. + +proc ::textutil::expander::Op_expand {name inputString {brackets ""}} { + # FIRST, push a new context onto the stack, and save the current + # brackets. + + Op_cpush $name expand + Op_cset $name lb [Get lb] + Op_cset $name rb [Get rb] + + # Keep position information in context variables as well. + # Line we are in, counting from 1; column we are at, + # counting from 0, and index of character we are at, + # counting from 0. Tabs counts as '1' when computing + # the column. + + LocInit $name + + # SF Tcllib Bug #530056. + set start_level [Get level] ; # remember this for check at end + + # NEXT, use the user's brackets, if given. + if {[llength $brackets] == 2} { + Set lb [lindex $brackets 0] + Set rb [lindex $brackets 1] + } + + # NEXT, loop over the string, finding and expanding macros. + while {[string length $inputString] > 0} { + set plainText [ExtractToToken inputString [Get lb] exclude] + + # FIRST, If there was plain text, append it to the output, and + # continue. + if {$plainText != ""} { + set input $plainText + set tc [Get textcmd] + if {[string length $tc] > 0} { + lappend tc $plainText + + if {![catch "[Get evalcmd] [list $tc]" result]} { + set plainText $result + } else { + HandleError $name {plain text} $tc $result + } + } + Op_cappend $name $plainText + LocUpdate $name $input + + if {[string length $inputString] == 0} { + break + } + } + + # NEXT, A macro is the next thing; process it. + if {[catch {GetMacro inputString} macro]} { + # SF tcllib bug 781973 ... Do not throw a regular + # error. Use HandleError to give the user control of the + # situation, via the defined error mode. The continue + # intercepts if the user allows the expansion to run on, + # yet we must not try to run the non-existing macro. + + HandleError $name {reading macro} $inputString $macro + continue + } + + # Expand the macro, and output the result, or + # handle an error. + if {![catch "[Get evalcmd] [list $macro]" result]} { + Op_cappend $name $result + + # We have to advance the location by the length of the + # macro, plus the two brackets. They were stripped by + # GetMacro, so we have to add them here again to make + # computation correct. + + LocUpdate $name [Get lb]${macro}[Get rb] + continue + } + + HandleError $name macro $macro $result + } + + # SF Tcllib Bug #530056. + if {[Get level] > $start_level} { + # The user macros pushed additional contexts, but forgot to + # pop them all. The main work here is to place all the still + # open contexts into the error message, and to produce + # syntactically correct english. + + set c [list] + set n [expr {[Get level] - $start_level}] + if {$n == 1} { + set ctx context + set verb was + } else { + set ctx contexts + set verb were + } + for {incr n -1} {$n >= 0} {incr n -1} { + lappend c [Get name-[expr {[Get level]-$n}]] + } + return -code error \ + "The following $ctx pushed by the macros $verb not popped: [join $c ,]." + } elseif {[Get level] < $start_level} { + set n [expr {$start_level - [Get level]}] + if {$n == 1} { + set ctx context + } else { + set ctx contexts + } + return -code error \ + "The macros popped $n more $ctx than they had pushed." + } + + Op_lb $name [Op_cget $name lb] + Op_rb $name [Op_cget $name rb] + + return [Op_cpop $name expand] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_where +# +# INPUTS: +# None. +# +# RETURNS: +# The current location in the input. +# +# DESCRIPTION: +# Retrieves the current location the expander +# is at during processing. + +proc ::textutil::expander::Op_where {name} { + return [LocGet $name] +} + +#--------------------------------------------------------------------- +# FUNCTION +# HandleError name title command errmsg +# +# INPUTS: +# name The name of the expander object in question. +# title A title text +# command The command which caused the error. +# errmsg The error message to report +# +# RETURNS: +# Nothing +# +# DESCRIPTIONS +# Is executed when an error in a macro or the plain text handler +# occurs. Generates an error message according to the current +# error mode. + +proc ::textutil::expander::HandleError {name title command errmsg} { + switch [Get errmode] { + nothing { } + macro { + # The location is irrelevant here. + Op_cappend $name "[Get lb]$command[Get rb]" + } + error { + foreach {ch line col} [LocGet $name] break + set display [DisplayOf $command] + + Op_cappend $name "\n=================================\n" + Op_cappend $name "*** Error in $title at line $line, column $col:\n" + Op_cappend $name "*** [Get lb]$display[Get rb]\n--> $errmsg\n" + Op_cappend $name "=================================\n" + } + fail { + foreach {ch line col} [LocGet $name] break + set display [DisplayOf $command] + + return -code error "Error in $title at line $line,\ + column $col:\n[Get lb]$display[Get rb]\n-->\ + $errmsg" + } + default { + return -code error "Unknown error mode: [Get errmode]" + } + } +} + +#--------------------------------------------------------------------- +# FUNCTION: +# ExtractToToken string token mode +# +# INPUTS: +# string The text to process. +# token The token to look for +# mode include or exclude +# +# RETURNS: +# The extracted text +# +# DESCRIPTION: +# Extract text from a string, up to or including a particular +# token. Remove the extracted text from the string. +# mode determines whether the found token is removed; +# it should be "include" or "exclude". The string is +# modified in place, and the extracted text is returned. + +proc ::textutil::expander::ExtractToToken {string token mode} { + upvar $string theString + + # First, determine the offset + switch $mode { + include { set offset [expr {[string length $token] - 1}] } + exclude { set offset -1 } + default { error "::expander::ExtractToToken: unknown mode $mode" } + } + + # Next, find the first occurrence of the token. + set tokenPos [string first $token $theString] + + # Next, return the entire string if it wasn't found, or just + # the part upto or including the character. + if {$tokenPos == -1} { + set theText $theString + set theString "" + } else { + set newEnd [expr {$tokenPos + $offset}] + set newBegin [expr {$newEnd + 1}] + set theText [string range $theString 0 $newEnd] + set theString [string range $theString $newBegin end] + } + + return $theText +} + +#--------------------------------------------------------------------- +# FUNCTION: +# GetMacro string +# +# INPUTS: +# string The text to process. +# +# RETURNS: +# The macro, stripped of its brackets. +# +# DESCRIPTION: + +proc ::textutil::expander::GetMacro {string} { + upvar $string theString + + # FIRST, it's an error if the string doesn't begin with a + # bracket. + if {[string first [Get lb] $theString] != 0} { + error "::expander::GetMacro: assertion failure, next text isn't a command! '$theString'" + } + + # NEXT, extract a full macro + set macro [ExtractToToken theString [Get lb] include] + while {[string length $theString] > 0} { + append macro [ExtractToToken theString [Get rb] include] + + # Verify that the command really ends with the [rb] characters, + # whatever they are. If not, break because of unexpected + # end of file. + if {![IsBracketed $macro]} { + break; + } + + set strippedMacro [StripBrackets $macro] + + if {[info complete "puts \[$strippedMacro\]"]} { + return $strippedMacro + } + } + + if {[string length $macro] > 40} { + set macro "[string range $macro 0 39]...\n" + } + error "Unexpected EOF in macro:\n$macro" +} + +# Strip left and right bracket tokens from the ends of a macro, +# provided that it's properly bracketed. +proc ::textutil::expander::StripBrackets {macro} { + set llen [string length [Get lb]] + set rlen [string length [Get rb]] + set tlen [string length $macro] + + return [string range $macro $llen [expr {$tlen - $rlen - 1}]] +} + +# Return 1 if the macro is properly bracketed, and 0 otherwise. +proc ::textutil::expander::IsBracketed {macro} { + set llen [string length [Get lb]] + set rlen [string length [Get rb]] + set tlen [string length $macro] + + set leftEnd [string range $macro 0 [expr {$llen - 1}]] + set rightEnd [string range $macro [expr {$tlen - $rlen}] end] + + if {$leftEnd != [Get lb]} { + return 0 + } elseif {$rightEnd != [Get rb]} { + return 0 + } else { + return 1 + } +} + +#--------------------------------------------------------------------- +# FUNCTION: +# LocInit name +# +# INPUTS: +# name The expander object to use. +# +# RETURNS: +# No result. +# +# DESCRIPTION: +# A convenience wrapper around LocSet. Initializes the location +# to the start of the input (char 0, line 1, column 0). + +proc ::textutil::expander::LocInit {name} { + LocSet $name {0 1 0} + return +} + +#--------------------------------------------------------------------- +# FUNCTION: +# LocSet name loc +# +# INPUTS: +# name The expander object to use. +# loc Location, list containing character position, +# line number and column, in this order. +# +# RETURNS: +# No result. +# +# DESCRIPTION: +# Sets the current location in the expander to 'loc'. + +proc ::textutil::expander::LocSet {name loc} { + foreach {ch line col} $loc break + Op_cset $name char $ch + Op_cset $name line $line + Op_cset $name col $col + return +} + +#--------------------------------------------------------------------- +# FUNCTION: +# LocGet name +# +# INPUTS: +# name The expander object to use. +# +# RETURNS: +# A list containing the current character position, line number +# and column, in this order. +# +# DESCRIPTION: +# Returns the current location as stored in the expander. + +proc ::textutil::expander::LocGet {name} { + list [Op_cget $name char] [Op_cget $name line] [Op_cget $name col] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# LocUpdate name text +# +# INPUTS: +# name The expander object to use. +# text The text to process. +# +# RETURNS: +# No result. +# +# DESCRIPTION: +# Takes the current location as stored in the expander, computes +# a new location based on the string (its length and contents +# (number of lines)), and makes that new location the current +# location. + +proc ::textutil::expander::LocUpdate {name text} { + foreach {ch line col} [LocGet $name] break + set numchars [string length $text] + #8.4+ set numlines [regexp -all "\n" $text] + set numlines [expr {[llength [split $text \n]]-1}] + + incr ch $numchars + incr line $numlines + if {$numlines} { + set col [expr {$numchars - [string last \n $text] - 1}] + } else { + incr col $numchars + } + + LocSet $name [list $ch $line $col] + return +} + +#--------------------------------------------------------------------- +# FUNCTION: +# LocRange name text +# +# INPUTS: +# name The expander object to use. +# text The text to process. +# +# RETURNS: +# A text range description, compatible with the 'location' data +# used in the tcl debugger/checker. +# +# DESCRIPTION: +# Takes the current location as stored in the expander object +# and the length of the text to generate a character range. + +proc ::textutil::expander::LocRange {name text} { + # Note that the structure is compatible with + # the ranges uses by tcl debugger and checker. + # {line {charpos length}} + + foreach {ch line col} [LocGet $name] break + return [list $line [list $ch [string length $text]]] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# DisplayOf text +# +# INPUTS: +# text The text to process. +# +# RETURNS: +# The text, cut down to at most 30 bytes. +# +# DESCRIPTION: +# Cuts the incoming text down to contain no more than 30 +# characters of the input. Adds an ellipsis (...) if characters +# were actually removed from the input. + +proc ::textutil::expander::DisplayOf {text} { + set ellip "" + while {[string bytelength $text] > 30} { + set ellip ... + set text [string range $text 0 end-1] + } + set display $text$ellip +} + +#--------------------------------------------------------------------- +# Provide the package only if the code above was read and executed +# without error. + +package provide textutil::expander 1.3.1 diff --git a/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/ithyph.tex b/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/ithyph.tex new file mode 100644 index 0000000..755e108 --- /dev/null +++ b/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/ithyph.tex @@ -0,0 +1,223 @@ + +%%%%%%%%%%%%%%%%%%%% file ithyph.tex + +%%%%%%%%%%%%%%%%%%%%%%%%%%% file ithyph.tex %%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% +% Prepared by Claudio Beccari e-mail beccari@polito.it +% +% Dipartimento di Elettronica +% Politecnico di Torino +% Corso Duca degli Abruzzi, 24 +% 10129 TORINO +% +% Copyright 1998, 2001 Claudio Beccari +% +% This program can be redistributed and/or modified under the terms +% of the LaTeX Project Public License Distributed from CTAN +% archives in directory macros/latex/base/lppl.txt; either +% version 1 of the License, or any later version. +% +% \versionnumber{4.8d} \versiondate{2001/11/21} +% +% These hyphenation patterns for the Italian language are supposed to comply +% with the Reccomendation UNI 6461 on hyphenation issued by the Italian +% Standards Institution (Ente Nazionale di Unificazione UNI). No guarantee +% or declaration of fitness to any particular purpose is given and any +% liability is disclaimed. +% +% See comments and loading instructions at the end of the file after the +% \endinput line +% +{\lccode`\'=`\' % Apostrophe has its own lccode so that it is treated + % as a letter + %>> 1998/04/14 inserted grouping + % +%\lccode23=23 % Compound word mark is a letter in encoding T1 +%\def\W{^^W} % ^^W =\char23 = \char"17 =\char'27 +% +\patterns{ +.a3p2n % After the Garzanti dictionary: a-pnea, a-pnoi-co,... +.anti1 .anti3m2n +.bio1 +.ca4p3s +.circu2m1 +.di2s3cine +%.e2x +.fran2k3 +.free3 +.narco1 +.opto1 +.orto3p2 +.para1 +.poli3p2 +.pre1 +.p2s +%.ri1a2 .ri1e2 .re1i2 .ri1o2 .ri1u2 +.sha2re3 +.tran2s3c .tran2s3d .tran2s3f .tran2s3l .tran2s3n .tran2s3p .tran2s3r .tran2s3t +.su2b3lu .su2b3r +.wa2g3n +.wel2t1 +a1ia a1ie a1io a1iu a1uo a1ya 2at. +e1iu e2w +o1ia o1ie o1io o1iu +%u1u +% +%1\W0a2 1\W0e2 1\W0i2 1\W0o2 1\W0u2 +'2 +1b 2bb 2bc 2bd 2bf 2bm 2bn 2bp 2bs 2bt 2bv + b2l b2r 2b. 2b'. 2b'' +1c 2cb 2cc 2cd 2cf 2ck 2cm 2cn 2cq 2cs 2ct 2cz + 2chh c2h 2chb ch2r 2chn c2l c2r 2c. 2c'. 2c'' .c2 +1d 2db 2dd 2dg 2dl 2dm 2dn 2dp d2r 2ds 2dt 2dv 2dw + 2d. 2d'. 2d'' .d2 +1f 2fb 2fg 2ff 2fn f2l f2r 2fs 2ft 2f. 2f'. 2f'' +1g 2gb 2gd 2gf 2gg g2h g2l 2gm g2n 2gp g2r 2gs 2gt + 2gv 2gw 2gz 2gh2t 2g. 2g'. 2g'' +1h 2hb 2hd 2hh hi3p2n h2l 2hm 2hn 2hr 2hv 2h. 2h'. 2h'' +1j 2j. 2j'. 2j'' +1k 2kg 2kf k2h 2kk k2l 2km k2r 2ks 2kt 2k. 2k'. 2k'' +1l 2lb 2lc 2ld 2l3f2 2lg l2h 2lk 2ll 2lm 2ln 2lp + 2lq 2lr 2ls 2lt 2lv 2lw 2lz 2l. 2l'. 2l'' +1m 2mb 2mc 2mf 2ml 2mm 2mn 2mp 2mq 2mr 2ms 2mt 2mv 2mw + 2m. 2m'. 2m'' +1n 2nb 2nc 2nd 2nf 2ng 2nk 2nl 2nm 2nn 2np 2nq 2nr + 2ns 2nt 2nv 2nz n2g3n 2nheit. 2n. 2n' 2n'' +1p 2pd p2h p2l 2pn 3p2ne 2pp p2r 2ps 3p2sic 2pt 2pz 2p. 2p'. 2p'' +1q 2qq 2q. 2q'. 2q'' +1r 2rb 2rc 2rd 2rf r2h 2rg 2rk 2rl 2rm 2rn 2rp + 2rq 2rr 2rs 2rt rt2s3 2rv 2rx 2rw 2rz 2r. 2r'. 2r'' +1s2 2shm 2s3s s4s3m 2s3p2n 2stb 2stc 2std 2stf 2stg 2stm 2stn + 2stp 2sts 2stt 2stv 2sz 4s. 4s'. 4s'' +1t 2tb 2tc 2td 2tf 2tg t2h t2l 2tm 2tn 2tp t2r 2ts + 3t2sch 2tt 2tv 2tw t2z 2tzk 2tzs 2t. 2t'. 2t'' +1v 2vc v2l v2r 2vv 2v. 2v'. 2v'' +1w w2h wa2r 2w1y 2w. 2w'. 2w'' +1x 2xt 2xw 2x. 2x'. 2x'' +y1ou y1i +1z 2zb 2zd 2zl 2zn 2zp 2zt 2zs 2zv 2zz 2z. 2z'. 2z'' .z2 +}} % Pattern end + +\endinput + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Information %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + LOADING THESE PATTERNS + +These patterns, as well as those for any other language, do not become +effective until they are loaded in a special form into a format file; this +task is performed by the TeX initializer; any TeX system has its own +initializer with its special way of being activated. Before loading these +patterns, then, it is necessary to read very carefully the instructions that +come with your TeX system. + +Here I describe how to load the patterns with the freeware TeX system named +MiKTeX version 2.x for Windows 9x, NT, 2000, XP; with minor changes the +whole procedure is applicable with other TeX systems, but the details must +be deduced from your TeX system documentation at the section/chapter "How to +build or to rebuild a format file". + +With MikTeX: + +a) copy this file and replace the existing file ithyph.tex in the directory + \texmf\tex\generic\hyphen if the existing one has an older version date + and number. +b) select Start|Programs|MiKTeX|MiKTeX options. +c) in the Language tab add a check mark to the line concerning the Italian + language. +d) in the Geneal tab click "Update format files". +e) That's all! + +For the activation of these patterns with the specific Italian typesetting +features, use the babel package as this: + +\documentclass{article} % Or whatever other class +\usepackage[italian]{babel} +... +\begin{document} +... +\end{document} + + + ON ITALIAN HYPHENATION + +I have been working on patterns for the Italian language since 1987; in 1992 +I published + +C. Beccari, "Computer aided hyphenation for Italian and Modern + Latin", TUG vol. 13, n. 1, pp. 23-33 (1992) + +which contained a set of patterns that allowed hyphenation for both Italian +and Latin; a slightly modified version of the patterns published in the +above paper is contained in LAHYPH.TEX available on the CTAN archives. + +From the above patterns I extracted the minimum set necessary for +hyphenating Italian that was made available on the CTAN archives with the +name ITHYPH.tex the version number 3.5 on the 16th of August 1994. + +The original pattern set required 37 ops; being interested in a local +version of TeX/LaTeX capable of dealing with half a dozen languages, I +wanted to reduce memory occupation and therefore the number of ops. + +Th new version (4.0 released in 1996) of ITHYPH.TEX is much simpler than +version 3.5 and requires just 29 ops while it retains all the power of +version 3.5; it contains many more new patterns that allow to hyphenate +unusual words that generally have a root borrowed from a foreign language. +Updated versions 4.x contain minor additions and the number of ops is +increased to 30 (version 4.7 of 1998/06/01). + +This new pattern set has been tested with the same set of difficult Italian +words that was used to test version 3.5 and it yields the same results (a +part a minor change that was deliberately introduced so as to reduce the +typographical hyphenation with hyathi, since hyphenated hyathi are not +appreciated by Italian readers). A new enlarged word set for testing +purposes gets correct hyphen points that were missed or wrongly placed with +version 3.5, although no error had been reported, because such words are of +very specialized nature and are seldom used. + +As the previous version, this new set of patterns does not contain any +accented character so that the hyphenation algorithm behaves properly in +both cases, that is with cm and with dc/ec fonts. With LaTeXe terminology +the difference is between OT1 and T1 encodings; with the former encoding +fonts do not contain accented characters, while with the latter accented +characters are present and sequences such as \`a map directly to slot "E0 +that contains "agrave". + +Of course if you use dc/ec fonts (or any other real or virtual font with T1 +encoding) you get the full power of the hyphenation algorithm, while if you +use cm fonts (or any other real or virtual font with OT1 encoding) you miss +some possible break points; this is not a big inconvenience in Italian +because: + +1) The Regulation UNI 6015 on accents specifies that compulsory accents + appear only on the ending vowel of oxitone words; this means that it is + almost indifferent to have or to miss the dc/ec fonts because the only + difference consists in how TeX evaluates the end of the word; in practice + if you have these special facilities you get "qua-li-t\`a", while if you + miss them, you get "qua-lit\`a" (assuming that \righthyphenmin > 1). + +2) Optional accents are so rare in Italian, that if you absolutely want to + use them in those rare instances, and you miss the T1 encoding + facilities, you should also provide explicit discretionary hyphens as in + "s\'e\-gui\-to". + +There is no explicit hyphenation exception list because these patterns +proved to hyphenate correctly a very large set of words suitably chosen in +order to test them in the most heavy circumstances; these patterns were used +in the preparation of a number of books and no errors were discovered. + +Nevertheless if you frequently use technical terms that you want hyphenated +differently from what is normally done (for example if you prefer +etymological hyphenation of prefixed and/or suffixed words) you should +insert a specific hyphenation list in the preamble of your document, for +example: + +\hyphenation{su-per-in-dut-to-re su-per-in-dut-to-ri} + +Should you find any word that gets hyphenated in a wrong way, please, AFTER +CHECKING ON A RELIABLE MODERN DICTIONARY, report to the author, preferably +by e-mail. + + + Happy multilingual typesetting ! diff --git a/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/patch-0.1.tm b/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/patch-0.1.tm new file mode 100644 index 0000000..cf68959 --- /dev/null +++ b/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/patch-0.1.tm @@ -0,0 +1,180 @@ +# patch.tcl -- +# +# Application of a diff -ruN patch to a directory tree. +# +# Copyright (c) 2019 Christian Gollwitzer +# with tweaks by Andreas Kupries +# - Factored patch parsing into a helper +# - Replaced `puts` with report callback. + +package require Tcl 8.5 +package provide textutil::patch 0.1 + +# # ## ### ##### ######## ############# ##################### + +namespace eval ::textutil::patch { + namespace export apply + namespace ensemble create +} + +# # ## ### ##### ######## ############# ##################### + +proc ::textutil::patch::apply {dir striplevel patch reportcmd} { + set patchdict [Parse $dir $striplevel $patch] + + # Apply, now that we have parsed the patch. + dict for {fn hunks} $patchdict { + Report apply $fn + if {[catch {open $fn} fd]} { + set orig {} + } else { + set orig [split [read $fd] \n] + } + close $fd + + set patched $orig + + set fail false + set already_applied false + set hunknr 1 + foreach hunk $hunks { + dict with hunk { + set oldend [expr {$oldstart+[llength $oldcode]-1}] + set newend [expr {$newstart+[llength $newcode]-1}] + # check if the hunk matches + set origcode [lrange $orig $oldstart $oldend] + if {$origcode ne $oldcode} { + set fail true + # check if the patch is already applied + set origcode_applied [lrange $orig $newstart $newend] + if {$origcode_applied eq $newcode} { + set already_applied true + Report fail-already $fn $hunknr + } else { + Report fail $fn $hunknr $oldcode $origcode + } + break + } + # apply patch + set patched [list \ + {*}[lrange $patched 0 $newstart-1] \ + {*}$newcode \ + {*}[lrange $orig $oldend+1 end]] + } + incr hunknr + } + + if {!$fail} { + # success - write the result back + set fd [open $fn w] + puts -nonewline $fd [join $patched \n] + close $fd + } + } + + return +} + +# # ## ### ##### ######## ############# ##################### + +proc ::textutil::patch::Report args { + upvar 1 reportcmd reportcmd + uplevel #0 [list {*}$reportcmd {*}$args] + ## + # apply $fname + # fail-already $fname $hunkno + # fail $fname $hunkno $expected $seen + ## +} + +proc ::textutil::patch::Parse {dir striplevel patch} { + set patchlines [split $patch \n] + set inhunk false + set oldcode {} + set newcode {} + set n [llength $patchlines] + + set patchdict {} + for {set lineidx 0} {$lineidx < $n} {incr lineidx} { + set line [lindex $patchlines $lineidx] + if {[string match ---* $line]} { + # a diff block starts. Current line should be + # --- oldfile date time TZ + # Next line should be + # +++ newfile date time TZ + set in $line + incr lineidx + set out [lindex $patchlines $lineidx] + + if {![string match ---* $in] || ![string match +++* $out]} { + #puts $in + #puts $out + return -code error "Patch not in unified diff format, line $lineidx $in $out" + } + + # the quoting is compatible with list + lassign $in -> oldfile + lassign $out -> newfile + + set fntopatch [file join $dir {*}[lrange [file split $oldfile] $striplevel end]] + set inhunk false + #puts "Found diffline for $fntopatch" + continue + } + + # state machine for parsing the hunks + set typechar [string index $line 0] + set codeline [string range $line 1 end] + switch $typechar { + @ { + if {![regexp {@@\s+\-(\d+),(\d+)\s+\+(\d+),(\d+)\s+@@} $line \ + -> oldstart oldlen newstart newlen]} { + return code -error "Erroneous hunk in line $lindeidx, $line" + } + # adjust line numbers for 0-based indexing + incr oldstart -1 + incr newstart -1 + #puts "New hunk" + set newcode {} + set oldcode {} + set inhunk true + } + - { # line only in old code + if {$inhunk} { + lappend oldcode $codeline + } + } + + { # line only in new code + if {$inhunk} { + lappend newcode $codeline + } + } + " " { # common line + if {$inhunk} { + lappend oldcode $codeline + lappend newcode $codeline + } + } + default { + # puts "Junk: $codeline"; + continue + } + } + # test if the hunk is complete + if {[llength $oldcode]==$oldlen && [llength $newcode]==$newlen} { + set hunk [dict create \ + oldcode $oldcode \ + newcode $newcode \ + oldstart $oldstart \ + newstart $newstart] + #puts "hunk complete: $hunk" + set inhunk false + dict lappend patchdict $fntopatch $hunk + } + } + + return $patchdict +} + +# # ## ### ##### ######## ############# ##################### +return diff --git a/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/repeat-0.7.tm b/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/repeat-0.7.tm new file mode 100644 index 0000000..24f8693 --- /dev/null +++ b/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/repeat-0.7.tm @@ -0,0 +1,91 @@ +# repeat.tcl -- +# +# Emulation of string repeat for older +# revisions of Tcl. +# +# Copyright (c) 2000 by Ajuba Solutions. +# Copyright (c) 2001-2006 by Andreas Kupries +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: repeat.tcl,v 1.1 2006/04/21 04:42:28 andreas_kupries Exp $ + +# ### ### ### ######### ######### ######### +## Requirements + +package require Tcl 8.2 + +namespace eval ::textutil::repeat {} + +# ### ### ### ######### ######### ######### + +namespace eval ::textutil::repeat { + variable HaveBuiltin [expr {![catch {string repeat a 1}]}] +} + +if {0} { + # Problems with the deactivated code: + # - Linear in 'num'. + # - Tests for 'string repeat' in every call! + # (Ok, just the variable, still a test every call) + # - Fails for 'num == 0' because of undefined 'str'. + + proc textutil::repeat::StrRepeat { char num } { + variable HaveBuiltin + if { $HaveBuiltin == 0 } then { + for { set i 0 } { $i < $num } { incr i } { + append str $char + } + } else { + set str [ string repeat $char $num ] + } + return $str + } +} + +if {$::textutil::repeat::HaveBuiltin} { + proc ::textutil::repeat::strRepeat {char num} { + return [string repeat $char $num] + } + + proc ::textutil::repeat::blank {n} { + return [string repeat " " $n] + } +} else { + proc ::textutil::repeat::strRepeat {char num} { + if {$num <= 0} { + # No replication required + return "" + } elseif {$num == 1} { + # Quick exit for recursion + return $char + } elseif {$num == 2} { + # Another quick exit for recursion + return $char$char + } elseif {0 == ($num % 2)} { + # Halving the problem results in O (log n) complexity. + set result [strRepeat $char [expr {$num / 2}]] + return "$result$result" + } else { + # Uneven length, reduce problem by one + return "$char[strRepeat $char [incr num -1]]" + } + } + + proc ::textutil::repeat::blank {n} { + return [strRepeat " " $n] + } +} + +# ### ### ### ######### ######### ######### +## Data structures + +namespace eval ::textutil::repeat { + namespace export strRepeat blank +} + +# ### ### ### ######### ######### ######### +## Ready + +package provide textutil::repeat 0.7 diff --git a/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/split-0.8.tm b/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/split-0.8.tm new file mode 100644 index 0000000..18ee13b --- /dev/null +++ b/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/split-0.8.tm @@ -0,0 +1,176 @@ +# split.tcl -- +# +# Various ways of splitting a string. +# +# Copyright (c) 2000 by Ajuba Solutions. +# Copyright (c) 2000 by Eric Melski +# Copyright (c) 2001 by Reinhard Max +# Copyright (c) 2003 by Pat Thoyts +# Copyright (c) 2001-2006 by Andreas Kupries +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: split.tcl,v 1.7 2006/04/21 04:42:28 andreas_kupries Exp $ + +# ### ### ### ######### ######### ######### +## Requirements + +package require Tcl 8.2 + +namespace eval ::textutil::split {} + +######################################################################## +# This one was written by Bob Techentin (RWT in Tcl'ers Wiki): +# http://www.techentin.net +# mailto:techentin.robert@mayo.edu +# +# Later, he send me an email stated that I can use it anywhere, because +# no copyright was added, so the code is defacto in the public domain. +# +# You can found it in the Tcl'ers Wiki here: +# http://mini.net/cgi-bin/wikit/460.html +# +# Bob wrote: +# If you need to split string into list using some more complicated rule +# than builtin split command allows, use following function. It mimics +# Perl split operator which allows regexp as element separator, but, +# like builtin split, it expects string to split as first arg and regexp +# as second (optional) By default, it splits by any amount of whitespace. +# Note that if you add parenthesis into regexp, parenthesed part of separator +# would be added into list as additional element. Just like in Perl. -- cary +# +# Speed improvement by Reinhard Max: +# Instead of repeatedly copying around the not yet matched part of the +# string, I use [regexp]'s -start option to restrict the match to that +# part. This reduces the complexity from something like O(n^1.5) to +# O(n). My test case for that was: +# +# foreach i {1 10 100 1000 10000} { +# set s [string repeat x $i] +# puts [time {splitx $s .}] +# } +# + +if {[package vsatisfies [package provide Tcl] 8.3]} { + + proc ::textutil::split::splitx {str {regexp {[\t \r\n]+}}} { + # Bugfix 476988 + if {[string length $str] == 0} { + return {} + } + if {[string length $regexp] == 0} { + return [::split $str ""] + } + if {[regexp $regexp {}]} { + return -code error \ + "splitting on regexp \"$regexp\" would cause infinite loop" + } + + set list {} + set start 0 + while {[regexp -start $start -indices -- $regexp $str match submatch]} { + foreach {subStart subEnd} $submatch break + foreach {matchStart matchEnd} $match break + incr matchStart -1 + incr matchEnd + lappend list [string range $str $start $matchStart] + if {$subStart >= $start} { + lappend list [string range $str $subStart $subEnd] + } + set start $matchEnd + } + lappend list [string range $str $start end] + return $list + } + +} else { + # For tcl <= 8.2 we do not have regexp -start... + proc ::textutil::split::splitx [list str [list regexp "\[\t \r\n\]+"]] { + + if {[string length $str] == 0} { + return {} + } + if {[string length $regexp] == 0} { + return [::split $str {}] + } + if {[regexp $regexp {}]} { + return -code error \ + "splitting on regexp \"$regexp\" would cause infinite loop" + } + + set list {} + while {[regexp -indices -- $regexp $str match submatch]} { + lappend list [string range $str 0 [expr {[lindex $match 0] -1}]] + if {[lindex $submatch 0] >= 0} { + lappend list [string range $str [lindex $submatch 0] \ + [lindex $submatch 1]] + } + set str [string range $str [expr {[lindex $match 1]+1}] end] + } + lappend list $str + return $list + } + +} + +# +# splitn -- +# +# splitn splits the string $str into chunks of length $len. These +# chunks are returned as a list. +# +# If $str really contains a ByteArray object (as retrieved from binary +# encoded channels) splitn must honor this by splitting the string +# into chunks of $len bytes. +# +# It is an error to call splitn with a nonpositive $len. +# +# If splitn is called with an empty string, it returns the empty list. +# +# If the length of $str is not an entire multiple of the chunk length, +# the last chunk in the generated list will be shorter than $len. +# +# The implementation presented here was given by Bryan Oakley, as +# part of a ``contest'' I staged on c.l.t in July 2004. I selected +# this version, as it does not rely on runtime generated code, is +# very fast for chunk size one, not too bad in all the other cases, +# and uses [split] or [string range] which have been around for quite +# some time. +# +# -- Robert Suetterlin (robert@mpe.mpg.de) +# +proc ::textutil::split::splitn {str {len 1}} { + + if {$len <= 0} { + return -code error "len must be > 0" + } + + if {$len == 1} { + return [split $str {}] + } + + set result [list] + set max [string length $str] + set i 0 + set j [expr {$len -1}] + while {$i < $max} { + lappend result [string range $str $i $j] + incr i $len + incr j $len + } + + return $result +} + +# ### ### ### ######### ######### ######### +## Data structures + +namespace eval ::textutil::split { + namespace export splitx splitn +} + +# ### ### ### ######### ######### ######### +## Ready + +package provide textutil::split 0.8 diff --git a/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/string-0.8.tm b/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/string-0.8.tm new file mode 100644 index 0000000..f1ad5a4 --- /dev/null +++ b/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/string-0.8.tm @@ -0,0 +1,144 @@ +# string.tcl -- +# +# Utilities for manipulating strings, words, single lines, +# paragraphs, ... +# +# Copyright (c) 2000 by Ajuba Solutions. +# Copyright (c) 2000 by Eric Melski +# Copyright (c) 2002 by Joe English +# Copyright (c) 2001-2014 by Andreas Kupries +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: string.tcl,v 1.2 2008/03/22 16:03:11 mic42 Exp $ + +# ### ### ### ######### ######### ######### +## Requirements + +package require Tcl 8.2 + +namespace eval ::textutil::string {} + +# ### ### ### ######### ######### ######### +## API implementation + +# @c Removes the last character from the given . +# +# @a string: The string to manipulate. +# +# @r The without its last character. +# +# @i chopping + +proc ::textutil::string::chop {string} { + return [string range $string 0 [expr {[string length $string]-2}]] +} + +# @c Removes the first character from the given . +# @c Convenience procedure. +# +# @a string: string to manipulate. +# +# @r The without its first character. +# +# @i tail + +proc ::textutil::string::tail {string} { + return [string range $string 1 end] +} + +# @c Capitalizes first character of the given . +# @c Complementary procedure to

. +# +# @a string: string to manipulate. +# +# @r The with its first character capitalized. +# +# @i capitalize + +proc ::textutil::string::cap {string} { + return [string toupper [string index $string 0]][string range $string 1 end] +} + +# @c unCapitalizes first character of the given . +# @c Complementary procedure to

. +# +# @a string: string to manipulate. +# +# @r The with its first character uncapitalized. +# +# @i uncapitalize + +proc ::textutil::string::uncap {string} { + return [string tolower [string index $string 0]][string range $string 1 end] +} + +# @c Capitalizes first character of each word of the given . +# +# @a sentence: string to manipulate. +# +# @r The with the first character of each word capitalized. +# +# @i capitalize + +proc ::textutil::string::capEachWord {sentence} { + regsub -all {\S+} [string map {\\ \\\\ \$ \\$} $sentence] {[string toupper [string index & 0]][string range & 1 end]} cmd + return [subst -nobackslashes -novariables $cmd] +} + +# Compute the longest string which is common to all strings given to +# the command, and at the beginning of said strings, i.e. a prefix. If +# only one argument is specified it is treated as a list of the +# strings to look at. If more than one argument is specified these +# arguments are the strings to be looked at. If only one string is +# given, in either form, the string is returned, as it is its own +# longest common prefix. + +proc ::textutil::string::longestCommonPrefix {args} { + return [longestCommonPrefixList $args] +} + +proc ::textutil::string::longestCommonPrefixList {list} { + if {[llength $list] <= 1} { + return [lindex $list 0] + } + + set list [lsort $list] + set min [lindex $list 0] + set max [lindex $list end] + + # Min and max are the two strings which are most different. If + # they have a common prefix, it will also be the common prefix for + # all of them. + + # Fast bailouts for common cases. + + set n [string length $min] + if {$n == 0} {return ""} + if {0 == [string compare $min $max]} {return $min} + + set prefix "" + set i 0 + while {[string index $min $i] == [string index $max $i]} { + append prefix [string index $min $i] + if {[incr i] > $n} {break} + } + set prefix +} + +# ### ### ### ######### ######### ######### +## Data structures + +namespace eval ::textutil::string { + # Export the imported commands + + namespace export chop tail cap uncap capEachWord + namespace export longestCommonPrefix + namespace export longestCommonPrefixList +} + +# ### ### ### ######### ######### ######### +## Ready + +package provide textutil::string 0.8 diff --git a/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/tabify-0.7.tm b/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/tabify-0.7.tm new file mode 100644 index 0000000..543b96c --- /dev/null +++ b/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/tabify-0.7.tm @@ -0,0 +1,289 @@ +# +# As the author of the procs 'tabify2' and 'untabify2' I suggest that the +# comments explaining their behaviour be kept in this file. +# 1) Beginners in any programming language (I am new to Tcl so I know what I +# am talking about) can profit enormously from studying 'correct' code. +# Of course comments will help a lot in this regard. +# 2) Many problems newbies face can be solved by directing them towards +# available libraries - after all, libraries have been written to solve +# recurring problems. Then they can just use them, or have a closer look +# to see and to discover how things are done the 'Tcl way'. +# 3) And if ever a proc from a library should be less than perfect, having +# comments explaining the behaviour of the code will surely help. +# +# This said, I will welcome any error reports or suggestions for improvements +# (especially on the 'doing things the Tcl way' aspect). +# +# Use of these sources is licensed under the same conditions as is Tcl. +# +# June 2001, Helmut Giese (hgiese@ratiosoft.com) +# +# ---------------------------------------------------------------------------- +# +# The original procs 'tabify' and 'untabify' each work with complete blocks +# of $num spaces ('num' holding the tab size). While this is certainly useful +# in some circumstances, it does not reflect the way an editor works: +# Counting columns from 1, assuming a tab size of 8 and entering '12345' +# followed by a tab, you expect to advance to column 9. Your editor might +# put a tab into the file or 3 spaces, depending on its configuration. +# Now, on 'tabifying' you will expect to see those 3 spaces converted to a +# tab (and on the other hand expect the tab *at this position* to be +# converted to 3 spaces). +# +# This behaviour is mimicked by the new procs 'tabify2' and 'untabify2'. +# Both have one feature in common: They accept multi-line strings (a whole +# file if you want to) but in order to make life simpler for the programmer, +# they split the incoming string into individual lines and hand each line to +# a proc that does the real work. +# +# One design decision worth mentioning here: +# A single space is never converted to a tab even if its position would +# allow to do so. +# Single spaces occur very often, say in arithmetic expressions like +# [expr (($a + $b) * $c) < $d]. If we didn't follow the above rule we might +# need to replace one or more of them to tabs. However if the tab size gets +# changed, this expression would be formatted quite differently - which is +# probably not a good idea. +# +# 'untabifying' on the other hand might need to replace a tab with a single +# space: If the current position requires it, what else to do? +# As a consequence those two procs are unsymmetric in this aspect, but I +# couldn't think of a better solution. Could you? +# +# ---------------------------------------------------------------------------- +# + +# ### ### ### ######### ######### ######### +## Requirements + +package require Tcl 8.2 +package require textutil::repeat + +namespace eval ::textutil::tabify {} + +# ### ### ### ######### ######### ######### +## API implementation + +namespace eval ::textutil::tabify { + namespace import -force ::textutil::repeat::strRepeat +} + +proc ::textutil::tabify::tabify { string { num 8 } } { + return [string map [list [MakeTabStr $num] \t] $string] +} + +proc ::textutil::tabify::untabify { string { num 8 } } { + return [string map [list \t [MakeTabStr $num]] $string] +} + +proc ::textutil::tabify::MakeTabStr { num } { + variable TabStr + variable TabLen + + if { $TabLen != $num } then { + set TabLen $num + set TabStr [strRepeat " " $num] + } + + return $TabStr +} + +# ---------------------------------------------------------------------------- +# +# tabifyLine: Works on a single line of text, replacing 'spaces at correct +# positions' with tabs. $num is the requested tab size. +# Returns the (possibly modified) line. +# +# 'spaces at correct positions': Only spaces which 'fill the space' between +# an arbitrary position and the next tab stop can be replaced. +# Example: With tab size 8, spaces at positions 11 - 13 will *not* be replaced, +# because an expansion of a tab at position 11 will jump up to 16. +# See also the comment at the beginning of this file why single spaces are +# *never* replaced by a tab. +# +# The proc works backwards, from the end of the string up to the beginning: +# - Set the position to start the search from ('lastPos') to 'end'. +# - Find the last occurrence of ' ' in 'line' with respect to 'lastPos' +# ('currPos' below). This is a candidate for replacement. +# - Find to 'currPos' the following tab stop using the expression +# set nextTab [expr ($currPos + $num) - ($currPos % $num)] +# and get the previous tab stop as well (this will be the starting +# point for the next iteration). +# - The ' ' at 'currPos' is only a candidate for replacement if +# 1) it is just one position before a tab stop *and* +# 2) there is at least one space at its left (see comment above on not +# touching an isolated space). +# Continue, if any of these conditions is not met. +# - Determine where to put the tab (that is: how many spaces to replace?) +# by stepping up to the beginning until +# -- you hit a non-space or +# -- you are at the previous tab position +# - Do the replacement and continue. +# +# This algorithm only works, if $line does not contain tabs. Otherwise our +# interpretation of any position beyond the tab will be wrong. (Imagine you +# find a ' ' at position 4 in $line. If you got 3 leading tabs, your *real* +# position might be 25 (tab size of 8). Since in real life some strings might +# already contain tabs, we test for it (and eventually call untabifyLine). +# + +proc ::textutil::tabify::tabifyLine { line num } { + if { [string first \t $line] != -1 } { + # assure array 'Spaces' is set up 'comme il faut' + checkArr $num + # remove existing tabs + set line [untabifyLine $line $num] + } + + set lastPos end + + while { $lastPos > 0 } { + set currPos [string last " " $line $lastPos] + if { $currPos == -1 } { + # no more spaces + break; + } + + set nextTab [expr {($currPos + $num) - ($currPos % $num)}] + set prevTab [expr {$nextTab - $num}] + + # prepare for next round: continue at 'previous tab stop - 1' + set lastPos [expr {$prevTab - 1}] + + if { ($currPos + 1) != $nextTab } { + continue ;# crit. (1) + } + + if { [string index $line [expr {$currPos - 1}]] != " " } { + continue ;# crit. (2) + } + + # now step backwards while there are spaces + for {set pos [expr {$currPos - 2}]} {$pos >= $prevTab} {incr pos -1} { + if { [string index $line $pos] != " " } { + break; + } + } + + # ... and replace them + set line [string replace $line [expr {$pos + 1}] $currPos \t] + } + return $line +} + +# +# Helper proc for 'untabifyLine': Checks if all needed elements of array +# 'Spaces' exist and creates the missing ones if needed. +# + +proc ::textutil::tabify::checkArr { num } { + variable TabLen2 + variable Spaces + + if { $num > $TabLen2 } { + for { set i [expr {$TabLen2 + 1}] } { $i <= $num } { incr i } { + set Spaces($i) [strRepeat " " $i] + } + set TabLen2 $num + } +} + + +# untabifyLine: Works on a single line of text, replacing tabs with enough +# spaces to get to the next tab position. +# Returns the (possibly modified) line. +# +# The procedure is straight forward: +# - Find the next tab. +# - Calculate the next tab position following it. +# - Delete the tab and insert as many spaces as needed to get there. +# + +proc ::textutil::tabify::untabifyLine { line num } { + variable Spaces + + set currPos 0 + while { 1 } { + set currPos [string first \t $line $currPos] + if { $currPos == -1 } { + # no more tabs + break + } + + # how far is the next tab position ? + set dist [expr {$num - ($currPos % $num)}] + # replace '\t' at $currPos with $dist spaces + set line [string replace $line $currPos $currPos $Spaces($dist)] + + # set up for next round (not absolutely necessary but maybe a trifle + # more efficient) + incr currPos $dist + } + return $line +} + +# tabify2: Replace all 'appropriate' spaces as discussed above with tabs. +# 'string' might hold any number of lines, 'num' is the requested tab size. +# Returns (possibly modified) 'string'. +# +proc ::textutil::tabify::tabify2 { string { num 8 } } { + + # split string into individual lines + set inLst [split $string \n] + + # now work on each line + set outLst [list] + foreach line $inLst { + lappend outLst [tabifyLine $line $num] + } + + # return all as one string + return [join $outLst \n] +} + + +# untabify2: Replace all tabs with the appropriate number of spaces. +# 'string' might hold any number of lines, 'num' is the requested tab size. +# Returns (possibly modified) 'string'. +# +proc ::textutil::tabify::untabify2 { string { num 8 } } { + + # assure array 'Spaces' is set up 'comme il faut' + checkArr $num + + set inLst [split $string \n] + + set outLst [list] + foreach line $inLst { + lappend outLst [untabifyLine $line $num] + } + + return [join $outLst \n] +} + + + +# ### ### ### ######### ######### ######### +## Data structures + +namespace eval ::textutil::tabify { + variable TabLen 8 + variable TabStr [strRepeat " " $TabLen] + + namespace export tabify untabify tabify2 untabify2 + + # The proc 'untabify2' uses the following variables for efficiency. + # Since a tab can be replaced by one up to 'tab size' spaces, it is handy + # to have the appropriate 'space strings' available. This is the use of + # the array 'Spaces', where 'Spaces(n)' contains just 'n' spaces. + # The variable 'TabLen2' remembers the biggest tab size used. + + variable TabLen2 0 + variable Spaces + array set Spaces {0 ""} +} + +# ### ### ### ######### ######### ######### +## Ready + +package provide textutil::tabify 0.7 diff --git a/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/trim-0.7.tm b/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/trim-0.7.tm new file mode 100644 index 0000000..4aab076 --- /dev/null +++ b/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/trim-0.7.tm @@ -0,0 +1,112 @@ +# trim.tcl -- +# +# Various ways of trimming a string. +# +# Copyright (c) 2000 by Ajuba Solutions. +# Copyright (c) 2000 by Eric Melski +# Copyright (c) 2001-2006 by Andreas Kupries +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: trim.tcl,v 1.5 2006/04/21 04:42:28 andreas_kupries Exp $ + +# ### ### ### ######### ######### ######### +## Requirements + +package require Tcl 8.2 + +namespace eval ::textutil::trim {} + +# ### ### ### ######### ######### ######### +## API implementation + +proc ::textutil::trim::trimleft {text {trim "[ \t]+"}} { + regsub -line -all -- [MakeStr $trim left] $text {} text + return $text +} + +proc ::textutil::trim::trimright {text {trim "[ \t]+"}} { + regsub -line -all -- [MakeStr $trim right] $text {} text + return $text +} + +proc ::textutil::trim::trim {text {trim "[ \t]+"}} { + regsub -line -all -- [MakeStr $trim left] $text {} text + regsub -line -all -- [MakeStr $trim right] $text {} text + return $text +} + + + +# @c Strips from , if found at its start. +# +# @a text: The string to check for . +# @a prefix: The string to remove from . +# +# @r The , but without . +# +# @i remove, prefix + +proc ::textutil::trim::trimPrefix {text prefix} { + if {[string first $prefix $text] == 0} { + return [string range $text [string length $prefix] end] + } else { + return $text + } +} + + +# @c Removes the Heading Empty Lines of . +# +# @a text: The text block to manipulate. +# +# @r The , but without heading empty lines. +# +# @i remove, empty lines + +proc ::textutil::trim::trimEmptyHeading {text} { + regsub -- "^(\[ \t\]*\n)*" $text {} text + return $text +} + +# ### ### ### ######### ######### ######### +## Helper commands. Internal + +proc ::textutil::trim::MakeStr { string pos } { + variable StrU + variable StrR + variable StrL + + if { "$string" != "$StrU" } { + set StrU $string + set StrR "(${StrU})\$" + set StrL "^(${StrU})" + } + if { "$pos" == "left" } { + return $StrL + } + if { "$pos" == "right" } { + return $StrR + } + + return -code error "Panic, illegal position key \"$pos\"" +} + +# ### ### ### ######### ######### ######### +## Data structures + +namespace eval ::textutil::trim { + variable StrU "\[ \t\]+" + variable StrR "(${StrU})\$" + variable StrL "^(${StrU})" + + namespace export \ + trim trimright trimleft \ + trimPrefix trimEmptyHeading +} + +# ### ### ### ######### ######### ######### +## Ready + +package provide textutil::trim 0.7 diff --git a/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/wcswidth-35.1.tm b/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/wcswidth-35.1.tm new file mode 100644 index 0000000..080a881 --- /dev/null +++ b/src/mixtemplates/layouts/basic/src/bootsupport/modules/textutil/wcswidth-35.1.tm @@ -0,0 +1,772 @@ +### +# This file is automatically generated by the build/build.tcl file +# based on information in the following database: +# http://www.unicode.org/Public/UCD/latest/ucd/EastAsianWidth.txt +# +# (This is the 35th edition, thus version 35 for our package) +# +# Author: Sean Woods +### +package provide textutil::wcswidth 35.1 +proc ::textutil::wcswidth_type char { + if {$char == 161} { return A } + if {$char == 164} { return A } + if {$char == 167} { return A } + if {$char == 168} { return A } + if {$char == 170} { return A } + if {$char == 173} { return A } + if {$char == 174} { return A } + if {$char == 176} { return A } + if {$char == 177} { return A } + if {$char >= 178 && $char <= 179 } { return A } + if {$char == 180} { return A } + if {$char >= 182 && $char <= 183 } { return A } + if {$char == 184} { return A } + if {$char == 185} { return A } + if {$char == 186} { return A } + if {$char >= 188 && $char <= 190 } { return A } + if {$char == 191} { return A } + if {$char == 198} { return A } + if {$char == 208} { return A } + if {$char == 215} { return A } + if {$char == 216} { return A } + if {$char >= 222 && $char <= 225 } { return A } + if {$char == 230} { return A } + if {$char >= 232 && $char <= 234 } { return A } + if {$char >= 236 && $char <= 237 } { return A } + if {$char == 240} { return A } + if {$char >= 242 && $char <= 243 } { return A } + if {$char == 247} { return A } + if {$char >= 248 && $char <= 250 } { return A } + if {$char == 252} { return A } + if {$char == 254} { return A } + if {$char == 257} { return A } + if {$char == 273} { return A } + if {$char == 275} { return A } + if {$char == 283} { return A } + if {$char >= 294 && $char <= 295 } { return A } + if {$char == 299} { return A } + if {$char >= 305 && $char <= 307 } { return A } + if {$char == 312} { return A } + if {$char >= 319 && $char <= 322 } { return A } + if {$char == 324} { return A } + if {$char >= 328 && $char <= 331 } { return A } + if {$char == 333} { return A } + if {$char >= 338 && $char <= 339 } { return A } + if {$char >= 358 && $char <= 359 } { return A } + if {$char == 363} { return A } + if {$char == 462} { return A } + if {$char == 464} { return A } + if {$char == 466} { return A } + if {$char == 468} { return A } + if {$char == 470} { return A } + if {$char == 472} { return A } + if {$char == 474} { return A } + if {$char == 476} { return A } + if {$char == 593} { return A } + if {$char == 609} { return A } + if {$char == 708} { return A } + if {$char == 711} { return A } + if {$char >= 713 && $char <= 715 } { return A } + if {$char == 717} { return A } + if {$char == 720} { return A } + if {$char >= 728 && $char <= 731 } { return A } + if {$char == 733} { return A } + if {$char == 735} { return A } + if {$char >= 768 && $char <= 879 } { return A } + if {$char >= 913 && $char <= 929 } { return A } + if {$char >= 931 && $char <= 937 } { return A } + if {$char >= 945 && $char <= 961 } { return A } + if {$char >= 963 && $char <= 969 } { return A } + if {$char == 1025} { return A } + if {$char >= 1040 && $char <= 1103 } { return A } + if {$char == 1105} { return A } + if {$char >= 4352 && $char <= 4447 } { return W } + if {$char == 8208} { return A } + if {$char >= 8211 && $char <= 8213 } { return A } + if {$char == 8214} { return A } + if {$char == 8216} { return A } + if {$char == 8217} { return A } + if {$char == 8220} { return A } + if {$char == 8221} { return A } + if {$char >= 8224 && $char <= 8226 } { return A } + if {$char >= 8228 && $char <= 8231 } { return A } + if {$char == 8240} { return A } + if {$char >= 8242 && $char <= 8243 } { return A } + if {$char == 8245} { return A } + if {$char == 8251} { return A } + if {$char == 8254} { return A } + if {$char == 8308} { return A } + if {$char == 8319} { return A } + if {$char >= 8321 && $char <= 8324 } { return A } + if {$char == 8361} { return H } + if {$char == 8364} { return A } + if {$char == 8451} { return A } + if {$char == 8453} { return A } + if {$char == 8457} { return A } + if {$char == 8467} { return A } + if {$char == 8470} { return A } + if {$char >= 8481 && $char <= 8482 } { return A } + if {$char == 8486} { return A } + if {$char == 8491} { return A } + if {$char >= 8531 && $char <= 8532 } { return A } + if {$char >= 8539 && $char <= 8542 } { return A } + if {$char >= 8544 && $char <= 8555 } { return A } + if {$char >= 8560 && $char <= 8569 } { return A } + if {$char == 8585} { return A } + if {$char >= 8592 && $char <= 8596 } { return A } + if {$char >= 8597 && $char <= 8601 } { return A } + if {$char >= 8632 && $char <= 8633 } { return A } + if {$char == 8658} { return A } + if {$char == 8660} { return A } + if {$char == 8679} { return A } + if {$char == 8704} { return A } + if {$char >= 8706 && $char <= 8707 } { return A } + if {$char >= 8711 && $char <= 8712 } { return A } + if {$char == 8715} { return A } + if {$char == 8719} { return A } + if {$char == 8721} { return A } + if {$char == 8725} { return A } + if {$char == 8730} { return A } + if {$char >= 8733 && $char <= 8736 } { return A } + if {$char == 8739} { return A } + if {$char == 8741} { return A } + if {$char >= 8743 && $char <= 8748 } { return A } + if {$char == 8750} { return A } + if {$char >= 8756 && $char <= 8759 } { return A } + if {$char >= 8764 && $char <= 8765 } { return A } + if {$char == 8776} { return A } + if {$char == 8780} { return A } + if {$char == 8786} { return A } + if {$char >= 8800 && $char <= 8801 } { return A } + if {$char >= 8804 && $char <= 8807 } { return A } + if {$char >= 8810 && $char <= 8811 } { return A } + if {$char >= 8814 && $char <= 8815 } { return A } + if {$char >= 8834 && $char <= 8835 } { return A } + if {$char >= 8838 && $char <= 8839 } { return A } + if {$char == 8853} { return A } + if {$char == 8857} { return A } + if {$char == 8869} { return A } + if {$char == 8895} { return A } + if {$char == 8978} { return A } + if {$char >= 8986 && $char <= 8987 } { return W } + if {$char == 9001} { return W } + if {$char == 9002} { return W } + if {$char >= 9193 && $char <= 9196 } { return W } + if {$char == 9200} { return W } + if {$char == 9203} { return W } + if {$char >= 9312 && $char <= 9371 } { return A } + if {$char >= 9372 && $char <= 9449 } { return A } + if {$char >= 9451 && $char <= 9471 } { return A } + if {$char >= 9472 && $char <= 9547 } { return A } + if {$char >= 9552 && $char <= 9587 } { return A } + if {$char >= 9600 && $char <= 9615 } { return A } + if {$char >= 9618 && $char <= 9621 } { return A } + if {$char >= 9632 && $char <= 9633 } { return A } + if {$char >= 9635 && $char <= 9641 } { return A } + if {$char >= 9650 && $char <= 9651 } { return A } + if {$char == 9654} { return A } + if {$char == 9655} { return A } + if {$char >= 9660 && $char <= 9661 } { return A } + if {$char == 9664} { return A } + if {$char == 9665} { return A } + if {$char >= 9670 && $char <= 9672 } { return A } + if {$char == 9675} { return A } + if {$char >= 9678 && $char <= 9681 } { return A } + if {$char >= 9698 && $char <= 9701 } { return A } + if {$char == 9711} { return A } + if {$char >= 9725 && $char <= 9726 } { return W } + if {$char >= 9733 && $char <= 9734 } { return A } + if {$char == 9737} { return A } + if {$char >= 9742 && $char <= 9743 } { return A } + if {$char >= 9748 && $char <= 9749 } { return W } + if {$char == 9756} { return A } + if {$char == 9758} { return A } + if {$char == 9792} { return A } + if {$char == 9794} { return A } + if {$char >= 9800 && $char <= 9811 } { return W } + if {$char >= 9824 && $char <= 9825 } { return A } + if {$char >= 9827 && $char <= 9829 } { return A } + if {$char >= 9831 && $char <= 9834 } { return A } + if {$char >= 9836 && $char <= 9837 } { return A } + if {$char == 9839} { return A } + if {$char == 9855} { return W } + if {$char == 9875} { return W } + if {$char >= 9886 && $char <= 9887 } { return A } + if {$char == 9889} { return W } + if {$char >= 9898 && $char <= 9899 } { return W } + if {$char >= 9917 && $char <= 9918 } { return W } + if {$char == 9919} { return A } + if {$char >= 9924 && $char <= 9925 } { return W } + if {$char >= 9926 && $char <= 9933 } { return A } + if {$char == 9934} { return W } + if {$char >= 9935 && $char <= 9939 } { return A } + if {$char == 9940} { return W } + if {$char >= 9941 && $char <= 9953 } { return A } + if {$char == 9955} { return A } + if {$char >= 9960 && $char <= 9961 } { return A } + if {$char == 9962} { return W } + if {$char >= 9963 && $char <= 9969 } { return A } + if {$char >= 9970 && $char <= 9971 } { return W } + if {$char == 9972} { return A } + if {$char == 9973} { return W } + if {$char >= 9974 && $char <= 9977 } { return A } + if {$char == 9978} { return W } + if {$char >= 9979 && $char <= 9980 } { return A } + if {$char == 9981} { return W } + if {$char >= 9982 && $char <= 9983 } { return A } + if {$char == 9989} { return W } + if {$char >= 9994 && $char <= 9995 } { return W } + if {$char == 10024} { return W } + if {$char == 10045} { return A } + if {$char == 10060} { return W } + if {$char == 10062} { return W } + if {$char >= 10067 && $char <= 10069 } { return W } + if {$char == 10071} { return W } + if {$char >= 10102 && $char <= 10111 } { return A } + if {$char >= 10133 && $char <= 10135 } { return W } + if {$char == 10160} { return W } + if {$char == 10175} { return W } + if {$char >= 11035 && $char <= 11036 } { return W } + if {$char == 11088} { return W } + if {$char == 11093} { return W } + if {$char >= 11094 && $char <= 11097 } { return A } + if {$char >= 11904 && $char <= 11929 } { return W } + if {$char >= 11931 && $char <= 12019 } { return W } + if {$char >= 12032 && $char <= 12245 } { return W } + if {$char >= 12272 && $char <= 12283 } { return W } + if {$char == 12288} { return F } + if {$char >= 12289 && $char <= 12291 } { return W } + if {$char == 12292} { return W } + if {$char == 12293} { return W } + if {$char == 12294} { return W } + if {$char == 12295} { return W } + if {$char == 12296} { return W } + if {$char == 12297} { return W } + if {$char == 12298} { return W } + if {$char == 12299} { return W } + if {$char == 12300} { return W } + if {$char == 12301} { return W } + if {$char == 12302} { return W } + if {$char == 12303} { return W } + if {$char == 12304} { return W } + if {$char == 12305} { return W } + if {$char >= 12306 && $char <= 12307 } { return W } + if {$char == 12308} { return W } + if {$char == 12309} { return W } + if {$char == 12310} { return W } + if {$char == 12311} { return W } + if {$char == 12312} { return W } + if {$char == 12313} { return W } + if {$char == 12314} { return W } + if {$char == 12315} { return W } + if {$char == 12316} { return W } + if {$char == 12317} { return W } + if {$char >= 12318 && $char <= 12319 } { return W } + if {$char == 12320} { return W } + if {$char >= 12321 && $char <= 12329 } { return W } + if {$char >= 12330 && $char <= 12333 } { return W } + if {$char >= 12334 && $char <= 12335 } { return W } + if {$char == 12336} { return W } + if {$char >= 12337 && $char <= 12341 } { return W } + if {$char >= 12342 && $char <= 12343 } { return W } + if {$char >= 12344 && $char <= 12346 } { return W } + if {$char == 12347} { return W } + if {$char == 12348} { return W } + if {$char == 12349} { return W } + if {$char == 12350} { return W } + if {$char >= 12353 && $char <= 12438 } { return W } + if {$char >= 12441 && $char <= 12442 } { return W } + if {$char >= 12443 && $char <= 12444 } { return W } + if {$char >= 12445 && $char <= 12446 } { return W } + if {$char == 12447} { return W } + if {$char == 12448} { return W } + if {$char >= 12449 && $char <= 12538 } { return W } + if {$char == 12539} { return W } + if {$char >= 12540 && $char <= 12542 } { return W } + if {$char == 12543} { return W } + if {$char >= 12549 && $char <= 12591 } { return W } + if {$char >= 12593 && $char <= 12686 } { return W } + if {$char >= 12688 && $char <= 12689 } { return W } + if {$char >= 12690 && $char <= 12693 } { return W } + if {$char >= 12694 && $char <= 12703 } { return W } + if {$char >= 12704 && $char <= 12730 } { return W } + if {$char >= 12736 && $char <= 12771 } { return W } + if {$char >= 12784 && $char <= 12799 } { return W } + if {$char >= 12800 && $char <= 12830 } { return W } + if {$char >= 12832 && $char <= 12841 } { return W } + if {$char >= 12842 && $char <= 12871 } { return W } + if {$char >= 12872 && $char <= 12879 } { return A } + if {$char == 12880} { return W } + if {$char >= 12881 && $char <= 12895 } { return W } + if {$char >= 12896 && $char <= 12927 } { return W } + if {$char >= 12928 && $char <= 12937 } { return W } + if {$char >= 12938 && $char <= 12976 } { return W } + if {$char >= 12977 && $char <= 12991 } { return W } + if {$char >= 12992 && $char <= 13054 } { return W } + if {$char >= 13056 && $char <= 13311 } { return W } + if {$char >= 13312 && $char <= 19893 } { return W } + if {$char >= 19894 && $char <= 19903 } { return W } + if {$char >= 19968 && $char <= 40943 } { return W } + if {$char >= 40944 && $char <= 40959 } { return W } + if {$char >= 40960 && $char <= 40980 } { return W } + if {$char == 40981} { return W } + if {$char >= 40982 && $char <= 42124 } { return W } + if {$char >= 42128 && $char <= 42182 } { return W } + if {$char >= 43360 && $char <= 43388 } { return W } + if {$char >= 44032 && $char <= 55203 } { return W } + if {$char >= 57344 && $char <= 63743 } { return A } + if {$char >= 63744 && $char <= 64109 } { return W } + if {$char >= 64110 && $char <= 64111 } { return W } + if {$char >= 64112 && $char <= 64217 } { return W } + if {$char >= 64218 && $char <= 64255 } { return W } + if {$char >= 65024 && $char <= 65039 } { return A } + if {$char >= 65040 && $char <= 65046 } { return W } + if {$char == 65047} { return W } + if {$char == 65048} { return W } + if {$char == 65049} { return W } + if {$char == 65072} { return W } + if {$char >= 65073 && $char <= 65074 } { return W } + if {$char >= 65075 && $char <= 65076 } { return W } + if {$char == 65077} { return W } + if {$char == 65078} { return W } + if {$char == 65079} { return W } + if {$char == 65080} { return W } + if {$char == 65081} { return W } + if {$char == 65082} { return W } + if {$char == 65083} { return W } + if {$char == 65084} { return W } + if {$char == 65085} { return W } + if {$char == 65086} { return W } + if {$char == 65087} { return W } + if {$char == 65088} { return W } + if {$char == 65089} { return W } + if {$char == 65090} { return W } + if {$char == 65091} { return W } + if {$char == 65092} { return W } + if {$char >= 65093 && $char <= 65094 } { return W } + if {$char == 65095} { return W } + if {$char == 65096} { return W } + if {$char >= 65097 && $char <= 65100 } { return W } + if {$char >= 65101 && $char <= 65103 } { return W } + if {$char >= 65104 && $char <= 65106 } { return W } + if {$char >= 65108 && $char <= 65111 } { return W } + if {$char == 65112} { return W } + if {$char == 65113} { return W } + if {$char == 65114} { return W } + if {$char == 65115} { return W } + if {$char == 65116} { return W } + if {$char == 65117} { return W } + if {$char == 65118} { return W } + if {$char >= 65119 && $char <= 65121 } { return W } + if {$char == 65122} { return W } + if {$char == 65123} { return W } + if {$char >= 65124 && $char <= 65126 } { return W } + if {$char == 65128} { return W } + if {$char == 65129} { return W } + if {$char >= 65130 && $char <= 65131 } { return W } + if {$char >= 65281 && $char <= 65283 } { return F } + if {$char == 65284} { return F } + if {$char >= 65285 && $char <= 65287 } { return F } + if {$char == 65288} { return F } + if {$char == 65289} { return F } + if {$char == 65290} { return F } + if {$char == 65291} { return F } + if {$char == 65292} { return F } + if {$char == 65293} { return F } + if {$char >= 65294 && $char <= 65295 } { return F } + if {$char >= 65296 && $char <= 65305 } { return F } + if {$char >= 65306 && $char <= 65307 } { return F } + if {$char >= 65308 && $char <= 65310 } { return F } + if {$char >= 65311 && $char <= 65312 } { return F } + if {$char >= 65313 && $char <= 65338 } { return F } + if {$char == 65339} { return F } + if {$char == 65340} { return F } + if {$char == 65341} { return F } + if {$char == 65342} { return F } + if {$char == 65343} { return F } + if {$char == 65344} { return F } + if {$char >= 65345 && $char <= 65370 } { return F } + if {$char == 65371} { return F } + if {$char == 65372} { return F } + if {$char == 65373} { return F } + if {$char == 65374} { return F } + if {$char == 65375} { return F } + if {$char == 65376} { return F } + if {$char == 65377} { return H } + if {$char == 65378} { return H } + if {$char == 65379} { return H } + if {$char >= 65380 && $char <= 65381 } { return H } + if {$char >= 65382 && $char <= 65391 } { return H } + if {$char == 65392} { return H } + if {$char >= 65393 && $char <= 65437 } { return H } + if {$char >= 65438 && $char <= 65439 } { return H } + if {$char >= 65440 && $char <= 65470 } { return H } + if {$char >= 65474 && $char <= 65479 } { return H } + if {$char >= 65482 && $char <= 65487 } { return H } + if {$char >= 65490 && $char <= 65495 } { return H } + if {$char >= 65498 && $char <= 65500 } { return H } + if {$char >= 65504 && $char <= 65505 } { return F } + if {$char == 65506} { return F } + if {$char == 65507} { return F } + if {$char == 65508} { return F } + if {$char >= 65509 && $char <= 65510 } { return F } + if {$char == 65512} { return H } + if {$char >= 65513 && $char <= 65516 } { return H } + if {$char >= 65517 && $char <= 65518 } { return H } + if {$char == 65533} { return A } + if {$char >= 94176 && $char <= 94177 } { return W } + if {$char >= 94208 && $char <= 100337 } { return W } + if {$char >= 100352 && $char <= 101106 } { return W } + if {$char >= 110592 && $char <= 110847 } { return W } + if {$char >= 110848 && $char <= 110878 } { return W } + if {$char >= 110960 && $char <= 111355 } { return W } + if {$char == 126980} { return W } + if {$char == 127183} { return W } + if {$char >= 127232 && $char <= 127242 } { return A } + if {$char >= 127248 && $char <= 127277 } { return A } + if {$char >= 127280 && $char <= 127337 } { return A } + if {$char >= 127344 && $char <= 127373 } { return A } + if {$char == 127374} { return W } + if {$char >= 127375 && $char <= 127376 } { return A } + if {$char >= 127377 && $char <= 127386 } { return W } + if {$char >= 127387 && $char <= 127404 } { return A } + if {$char >= 127488 && $char <= 127490 } { return W } + if {$char >= 127504 && $char <= 127547 } { return W } + if {$char >= 127552 && $char <= 127560 } { return W } + if {$char >= 127568 && $char <= 127569 } { return W } + if {$char >= 127584 && $char <= 127589 } { return W } + if {$char >= 127744 && $char <= 127776 } { return W } + if {$char >= 127789 && $char <= 127797 } { return W } + if {$char >= 127799 && $char <= 127868 } { return W } + if {$char >= 127870 && $char <= 127891 } { return W } + if {$char >= 127904 && $char <= 127946 } { return W } + if {$char >= 127951 && $char <= 127955 } { return W } + if {$char >= 127968 && $char <= 127984 } { return W } + if {$char == 127988} { return W } + if {$char >= 127992 && $char <= 127994 } { return W } + if {$char >= 127995 && $char <= 127999 } { return W } + if {$char >= 128000 && $char <= 128062 } { return W } + if {$char == 128064} { return W } + if {$char >= 128066 && $char <= 128252 } { return W } + if {$char >= 128255 && $char <= 128317 } { return W } + if {$char >= 128331 && $char <= 128334 } { return W } + if {$char >= 128336 && $char <= 128359 } { return W } + if {$char == 128378} { return W } + if {$char >= 128405 && $char <= 128406 } { return W } + if {$char == 128420} { return W } + if {$char >= 128507 && $char <= 128511 } { return W } + if {$char >= 128512 && $char <= 128591 } { return W } + if {$char >= 128640 && $char <= 128709 } { return W } + if {$char == 128716} { return W } + if {$char >= 128720 && $char <= 128722 } { return W } + if {$char >= 128747 && $char <= 128748 } { return W } + if {$char >= 128756 && $char <= 128761 } { return W } + if {$char >= 129296 && $char <= 129342 } { return W } + if {$char >= 129344 && $char <= 129392 } { return W } + if {$char >= 129395 && $char <= 129398 } { return W } + if {$char == 129402} { return W } + if {$char >= 129404 && $char <= 129442 } { return W } + if {$char >= 129456 && $char <= 129465 } { return W } + if {$char >= 129472 && $char <= 129474 } { return W } + if {$char >= 129488 && $char <= 129535 } { return W } + if {$char >= 131072 && $char <= 173782 } { return W } + if {$char >= 173783 && $char <= 173823 } { return W } + if {$char >= 173824 && $char <= 177972 } { return W } + if {$char >= 177973 && $char <= 177983 } { return W } + if {$char >= 177984 && $char <= 178205 } { return W } + if {$char >= 178206 && $char <= 178207 } { return W } + if {$char >= 178208 && $char <= 183969 } { return W } + if {$char >= 183970 && $char <= 183983 } { return W } + if {$char >= 183984 && $char <= 191456 } { return W } + if {$char >= 191457 && $char <= 194559 } { return W } + if {$char >= 194560 && $char <= 195101 } { return W } + if {$char >= 195102 && $char <= 195103 } { return W } + if {$char >= 195104 && $char <= 196605 } { return W } + if {$char >= 196608 && $char <= 262141 } { return W } + if {$char >= 917760 && $char <= 917999 } { return A } + if {$char >= 983040 && $char <= 1048573 } { return A } + if {$char >= 1048576 && $char <= 1114109 } { return A } + return N +} +proc ::textutil::wcswidth_char char { + if {$char >= 4352 && $char <= 4447 } { return 2 } + if {$char >= 8986 && $char <= 8987 } { return 2 } + if {$char == 9001} { return 2 } + if {$char == 9002} { return 2 } + if {$char >= 9193 && $char <= 9196 } { return 2 } + if {$char == 9200} { return 2 } + if {$char == 9203} { return 2 } + if {$char >= 9725 && $char <= 9726 } { return 2 } + if {$char >= 9748 && $char <= 9749 } { return 2 } + if {$char >= 9800 && $char <= 9811 } { return 2 } + if {$char == 9855} { return 2 } + if {$char == 9875} { return 2 } + if {$char == 9889} { return 2 } + if {$char >= 9898 && $char <= 9899 } { return 2 } + if {$char >= 9917 && $char <= 9918 } { return 2 } + if {$char >= 9924 && $char <= 9925 } { return 2 } + if {$char == 9934} { return 2 } + if {$char == 9940} { return 2 } + if {$char == 9962} { return 2 } + if {$char >= 9970 && $char <= 9971 } { return 2 } + if {$char == 9973} { return 2 } + if {$char == 9978} { return 2 } + if {$char == 9981} { return 2 } + if {$char == 9989} { return 2 } + if {$char >= 9994 && $char <= 9995 } { return 2 } + if {$char == 10024} { return 2 } + if {$char == 10060} { return 2 } + if {$char == 10062} { return 2 } + if {$char >= 10067 && $char <= 10069 } { return 2 } + if {$char == 10071} { return 2 } + if {$char >= 10133 && $char <= 10135 } { return 2 } + if {$char == 10160} { return 2 } + if {$char == 10175} { return 2 } + if {$char >= 11035 && $char <= 11036 } { return 2 } + if {$char == 11088} { return 2 } + if {$char == 11093} { return 2 } + if {$char >= 11904 && $char <= 11929 } { return 2 } + if {$char >= 11931 && $char <= 12019 } { return 2 } + if {$char >= 12032 && $char <= 12245 } { return 2 } + if {$char >= 12272 && $char <= 12283 } { return 2 } + if {$char == 12288} { return 2 } + if {$char >= 12289 && $char <= 12291 } { return 2 } + if {$char == 12292} { return 2 } + if {$char == 12293} { return 2 } + if {$char == 12294} { return 2 } + if {$char == 12295} { return 2 } + if {$char == 12296} { return 2 } + if {$char == 12297} { return 2 } + if {$char == 12298} { return 2 } + if {$char == 12299} { return 2 } + if {$char == 12300} { return 2 } + if {$char == 12301} { return 2 } + if {$char == 12302} { return 2 } + if {$char == 12303} { return 2 } + if {$char == 12304} { return 2 } + if {$char == 12305} { return 2 } + if {$char >= 12306 && $char <= 12307 } { return 2 } + if {$char == 12308} { return 2 } + if {$char == 12309} { return 2 } + if {$char == 12310} { return 2 } + if {$char == 12311} { return 2 } + if {$char == 12312} { return 2 } + if {$char == 12313} { return 2 } + if {$char == 12314} { return 2 } + if {$char == 12315} { return 2 } + if {$char == 12316} { return 2 } + if {$char == 12317} { return 2 } + if {$char >= 12318 && $char <= 12319 } { return 2 } + if {$char == 12320} { return 2 } + if {$char >= 12321 && $char <= 12329 } { return 2 } + if {$char >= 12330 && $char <= 12333 } { return 2 } + if {$char >= 12334 && $char <= 12335 } { return 2 } + if {$char == 12336} { return 2 } + if {$char >= 12337 && $char <= 12341 } { return 2 } + if {$char >= 12342 && $char <= 12343 } { return 2 } + if {$char >= 12344 && $char <= 12346 } { return 2 } + if {$char == 12347} { return 2 } + if {$char == 12348} { return 2 } + if {$char == 12349} { return 2 } + if {$char == 12350} { return 2 } + if {$char >= 12353 && $char <= 12438 } { return 2 } + if {$char >= 12441 && $char <= 12442 } { return 2 } + if {$char >= 12443 && $char <= 12444 } { return 2 } + if {$char >= 12445 && $char <= 12446 } { return 2 } + if {$char == 12447} { return 2 } + if {$char == 12448} { return 2 } + if {$char >= 12449 && $char <= 12538 } { return 2 } + if {$char == 12539} { return 2 } + if {$char >= 12540 && $char <= 12542 } { return 2 } + if {$char == 12543} { return 2 } + if {$char >= 12549 && $char <= 12591 } { return 2 } + if {$char >= 12593 && $char <= 12686 } { return 2 } + if {$char >= 12688 && $char <= 12689 } { return 2 } + if {$char >= 12690 && $char <= 12693 } { return 2 } + if {$char >= 12694 && $char <= 12703 } { return 2 } + if {$char >= 12704 && $char <= 12730 } { return 2 } + if {$char >= 12736 && $char <= 12771 } { return 2 } + if {$char >= 12784 && $char <= 12799 } { return 2 } + if {$char >= 12800 && $char <= 12830 } { return 2 } + if {$char >= 12832 && $char <= 12841 } { return 2 } + if {$char >= 12842 && $char <= 12871 } { return 2 } + if {$char == 12880} { return 2 } + if {$char >= 12881 && $char <= 12895 } { return 2 } + if {$char >= 12896 && $char <= 12927 } { return 2 } + if {$char >= 12928 && $char <= 12937 } { return 2 } + if {$char >= 12938 && $char <= 12976 } { return 2 } + if {$char >= 12977 && $char <= 12991 } { return 2 } + if {$char >= 12992 && $char <= 13054 } { return 2 } + if {$char >= 13056 && $char <= 13311 } { return 2 } + if {$char >= 13312 && $char <= 19893 } { return 2 } + if {$char >= 19894 && $char <= 19903 } { return 2 } + if {$char >= 19968 && $char <= 40943 } { return 2 } + if {$char >= 40944 && $char <= 40959 } { return 2 } + if {$char >= 40960 && $char <= 40980 } { return 2 } + if {$char == 40981} { return 2 } + if {$char >= 40982 && $char <= 42124 } { return 2 } + if {$char >= 42128 && $char <= 42182 } { return 2 } + if {$char >= 43360 && $char <= 43388 } { return 2 } + if {$char >= 44032 && $char <= 55203 } { return 2 } + if {$char >= 63744 && $char <= 64109 } { return 2 } + if {$char >= 64110 && $char <= 64111 } { return 2 } + if {$char >= 64112 && $char <= 64217 } { return 2 } + if {$char >= 64218 && $char <= 64255 } { return 2 } + if {$char >= 65040 && $char <= 65046 } { return 2 } + if {$char == 65047} { return 2 } + if {$char == 65048} { return 2 } + if {$char == 65049} { return 2 } + if {$char == 65072} { return 2 } + if {$char >= 65073 && $char <= 65074 } { return 2 } + if {$char >= 65075 && $char <= 65076 } { return 2 } + if {$char == 65077} { return 2 } + if {$char == 65078} { return 2 } + if {$char == 65079} { return 2 } + if {$char == 65080} { return 2 } + if {$char == 65081} { return 2 } + if {$char == 65082} { return 2 } + if {$char == 65083} { return 2 } + if {$char == 65084} { return 2 } + if {$char == 65085} { return 2 } + if {$char == 65086} { return 2 } + if {$char == 65087} { return 2 } + if {$char == 65088} { return 2 } + if {$char == 65089} { return 2 } + if {$char == 65090} { return 2 } + if {$char == 65091} { return 2 } + if {$char == 65092} { return 2 } + if {$char >= 65093 && $char <= 65094 } { return 2 } + if {$char == 65095} { return 2 } + if {$char == 65096} { return 2 } + if {$char >= 65097 && $char <= 65100 } { return 2 } + if {$char >= 65101 && $char <= 65103 } { return 2 } + if {$char >= 65104 && $char <= 65106 } { return 2 } + if {$char >= 65108 && $char <= 65111 } { return 2 } + if {$char == 65112} { return 2 } + if {$char == 65113} { return 2 } + if {$char == 65114} { return 2 } + if {$char == 65115} { return 2 } + if {$char == 65116} { return 2 } + if {$char == 65117} { return 2 } + if {$char == 65118} { return 2 } + if {$char >= 65119 && $char <= 65121 } { return 2 } + if {$char == 65122} { return 2 } + if {$char == 65123} { return 2 } + if {$char >= 65124 && $char <= 65126 } { return 2 } + if {$char == 65128} { return 2 } + if {$char == 65129} { return 2 } + if {$char >= 65130 && $char <= 65131 } { return 2 } + if {$char >= 65281 && $char <= 65283 } { return 2 } + if {$char == 65284} { return 2 } + if {$char >= 65285 && $char <= 65287 } { return 2 } + if {$char == 65288} { return 2 } + if {$char == 65289} { return 2 } + if {$char == 65290} { return 2 } + if {$char == 65291} { return 2 } + if {$char == 65292} { return 2 } + if {$char == 65293} { return 2 } + if {$char >= 65294 && $char <= 65295 } { return 2 } + if {$char >= 65296 && $char <= 65305 } { return 2 } + if {$char >= 65306 && $char <= 65307 } { return 2 } + if {$char >= 65308 && $char <= 65310 } { return 2 } + if {$char >= 65311 && $char <= 65312 } { return 2 } + if {$char >= 65313 && $char <= 65338 } { return 2 } + if {$char == 65339} { return 2 } + if {$char == 65340} { return 2 } + if {$char == 65341} { return 2 } + if {$char == 65342} { return 2 } + if {$char == 65343} { return 2 } + if {$char == 65344} { return 2 } + if {$char >= 65345 && $char <= 65370 } { return 2 } + if {$char == 65371} { return 2 } + if {$char == 65372} { return 2 } + if {$char == 65373} { return 2 } + if {$char == 65374} { return 2 } + if {$char == 65375} { return 2 } + if {$char == 65376} { return 2 } + if {$char >= 65504 && $char <= 65505 } { return 2 } + if {$char == 65506} { return 2 } + if {$char == 65507} { return 2 } + if {$char == 65508} { return 2 } + if {$char >= 65509 && $char <= 65510 } { return 2 } + if {$char >= 94176 && $char <= 94177 } { return 2 } + if {$char >= 94208 && $char <= 100337 } { return 2 } + if {$char >= 100352 && $char <= 101106 } { return 2 } + if {$char >= 110592 && $char <= 110847 } { return 2 } + if {$char >= 110848 && $char <= 110878 } { return 2 } + if {$char >= 110960 && $char <= 111355 } { return 2 } + if {$char == 126980} { return 2 } + if {$char == 127183} { return 2 } + if {$char == 127374} { return 2 } + if {$char >= 127377 && $char <= 127386 } { return 2 } + if {$char >= 127488 && $char <= 127490 } { return 2 } + if {$char >= 127504 && $char <= 127547 } { return 2 } + if {$char >= 127552 && $char <= 127560 } { return 2 } + if {$char >= 127568 && $char <= 127569 } { return 2 } + if {$char >= 127584 && $char <= 127589 } { return 2 } + if {$char >= 127744 && $char <= 127776 } { return 2 } + if {$char >= 127789 && $char <= 127797 } { return 2 } + if {$char >= 127799 && $char <= 127868 } { return 2 } + if {$char >= 127870 && $char <= 127891 } { return 2 } + if {$char >= 127904 && $char <= 127946 } { return 2 } + if {$char >= 127951 && $char <= 127955 } { return 2 } + if {$char >= 127968 && $char <= 127984 } { return 2 } + if {$char == 127988} { return 2 } + if {$char >= 127992 && $char <= 127994 } { return 2 } + if {$char >= 127995 && $char <= 127999 } { return 2 } + if {$char >= 128000 && $char <= 128062 } { return 2 } + if {$char == 128064} { return 2 } + if {$char >= 128066 && $char <= 128252 } { return 2 } + if {$char >= 128255 && $char <= 128317 } { return 2 } + if {$char >= 128331 && $char <= 128334 } { return 2 } + if {$char >= 128336 && $char <= 128359 } { return 2 } + if {$char == 128378} { return 2 } + if {$char >= 128405 && $char <= 128406 } { return 2 } + if {$char == 128420} { return 2 } + if {$char >= 128507 && $char <= 128511 } { return 2 } + if {$char >= 128512 && $char <= 128591 } { return 2 } + if {$char >= 128640 && $char <= 128709 } { return 2 } + if {$char == 128716} { return 2 } + if {$char >= 128720 && $char <= 128722 } { return 2 } + if {$char >= 128747 && $char <= 128748 } { return 2 } + if {$char >= 128756 && $char <= 128761 } { return 2 } + if {$char >= 129296 && $char <= 129342 } { return 2 } + if {$char >= 129344 && $char <= 129392 } { return 2 } + if {$char >= 129395 && $char <= 129398 } { return 2 } + if {$char == 129402} { return 2 } + if {$char >= 129404 && $char <= 129442 } { return 2 } + if {$char >= 129456 && $char <= 129465 } { return 2 } + if {$char >= 129472 && $char <= 129474 } { return 2 } + if {$char >= 129488 && $char <= 129535 } { return 2 } + if {$char >= 131072 && $char <= 173782 } { return 2 } + if {$char >= 173783 && $char <= 173823 } { return 2 } + if {$char >= 173824 && $char <= 177972 } { return 2 } + if {$char >= 177973 && $char <= 177983 } { return 2 } + if {$char >= 177984 && $char <= 178205 } { return 2 } + if {$char >= 178206 && $char <= 178207 } { return 2 } + if {$char >= 178208 && $char <= 183969 } { return 2 } + if {$char >= 183970 && $char <= 183983 } { return 2 } + if {$char >= 183984 && $char <= 191456 } { return 2 } + if {$char >= 191457 && $char <= 194559 } { return 2 } + if {$char >= 194560 && $char <= 195101 } { return 2 } + if {$char >= 195102 && $char <= 195103 } { return 2 } + if {$char >= 195104 && $char <= 196605 } { return 2 } + if {$char >= 196608 && $char <= 262141 } { return 2 } + return 1 +} + +proc ::textutil::wcswidth {string} { + set width 0 + set len [string length $string] + foreach c [split $string {}] { + scan $c %c char + set n [::textutil::wcswidth_char $char] + if {$n < 0} { + return -1 + } + incr width $n + } + return $width +} + diff --git a/src/mixtemplates/layouts/basic/src/make.tcl b/src/mixtemplates/layouts/basic/src/make.tcl index 547b880..c01c977 100644 --- a/src/mixtemplates/layouts/basic/src/make.tcl +++ b/src/mixtemplates/layouts/basic/src/make.tcl @@ -378,7 +378,7 @@ if {$::punkmake::command eq "bootsupport"} { set project_layouts [glob -nocomplain -dir $project_layout_base -type d -tail *] foreach layoutname $project_layouts { if {[file exists [file join $project_layout_base $layoutname/src/bootsupport]]} { - set unpublish [list\ + set antipaths [list\ README.md\ ] set sourcemodules $projectroot/src/bootsupport/modules @@ -386,7 +386,7 @@ if {$::punkmake::command eq "bootsupport"} { file mkdir $targetroot puts stdout "BOOTSUPPORT layouts/$layoutname: copying from $sourcemodules to $targetroot (if source file changed)" - set resultdict [punkcheck::install $sourcemodules $targetroot -overwrite installedsourcechanged-targets -unpublish_paths $unpublish] + set resultdict [punkcheck::install $sourcemodules $targetroot -overwrite installedsourcechanged-targets -antiglob_paths $antipaths] puts stdout [punkcheck::summarize_install_resultdict $resultdict] flush stdout } @@ -420,17 +420,17 @@ file mkdir $target_modules_base #external libs and modules first - and any supporting files - no 'building' required if {[file exists $sourcefolder/vendorlib]} { - #unpublish README.md from source folder - but only the root one - #-unpublish_paths takes relative patterns e.g + #exclude README.md from source folder - but only the root one + #-antiglob_paths takes relative patterns e.g # */test.txt will only match test.txt exactly one level deep. # */*/*.foo will match any path ending in .foo that is exactly 2 levels deep. # **/test.txt will match at any level below the root (but not in the root) - set unpublish [list\ + set antipaths [list\ README.md\ ] puts stdout "VENDORLIB: copying from $sourcefolder/vendorlib to $projectroot/lib (if source file changed)" - set resultdict [punkcheck::install $sourcefolder/vendorlib $projectroot/lib -overwrite installedsourcechanged-targets -unpublish_paths $unpublish] + set resultdict [punkcheck::install $sourcefolder/vendorlib $projectroot/lib -overwrite installedsourcechanged-targets -antiglob_paths $antipaths] puts stdout [punkcheck::summarize_install_resultdict $resultdict] } else { @@ -440,7 +440,7 @@ if {[file exists $sourcefolder/vendorlib]} { if {[file exists $sourcefolder/vendormodules]} { #install .tm *and other files* puts stdout "VENDORMODULES: copying from $sourcefolder/vendormodules to $target_modules_base (if source file changed)" - set resultdict [punkcheck::install $sourcefolder/vendormodules $target_modules_base -installer make.tcl -overwrite installedsourcechanged-targets -unpublish_paths {README.md}] + set resultdict [punkcheck::install $sourcefolder/vendormodules $target_modules_base -installer make.tcl -overwrite installedsourcechanged-targets -antiglob_paths {README.md}] puts stdout [punkcheck::summarize_install_resultdict $resultdict] } else { puts stderr "VENDORMODULES: No src/vendormodules folder found." @@ -526,7 +526,7 @@ foreach src_module_dir $source_module_folderlist { set overwrite "installedsourcechanged-targets" #set overwrite "ALL-TARGETS" puts stdout "MODULEFOLDER non_tm_files $src_module_dir - copying to $target_modules_base (if source file changed)" - set resultdict [punkcheck::install_non_tm_files $src_module_dir $target_modules_base -installer make.tcl -overwrite $overwrite -unpublish_paths {README.md}] + set resultdict [punkcheck::install_non_tm_files $src_module_dir $target_modules_base -installer make.tcl -overwrite $overwrite -antiglob_paths {README.md}] puts stdout [punkcheck::summarize_install_resultdict $resultdict] } diff --git a/src/modules/punk-0.1.tm b/src/modules/punk-0.1.tm index 4e4dc6d..09d4df0 100644 --- a/src/modules/punk-0.1.tm +++ b/src/modules/punk-0.1.tm @@ -5172,6 +5172,24 @@ namespace eval punk { return [dirfiles_dict_as_lines -stripbase 1 $contents] } + #basic (glob based) list of filenames matching tailglob - recursive - no natsorting + #todo - implement treefiles which acts like dirfiles but allows path globbing in the same way as punk::ns::ns/ + #then review if treefiles can replace dirfiles or if both should exist (dirfiles can have literal glob chars in path segments - but that is a rare usecase) + proc treefilenames {basepath {tailglob *}} { + set files [list] + if {![file isdirectory $basepath]} { + return $files + } + #todo - account for vfs where matched path could appear to be a directory but is mounted so could be a desired match? + set dirfiles [glob -nocomplain -dir $basepath -type f $tailglob] + lappend files {*}$dirfiles + set dirdirs [glob -nocomplain -dir $basepath -type d *] + foreach dir $dirdirs { + lappend files {*}[treefilenames $dir $tailglob] + } + return $files + } + #dirfiles dirfiles_dict always deliberately return absolute *unnormalized* path #e.g when cwd is c:/repo/jn/shellspy dirfiles ../../ will return something like: # c:/repo/jn/shellspy/../../blah diff --git a/src/modules/punk/cap-999999.0a1.0.tm b/src/modules/punk/cap-999999.0a1.0.tm index 4ca144c..e7021a8 100644 --- a/src/modules/punk/cap-999999.0a1.0.tm +++ b/src/modules/punk/cap-999999.0a1.0.tm @@ -14,20 +14,35 @@ # @@ Meta End +#*** !doctools +#[manpage_begin punk::cap 0 999999.0a1.0] +#[copyright "2023 JMNoble - BSD licensed"] +#[titledesc {capability provider and handler plugin system}] +#[moddesc {punk capabilities plugin system}] +#[require punk::cap] +#[description] +#[section Overview] +#[para]punk::cap provides management of named capabilities and the provider packages and handler packages that implement a pluggable capability. +#[subsection Concepts] +#[para]A [term capability] may be something like providing a folder of files, or just a data dictionary, and/or an API +# +#[para][term {capability handler}] - a package/namespace which may provide validation and standardised ways of looking up provider data +# registered (or not) using register_capabilityname +# +#[para][term {capability provider}] - a package which registers as providing one or more capablities. +#[para]registered using register_package +#the capabilitylist is a list of 2-element lists where the first element is the capabilityname and the second element is a (possibly empty) dict of data relevant to that capability +#A capabilityname may appear multiple times. ie a package may register that it provides the capability with multiple datasets. + + +#*** !doctools +#[section API] + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Requirements ##e.g package require frobz - -#concepts: -# A capability may be something like providing a folder of files, or just a data dictionary, and/or an API -# -# capability handler - a package/namespace which may provide validation and standardised ways of looking up provider data -# registered (or not) using register_capabilityname -# capability provider - a package which registers as providing one or more capablities. -# registered using register_package -# the capabilitylist is a list of 2-element lists where the first element is the capabilityname and the second element is a (possibly empty) dict of data relevant to that capability -# A capabilityname may appear multiple times. ie a package may register that it provides the capability with multiple datasets. +package require oolib # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ @@ -35,67 +50,179 @@ namespace eval punk::cap { variable pkgcapsdeclared [dict create] variable pkgcapsaccepted [dict create] variable caps [dict create] - if {[info commands [namespace current]::interface_caphandler.registry] eq ""} { - oo::class create [namespace current]::interface_caphandler.registry { - method pkg_register {pkg capname capdict fullcapabilitylist} { - #handler may override and return 0 (indicating don't register)e.g if pkg capdict data wasn't valid - #overridden handler must be able to handle multiple calls for same pkg - but it may return 1 or 0 as it wishes. - return 1 ;#default to permit - } - method pkg_unregister {pkg} { - return ;#unregistration return is ignored - review - } - } - - oo::class create [namespace current]::interface_capprovider.registration { - method get_declarations {} { - error "interface_capprovider.registration not implemented by provider" - } - } - oo::class create [namespace current]::interface_capprovider.provider { - variable provider_pkg - variable registrationobj - constructor {providerpkg} { - variable provider_pkg - if {$providerpkg in [list "" "::"]} { - error "interface_capprovider.provider constructor error. Invalid provider '$providerpkg'" + namespace eval class { + if {[info commands [namespace current]::interface_caphandler.registry] eq ""} { + #*** !doctools + #[subsection {Namespace punk::cap::class}] + #[para] class definitions + #[list_begin itemized] [comment {- punk::cap::class groupings -}] + # [item] + # [para] [emph {handler_classes}] + # [list_begin enumerated] + + oo::class create [namespace current]::interface_caphandler.registry { + #*** !doctools + #[enum] [emph {CLASS interface_caphandler.registry}] + #[list_begin definitions] + method pkg_register {pkg capname capdict fullcapabilitylist} { + #*** !doctools + #[call class::[class interface_caphandler.registry] [method pkg_register] [arg pkg] [arg capname] [arg capdict] [arg fullcapabilitylist]] + #handler may override and return 0 (indicating don't register)e.g if pkg capdict data wasn't valid + #overridden handler must be able to handle multiple calls for same pkg - but it may return 1 or 0 as it wishes. + return 1 ;#default to permit } - if {![namespace exists ::$providerpkg]} { - error "interface_capprovider.provider constructor error. Invalid provider '$providerpkg' - matching namespace not found" + method pkg_unregister {pkg} { + #*** !doctools + #[call class::[class interface_caphandler.registry] [method pkg_unregister] [arg pkg]] + return ;#unregistration return is ignored - review } + #*** !doctools + #[list_end] + } - set registrationobj ::${providerpkg}::capsystem::capprovider.registration - if {[info commands $registrationobj] eq ""} { - error "capprovider.provider constructor error. Missing capprovider.registration interface at '$obj' (command not found) interface_capprovider.regstration instantiation must precede interface_capprovider.provider" - } + oo::class create [namespace current]::interface_caphandler.sysapi { + #*** !doctools + #[enum] [emph {CLASS interface_caphandler.sysapi}] + #[list_begin definitions] - set provider_pkg [string trim $providerpkg ""] + #*** !doctools + #[list_end] } - method register {{capabilityname_glob *}} { - variable provider_pkg - set all_decls [$registrationobj get_declarations] - set register_decls [lsearch -all -inline -index 0 $all_decls $capabilityname_glob] - punk::cap::register_package $provider_pkg $register_decls + + #*** !doctools + # [list_end] [comment {- end enumeration handler classes -}] + + #*** !doctools + # [item] + # [para] [emph {provider_classes}] + # [list_begin enumerated] + + #Provider classes + oo::class create [namespace current]::interface_capprovider.registration { + #*** !doctools + # [enum] [emph {CLASS interface_cappprovider.registration}] + # Your provider package will need to instantiate this object under a sub-namespace called [namespace capsystem] within your package namespace. + # [para]If your package namespace is mypackages::providerpkg then the object command would be at mypackages::providerpkg::capsystem::capprovider.registration + # [para]Example code for your provider package to evaluate within its namespace: + # [example { + #namespace eval capsystem { + # if {[info commands capprovider.registration] eq ""} { + # punk::cap::class::interface_capprovider.registration create capprovider.registration + # oo::objdefine capprovider.registration { + # method get_declarations {} { + # set decls [list] + # lappend decls [list punk.templates {relpath ../templates}] + # lappend decls [list another_capability_name {somekey blah key2 etc}] + # return $decls + # } + # } + # } + #} + #}] + #[para] The above example declares that your package can be registered as a provider for the capabilities named 'punk.templates' and 'another_capability_name' + # [list_begin definitions] + method get_declarations {} { + #*** + #[call class::[class interface_capprovider.registration] [method get_declarations]] + #[para] This method must be overridden by your provider using oo::objdefine cappprovider.registration as in the example above. + # There must be at least one 2-element list in the result for the provider to be registerable. + #[para]The first element of the list is the capabilityname - which can be custom to your provider/handler packages - or a well-known name that other authors may use/implement. + #[para]The second element is a dictionary of keys specific to the capability being implemented. It may be empty if the any potential capability handlers for the named capability don't require registration data. + error "interface_capprovider.registration not implemented by provider" + } + #*** !doctools + # [list_end] } - method capabilities {} { + + oo::class create [namespace current]::interface_capprovider.provider { + #*** !doctools + # [enum] [emph {CLASS interface_capprovider.provider}] + # [para] Your provider package will need to instantiate this directly under it's own namespace with the command name of [emph {provider}] + # [example { + # namespace eval mypackages::providerpkg { + # punk::cap::class::interface_capprovider.provider create provider mypackages::providerpkg + # } + # }] + # [list_begin definitions] variable provider_pkg variable registrationobj + constructor {providerpkg} { + #*** !doctools + #[call class::[class interface_capprovider.provider] [method constructor] [arg providerpkg]] + variable provider_pkg + if {$providerpkg in [list "" "::"]} { + error "interface_capprovider.provider constructor error. Invalid provider '$providerpkg'" + } + if {![namespace exists ::$providerpkg]} { + error "interface_capprovider.provider constructor error. Invalid provider '$providerpkg' - matching namespace not found" + } - set capabilities [list] - set decls [$registrationobj get_declarations] - foreach decl $decls { - lassign $decl capname capdict - if {$capname ni $capabilities} { - lappend capabilities $capname + set registrationobj ::${providerpkg}::capsystem::capprovider.registration + if {[info commands $registrationobj] eq ""} { + error "capprovider.provider constructor error. Missing capprovider.registration interface at '$obj' (command not found) interface_capprovider.regstration instantiation must precede interface_capprovider.provider" } + + set provider_pkg [string trim $providerpkg ""] + + } + method register {{capabilityname_glob *}} { + #*** !doctools + #[comment {- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---}] + #[call class::[class interface_capprovider.provider] [method register] [opt capabilityname_glob]] + # + #[para]This is the mechanism by which a user of your provider package will register your package as a provider of the capability named. + # + #[para]A user of your provider may elect to register all your declared capabilities: + #[example { + # package require mypackages::providerpkg + # mypackages::providerpkg::provider register * + #}] + #[para] Or a specific capability may be registered: + #[example { + # package require mypackages::providerpkg + # mypackages::providerpkg::provider register another_capability_name + #}] + # + variable provider_pkg + set all_decls [$registrationobj get_declarations] + set register_decls [lsearch -all -inline -index 0 $all_decls $capabilityname_glob] + punk::cap::register_package $provider_pkg $register_decls + } + method capabilities {} { + #*** !doctools + #[comment {- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---}] + #[call class::[class interface_capprovider.provider] [method capabilities]] + #[para] return a list of capabilities supported by this provider package + variable provider_pkg + variable registrationobj + + set capabilities [list] + set decls [$registrationobj get_declarations] + foreach decl $decls { + lassign $decl capname capdict + if {$capname ni $capabilities} { + lappend capabilities $capname + } + } + return $capabilities } - return $capname + #*** !doctools + # [list_end] [comment {- end class definitions -}] } + #*** !doctools + # [list_end] [comment {- end enumeration provider_classes }] + #[list_end] [comment {- end itemized list punk::cap::class groupings -}] } - } - #Not all capabilities have to be registered. - #A package registering as a provider using register_package can include capabilitynames in it's capabilitylist which have no associated capnamespace (handler). + } ;# end namespace class + + #*** !doctools + #[subsection {Namespace punk::cap}] + #[para] Main punk::cap API for client programs interested in using capability handler packages and associated (registered) provider packages + #[list_begin definitions] + + #Not all capability names have to be registered. + #A package registering as a provider using register_package can include capabilitynames in it's capabilitylist which have no associated handler. #such unregistered capabilitynames may be used just to flag something, or have datamembers significant to callers cooperatively interested in that capname. #we allow registering a capability with an empty handler (capnamespace) - but this means another handler could be registered later. proc register_capabilityname {capname capnamespace} { @@ -111,7 +238,7 @@ namespace eval punk::cap { #allow register of existing capname iff there is no current handler #as handlers can be used to validate during provider registration - ideally handlers should be registered before any pkgs call register_package #we allow loading a handler later though - but will need to validate existing data from pkgs that have already registered as providers - if {[set hdlr [get_handler $capname]] ne ""} { + if {[set hdlr [capability_get_handler $capname]] ne ""} { error "register_capabilityname cannot register capability:$capname with handler:$capnamespace. There is already a registered handler:$hdlr" } #assert: capnamespace may or may not be empty string, capname may or may not already exist in caps dict, caps $capname providers may have existing entries. @@ -121,7 +248,7 @@ namespace eval punk::cap { } if {[llength [set providers [dict get $caps $capname providers]]]} { #some provider(s) were in place before the handler was registered - if {[set capreg [get_caphandler_registry $capname]] ne ""} { + if {[set capreg [punk::cap::capsystem::get_caphandler_registry $capname]] ne ""} { foreach pkg $providers { set fullcapabilitylist [dict get $pkgcapsdeclared $pkg] foreach capspec $fullcapabilitylist { @@ -163,47 +290,38 @@ namespace eval punk::cap { } } - proc exists {capname} { + proc capability_exists {capname} { + #*** !doctools + # [call [fun capability_exists] [arg capname]] + # Return a boolean indicating if the named capability exists (0|1) variable caps return [dict exists $caps $capname] } - proc has_handler {capname} { + proc capability_has_handler {capname} { + #*** !doctools + # [call [fun capability_has_handler] [arg capname]] + #Return a boolean indicating if the named capability has a handler package installed (0|1) variable caps return [expr {[dict exists $caps $capname handler] && [dict get $caps $capname handler] ne ""}] } - proc get_handler {capname} { + proc capability_get_handler {capname} { + #*** !doctools + # [call [fun capability_get_handler] [arg capname]] + #Return the base namespace of the active handler package for the named capability. + #[para] The base namespace for a handler will always be the package name, but prefixed with :: variable caps if {[dict exists $caps $capname]} { return [dict get $caps $capname handler] } return "" } - - #dispatch - #proc call_handler {capname args} { - # if {[set handler [get_handler $capname]] eq ""} { - # error "punk::cap::call_handler $capname $args - no handler registered for capability $capname" - # } - # ${handler}::[lindex $args 0] {*}[lrange $args 1 end] - #} proc call_handler {capname args} { - if {[set handler [get_handler $capname]] eq ""} { + if {[set handler [capability_get_handler $capname]] eq ""} { error "punk::cap::call_handler $capname $args - no handler registered for capability $capname" } - set obj ${handler}::$capname + set obj ${handler}::api_$capname $obj [lindex $args 0] {*}[lrange $args 1 end] } - proc get_caphandler_registry {capname} { - set ns [get_handler $capname]::capsystem - if {[namespace exists ${ns}]} { - if {[info command ${ns}::caphandler.registry] ne ""} { - if {[info object isa object ${ns}::caphandler.registry]} { - return ${ns}::caphandler.registry - } - } - } - return "" - } proc get_providers {capname} { variable caps if {[dict exists $caps $capname]} { @@ -214,10 +332,21 @@ namespace eval punk::cap { #register package with arbitrary capnames from capabilitylist #The registered pkg is a module that provides some service to that capname. Possibly just data members, that the capability will use. - proc register_package {pkg capabilitylist} { + proc register_package {pkg capabilitylist args} { variable pkgcapsdeclared variable pkgcapsaccepted variable caps + set defaults [dict create\ + -nowarnings false + ] + dict for {k v} $args { + if {$k ni $defaults} { + error "Unrecognized option $k. Known options [dict keys $defaults]" + } + } + set opts [dict merge $defaults $args] + set warnings [expr {! [dict get $opts -nowarnings]}] + if {[string match ::* $pkg]} { set pkg [string range $pkg 2 end] } @@ -226,11 +355,23 @@ namespace eval punk::cap { } else { set pkg_already_accepted [list] } + package require $pkg + set providerapi ::${pkg}::provider + if {[info commands $providerapi] eq ""} { + error "register_package error. pkg '$pkg' doesn't seem to be a punk::cap capability provider (no object found at $providerapi)" + } + set defined_caps [$providerapi capabilities] #for each capability # - ensure 1st element is a single word # - ensure that if 2nd element (capdict) is present - it is dict shaped foreach capspec $capabilitylist { lassign $capspec capname capdict + + if {$warnings} { + if {$capname ni $defined_caps} { + puts stderr "WARNING: pkg '$pkg' doesn't declare support for capability '$capname'." + } + } if {[llength $capname] !=1} { error "register_package error. pkg: '$pkg' An entry in the capability list doesn't appear to have a single-word name. Problematic entry:'$capspec'" } @@ -239,7 +380,9 @@ namespace eval punk::cap { } if {$capspec in $pkg_already_accepted} { #review - multiple handlers? if so - will need to record which handler(s) accepted the capspec - puts stderr "register_package pkg $pkg already has capspec marked as accepted: $capspec" + if {$warnings} { + puts stderr "WARNING: register_package pkg $pkg already has capspec marked as accepted: $capspec" + } continue } if {[dict exists $caps $capname]} { @@ -250,7 +393,7 @@ namespace eval punk::cap { } #todo - if there's a caphandler - call it's init/validation callback for the pkg set do_register 1 ;#default assumption unless vetoed by handler - if {[set capreg [get_caphandler_registry $capname]] ne ""} { + if {[set capreg [punk::cap::capsystem::get_caphandler_registry $capname]] ne ""} { #Note that the interface_caphandler.registry instance must be able to handle multiple calls for same pkg set do_register [$capreg pkg_register $pkg $capname $capdict $capabilitylist] } @@ -294,13 +437,13 @@ namespace eval punk::cap { set pkglist [dict get $cap_info providers] set posn [lsearch $pkglist $pkg] if {$posn >= 0} { - if {[set capreg [get_caphandler_registry $capname]] ne ""} { + if {[set capreg [punk::cap::capsystem::get_caphandler_registry $capname]] ne ""} { #review # it seems not useful to allow the callback to block this unregister action #the pkg may have multiple datasets for each capname so callback will only be called for first dataset we encounter #vetoing unregister would make this more complex for no particular advantage #if per dataset deregistration required this should probably be a separate thing - $capreg pkg_unregister $pkg + $capreg pkg_unregister $pkg $capname } set pkglist [lreplace $pkglist $posn $posn] dict set caps $capname providers $pkglist @@ -311,73 +454,6 @@ namespace eval punk::cap { } } - #review promote/demote doesn't always make a lot of sense .. should possibly be per cap for multicap pkgs - #The idea is to provide a crude way to preference/depreference packages independently of order the packages were loaded - #e.g a caller or cap-handler can ascribe some meaning to the order of the 'providers' key returned from punk::cap::capabilities - #The order of providers will be the order the packages were loaded & registered - #the naming: "promote vs demote" operates on a latest-package-in-list has higher preference assumption (matching last pkg loaded) - #Each capability handler could implement specific preferencing methods if finer control needed. - #In some cases the preference/loading order may be inapplicable/irrelevant to a particular capability anyway. - #As this is just a basic mechanism, which can't support independent per-cap preferencing for multi-cap packages - - # it only allows putting the pkgs to the head or tail of the lists. - #Whether particular caps or users of caps do anything with this ordering is dependent on the cap-handler and/or calling code. - proc promote_package {pkg} { - variable pkgcapsdeclared - variable caps - if {[string match ::* $pkg]} { - set pkg [string range $pkg 2 end] - } - if {![dict exists $pkgcapsdeclared $pkg]} { - error "punk::cap::promote_package error pkg'$pkg' not registered. Use register_package \$pkg first" - } - if {[dict size $pkgcapsdeclared] > 1} { - set pkginfo [dict get $pkgcapsdeclared $pkg] - #remove and re-add at end of dict - dict unset pkgcapsdeclared $pkg - dict set pkgcapsdeclared $pkg $pkginfo - dict for {cap cap_info} $caps { - set cap_pkgs [dict get $cap_info providers] - if {$pkg in $cap_pkgs} { - set posn [lsearch $cap_pkgs $pkg] - if {$posn >=0} { - #rewrite package list with pkg at tail of list for this capability - set cap_pkgs [lreplace $cap_pkgs $posn $posn] - lappend cap_pkgs $pkg - dict set caps $cap providers $cap_pkgs - } - } - } - } - } - proc demote_package {pkg} { - variable pkgcapsdeclared - variable caps - if {[string match ::* $pkg]} { - set pkg [string range $pkg 2 end] - } - if {![dict exists $pkgcapsdeclared $pkg]} { - error "punk::cap::promote_package error pkg'$pkg' not registered. Use register_package \$pkg first" - } - if {[dict size $pkgcapsdeclared] > 1} { - set pkginfo [dict get $pkgcapsdeclared $pkg] - #remove and re-add at start of dict - dict unset pkgcapsdeclared $pkg - dict set pkgcapsdeclared $pkg $pkginfo - set pkgcapsdeclared [dict merge [dict create $pkg $pkginfo] $pkgcapsdeclared] - dict for {cap cap_info} $caps { - set cap_pkgs [dict get $cap_info providers] - if {$pkg in $cap_pkgs} { - set posn [lsearch $cap_pkgs $pkg] - if {$posn >=0} { - #rewrite package list with pkg at head of list for this capability - set cap_pkgs [lreplace $cap_pkgs $posn $posn] - set cap_pkgs [list $pkg {*}$cap_pkgs] - dict set caps $cap providers $cap_pkgs - } - } - } - } - } proc pkgcap {pkg} { variable pkgcapsdeclared variable pkgcapsaccepted @@ -442,19 +518,122 @@ namespace eval punk::cap { } return $cap_list } + #*** !doctools + #[list_end] [comment {- end definitions for namespace punk::cap -}] + + namespace eval advanced { + #*** !doctools + #[subsection {Namespace punk::cap::advanced}] + #[para] punk::cap::advanced API. Functions here are generally not the preferred way to interact with punk::cap. + #[para] In some cases they may allow interaction in less safe ways or may allow use of features that are unavailable in the base namespace. + #[para] Some functions are here because they are only marginally or rarely useful, and they are here to keep the base API simple. + #[list_begin definitions] + + proc promote_provider {pkg} { + #*** !doctools + # [call advanced::[fun promote_provider] [arg pkg]] + #[para]Move the named provider package to the preferred end of the list (tail). + #[para]The active handler may or may not utilise this for preferencing. See documentation for the specific handler package to confirm. + #[para] + #[para] promote/demote doesn't always make a lot of sense .. should preferably be configurable per capapbility for multicap provider pkgs + #[para]The idea is to provide a crude way to preference/depreference packages independently of order the packages were loaded + #e.g a caller or cap-handler can ascribe some meaning to the order of the 'providers' key returned from punk::cap::capabilities + #[para]The order of providers will be the order the packages were loaded & registered + #[para]the naming: "promote vs demote" operates on a latest-package-in-list has higher preference assumption (matching last pkg loaded) + #[para]Each capability handler could and should implement specific preferencing methods within its own API if finer control needed. + #In some cases the preference/loading order may be inapplicable/irrelevant to a particular capability anyway. + #[para]As this is just a basic mechanism, which can't support independent per-cap preferencing for multi-cap packages - + # it only allows putting the pkgs to the head or tail of the lists. + #[para]Whether particular caps or users of caps do anything with this ordering is dependent on the cap-handler and/or calling code. + variable pkgcapsdeclared + variable caps + if {[string match ::* $pkg]} { + set pkg [string range $pkg 2 end] + } + if {![dict exists $pkgcapsdeclared $pkg]} { + error "punk::cap::promote_package error pkg'$pkg' not registered. Use register_package \$pkg first" + } + if {[dict size $pkgcapsdeclared] > 1} { + set pkginfo [dict get $pkgcapsdeclared $pkg] + #remove and re-add at end of dict + dict unset pkgcapsdeclared $pkg + dict set pkgcapsdeclared $pkg $pkginfo + dict for {cap cap_info} $caps { + set cap_pkgs [dict get $cap_info providers] + if {$pkg in $cap_pkgs} { + set posn [lsearch $cap_pkgs $pkg] + if {$posn >=0} { + #rewrite package list with pkg at tail of list for this capability + set cap_pkgs [lreplace $cap_pkgs $posn $posn] + lappend cap_pkgs $pkg + dict set caps $cap providers $cap_pkgs + } + } + } + } + } + proc demote_provider {pkg} { + #*** !doctools + # [call advanced::[fun demote_provider] [arg pkg]] + #[para]Move the named provider package to the preferred end of the list (tail). + #[para]The active handler may or may not utilise this for preferencing. See documentation for the specific handler package to confirm. + variable pkgcapsdeclared + variable caps + if {[string match ::* $pkg]} { + set pkg [string range $pkg 2 end] + } + if {![dict exists $pkgcapsdeclared $pkg]} { + error "punk::cap::promote_package error pkg'$pkg' not registered. Use register_package \$pkg first" + } + if {[dict size $pkgcapsdeclared] > 1} { + set pkginfo [dict get $pkgcapsdeclared $pkg] + #remove and re-add at start of dict + dict unset pkgcapsdeclared $pkg + dict set pkgcapsdeclared $pkg $pkginfo + set pkgcapsdeclared [dict merge [dict create $pkg $pkginfo] $pkgcapsdeclared] + dict for {cap cap_info} $caps { + set cap_pkgs [dict get $cap_info providers] + if {$pkg in $cap_pkgs} { + set posn [lsearch $cap_pkgs $pkg] + if {$posn >=0} { + #rewrite package list with pkg at head of list for this capability + set cap_pkgs [lreplace $cap_pkgs $posn $posn] + set cap_pkgs [list $pkg {*}$cap_pkgs] + dict set caps $cap providers $cap_pkgs + } + } + } + } + } -} - - - - - - - - - + #*** !doctools + #[list_end] + } +#*** !doctools +#[section Internal] + + namespace eval capsystem { + #*** !doctools + #[subsection {Namespace punk::cap::capsystem}] + #[para] Internal functions used to communicate between punk::cap and capability handlers + #[list_begin definitions] + proc get_caphandler_registry {capname} { + set ns [::punk::cap::capability_get_handler $capname]::capsystem + if {[namespace exists ${ns}]} { + if {[info command ${ns}::caphandler.registry] ne ""} { + if {[info object isa object ${ns}::caphandler.registry]} { + return ${ns}::caphandler.registry + } + } + } + return "" + } + #*** !doctools + #[list_end] + } +} @@ -462,6 +641,17 @@ namespace eval punk::cap { ## Ready package provide punk::cap [namespace eval punk::cap { variable version + variable pkg punk::cap set version 999999.0a1.0 + variable README.md [string map [list %pkg% $pkg %ver% $version] { + # punk capabilities system + ## pkg: %pkg% version: %ver% + + punk::cap base namespace + }] + return $version }] -return \ No newline at end of file +return + +#*** !doctools +#[manpage_end] diff --git a/src/modules/punk/cap.html b/src/modules/punk/cap.html new file mode 100644 index 0000000..c41be49 --- /dev/null +++ b/src/modules/punk/cap.html @@ -0,0 +1,123 @@ + + + + + + + + +Documentation cap-999999.0a1.0 + + + + + +

Documentation cap-999999.0a1.0

+

JMNoble

+

2023-12-19

+ +

Concepts:

+

A capability may be something like providing a folder of files, or just a data dictionary, and/or an API

+ +

capability handler - a package/namespace which may provide validation and standardised ways of looking up provider data + registered (or not) using register_capabilityname

+ +

capability provider - a package which registers as providing one or more capablities. + registered using register_package + the capabilitylist is a list of 2-element lists where the first element is the capabilityname and the second element is a (possibly empty) dict of data relevant to that capability + A capabilityname may appear multiple times. ie a package may register that it provides the capability with multiple datasets.

+
+ +

exists(capname)

+ +
+

return a boolean indicating the existence of a capability

+ +

Arguments:

+ +
    +
  • capname - string indicating the name of the capability +
+ +
%pkg%Module API
punk::capcapability provider and handler plugin system
punk::capModule API
punkshell punkshell - Core
+ + + + + + +
Returns: 01
+ + + + diff --git a/src/modules/punk/cap.md b/src/modules/punk/cap.md new file mode 100644 index 0000000..353a30e --- /dev/null +++ b/src/modules/punk/cap.md @@ -0,0 +1,29 @@ +--- +author: NN +css: mkdoc.css +date: 2023-12-19 +title: Documentation cap-999999.0a1.0 +--- +> concepts: +> A capability may be something like providing a folder of files, or just a data dictionary, and/or an API + +> capability handler - a package/namespace which may provide validation and standardised ways of looking up provider data + registered (or not) using register_capabilityname + +> capability provider - a package which registers as providing one or more capablities. + registered using register_package + the capabilitylist is a list of 2-element lists where the first element is the capabilityname and the second element is a (possibly empty) dict of data relevant to that capability + A capabilityname may appear multiple times. ie a package may register that it provides the capability with multiple datasets. + +## **exists(capname)** + +> return a boolean indicating the existence of a capability + +> Arguments: + +> - *capname* - string indicating the name of the capability + +> Returns: 0|1 + + + diff --git a/src/modules/punk/cap/handlers/templates-999999.0a1.0.tm b/src/modules/punk/cap/handlers/templates-999999.0a1.0.tm index ce739f1..886de4d 100644 --- a/src/modules/punk/cap/handlers/templates-999999.0a1.0.tm +++ b/src/modules/punk/cap/handlers/templates-999999.0a1.0.tm @@ -35,10 +35,14 @@ namespace eval punk::cap::handlers::templates { namespace eval capsystem { #interfaces for punk::cap to call into if {[info commands caphandler.registry] eq ""} { - punk::cap::interface_caphandler.registry create caphandler.registry + punk::cap::class::interface_caphandler.registry create caphandler.registry oo::objdefine caphandler.registry { method pkg_register {pkg capname capdict caplist} { #caplist may not be complete set - which somewhat reduces its utility here regarding any decisions based on the context of this capname/capdict (review - remove this arg?) + + # -- --- --- --- --- --- --- ---- --- + # validation of capdict + # -- --- --- --- --- --- --- ---- --- if {![dict exists $capdict relpath]} { puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of '$capname' capability, but is missing 'relpath' key" return 0 @@ -54,15 +58,26 @@ namespace eval punk::cap::handlers::templates { puts stderr "punk::cap::handlers::templates::capsystem pkg_register WARNING - unable to validate relpath location [dict get $capdict relpath] ($tpath) for package '$pkg' which is attempting to register with punk::cap as a provider of '$capname' capability" return 0 } + + + # -- --- --- --- --- --- --- ---- --- + # update package internal data + # -- --- --- --- --- --- --- ---- --- if {$capname ni $::punk::cap::handlers::templates::handled_caps} { lappend ::punk::cap::handlers::templates::handled_caps $capname } - if {[info commands ::punk::cap::handlers::templates::$capname] eq ""} { - punk::cap::handlers::templates::api create ::punk::cap::handlers::templates::$capname $capname - } set cname [string map [list . _] $capname] upvar ::punk::cap::handlers::templates::pkg_folders_$cname pfolders dict lappend pfolders $pkg $tpath + + + # -- --- --- --- --- --- --- ---- --- + # instantiation of api at punk::cap::handlers::templates::api_$capname + # -- --- --- --- --- --- --- ---- --- + if {[info commands ::punk::cap::handlers::templates::$capname] eq ""} { + punk::cap::handlers::templates::class::api create ::punk::cap::handlers::templates::api_$capname $capname + } + return 1 } method pkg_unregister {pkg} { @@ -85,36 +100,38 @@ namespace eval punk::cap::handlers::templates { #handler api for clients of this capability - called via punk::cap::call_handler ?args? # -- --- --- --- --- --- --- namespace export * - - oo::class create api { - #return a dict keyed on folder with source pkg as value - constructor {capname} { - variable capabilityname - variable cname - set cname [string map [list . _] $capname] - set capabilityname $capname - } - method folders {} { - variable capabilityname - variable cname - upvar punk::cap::handlers::templates::pkg_folders_$cname pkg_folders - package require punk::cap - set capinfo [punk::cap::capability $capabilityname] - # e.g {punk.templates {handler punk::mix::templates providers ::somepkg}} - - #use the order of pkgs as registered with punk::cap - may have been modified with punk::cap::promote_package/demote_package - set pkgs [dict get $capinfo providers] - set folderdict [dict create] - foreach pkg $pkgs { - foreach pfolder [dict get $pkg_folders $pkg] { - dict set folderdict $pfolder [list source $pkg sourcetype package] + namespace eval class { + oo::class create api { + #return a dict keyed on folder with source pkg as value + constructor {capname} { + variable capabilityname + variable cname + set cname [string map [list . _] $capname] + set capabilityname $capname + } + method folders {} { + variable capabilityname + variable cname + upvar punk::cap::handlers::templates::pkg_folders_$cname pkg_folders + package require punk::cap + set capinfo [punk::cap::capability $capabilityname] + # e.g {punk.templates {handler punk::mix::templates providers ::somepkg}} + + #use the order of pkgs as registered with punk::cap - may have been modified with punk::cap::promote_package/demote_package + set pkgs [dict get $capinfo providers] + set folderdict [dict create] + foreach pkg $pkgs { + foreach pfolder [dict get $pkg_folders $pkg] { + dict set folderdict $pfolder [list source $pkg sourcetype package] + } } + return $folderdict } - return $folderdict } } + } diff --git a/src/modules/punk/docgen-999999.0a1.0.tm b/src/modules/punk/docgen-999999.0a1.0.tm new file mode 100644 index 0000000..a308c4f --- /dev/null +++ b/src/modules/punk/docgen-999999.0a1.0.tm @@ -0,0 +1,71 @@ + +# -*- tcl -* +# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from -buildversion.txt +# +# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. +# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# (C) 2023 +# +# @@ Meta Begin +# Application punk::docgen 999999.0a1.0 +# Meta platform tcl +# Meta license BSD +# @@ Meta End + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Requirements +##e.g package require frobz + +package require punk::repo + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval punk::docgen { + proc get_doctools_comments {fname} { + #does no validation of doctools commands + #existence of string match #\**!doctools is taken as evidence enough that the file has inline doctools - review + if {![file exists $fname]} { + error "get_doctools_comments file '$fname' not found" + } + set fd [open $fname r] + set data [read $fd] + close $fd + if {![string match "*#\**!doctools*" $data]} { + return + } + set data [string map [list \r\n \n] $data] + set in_doctools 0 + set doctools "" + foreach ln [split $data \n] { + set ln [string trim $ln] + if {$in_doctools && [string index $ln 0] != "#"} { + set in_doctools 0 + } elseif {[string range $ln 0 1] == "#*"} { + #todo - process doctools ordering hints in tail of line + set in_doctools 1 + } elseif {$in_doctools} { + append doctools [string range $ln 1 end] \n + } + } + return $doctools + } + #todo - proc autogen_doctools_comments {fname} {} + # - will probably need to use something like parsetcl - as we won't be able to reliably source in an interp without side-effects and use info body etc. + # - mechanism will be to autodocument namespaces, procs, methods where no #*** doctools indication present - but use existing doctools comments for that particular item if it is present. + + + +} + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Ready +package provide punk::docgen [namespace eval punk::docgen { + variable pkg punk::docgen + variable version + set version 999999.0a1.0 +}] +return \ No newline at end of file diff --git a/src/modules/punk/docgen-buildversion.txt b/src/modules/punk/docgen-buildversion.txt new file mode 100644 index 0000000..f47d01c --- /dev/null +++ b/src/modules/punk/docgen-buildversion.txt @@ -0,0 +1,3 @@ +0.1.0 +#First line must be a semantic version number +#all other lines are ignored. diff --git a/src/modules/punk/mix/cli-0.3.tm b/src/modules/punk/mix/cli-0.3.tm index 790cfc6..437b1c4 100644 --- a/src/modules/punk/mix/cli-0.3.tm +++ b/src/modules/punk/mix/cli-0.3.tm @@ -477,7 +477,13 @@ namespace eval punk::mix::cli { set did_skip 0 ;#flag for stdout/stderr formatting only foreach m $src_modules { - #puts "build_modules_from_source_to_base >>> module $m" + set is_interesting 0 + if {[string match "foobar" $current_source_dir]} { + set is_interesting 1 + } + if {$is_interesting} { + puts "build_modules_from_source_to_base >>> module $current_source_dir/$m" + } set fileparts [split [file rootname $m] -] set tmfile_versionsegment [lindex $fileparts end] if {$tmfile_versionsegment eq $magicversion} { @@ -582,7 +588,9 @@ namespace eval punk::mix::cli { #set file_record [punkcheck::installfile_finished_install $basedir $file_record] $event targetset_end OK } else { - #puts stdout "skipping module $current_source_dir/$m - no change in sources detected" + if {$is_interesting} { + puts stdout "skipping module $current_source_dir/$m - no change in sources detected" + } puts -nonewline stderr "." set did_skip 1 #set file_record [punkcheck::installfile_skipped_install $basedir $file_record] @@ -627,15 +635,18 @@ namespace eval punk::mix::cli { $event targetset_started # -- --- --- --- --- --- if {$did_skip} {set did_skip 0; puts -nonewline stdout \n} - puts stderr "Copied already versioned module $current_source_dir/$m to $target_module_dir" lappend module_list $current_source_dir/$m file copy -force $current_source_dir/$m $target_module_dir + puts stderr "Copied already versioned module $current_source_dir/$m to $target_module_dir" # -- --- --- --- --- --- #set file_record [punkcheck::installfile_finished_install $basedir $file_record] $event targetset_end OK -note "already versioned module" } else { puts -nonewline stderr "." set did_skip 1 + if {$is_interesting} { + puts stderr "$current_source_dir/$m [$event targetset_source_changes]" + } #set file_record [punkcheck::installfile_skipped_install $basedir $file_record] $event targetset_end SKIPPED } diff --git a/src/modules/punk/mix/commandset/doc-999999.0a1.0.tm b/src/modules/punk/mix/commandset/doc-999999.0a1.0.tm index b7be138..b4f8325 100644 --- a/src/modules/punk/mix/commandset/doc-999999.0a1.0.tm +++ b/src/modules/punk/mix/commandset/doc-999999.0a1.0.tm @@ -18,7 +18,11 @@ ## Requirements ##e.g package require frobz - +package require punk ;# for treefilenames +package require punk::repo +package require punk::docgen ;#inline doctools - generate doctools .man files at src/docgen prior to using kettle to producing .html .md etc +package require punk::mix::cli ;#punk::mix::cli::lib used for kettle_call +package require punk::mix::util ;#for path_relative # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ @@ -38,6 +42,30 @@ namespace eval punk::mix::commandset::doc { puts stderr "No current project dir - unable to build docs" return } + #user may delete the comment containing "--- punk::docgen::overwrites" and then manually edit, and we won't overwrite + #we still generate output in src/docgen so user can diff and manually update if thats what they prefer + set oldfiles [glob -nocomplain -dir $projectdir/src/doc -type f _module_*] + foreach maybedoomed $oldfiles { + set fd [open $maybedoomed r] + set data [read $fd] + close $fd + if {[string match "*--- punk::docgen overwrites *" $data]} { + file delete -force $maybedoomed + } + } + set generated [lib::do_docgen modules] + if {[dict get $generated count] > 0} { + #review + set doclist [dict get $generated docs] + foreach dinfo $doclist { + lassign $dinfo module fpath + set target $projectdir/src/doc/_module_[file tail $fpath] + if {![file exists $target]} { + file copy $fpath $target + } + } + } + if {[file exists $projectdir/src/doc]} { set original_wd [pwd] cd $projectdir/src @@ -125,6 +153,7 @@ namespace eval punk::mix::commandset::doc { cd $original_wd } proc validate {} { + #todo - run and validate punk::docgen output set projectdir [punk::repo::find_project] if {$projectdir eq ""} { puts stderr "No current project dir - unable to check doc status" @@ -154,6 +183,49 @@ namespace eval punk::mix::commandset::doc { namespace eval lib { variable pkg set pkg punk::mix::commandset::doc + proc do_docgen {{project_subpath modules}} { + set projectdir [punk::repo::find_project] + set outdir [file join $projectdir src docgen] + set subpath [file join $projectdir $project_subpath] + if {![file isdirectory $subpath]} { + puts stderr "WARNING punk::mix::commandset::doc unable to find subpath $subpath during do_docgen - skipping inline doctools generation" + return + } + if {[file isdirectory $outdir]} { + if {[catch { + file delete -force $outdir + }]} { + error "do_docgen failed to delete existing $outdir" + } + } + file mkdir $outdir + + set matched_paths [punk::treefilenames $subpath *.tm] + set count 0 + set newdocs [list] + set docgen_header_comments "" + append docgen_header_comments {[comment {--- punk::docgen generated from inline doctools comments ---}]} \n + append docgen_header_comments {[comment {--- punk::docgen DO NOT EDIT DOCS HERE UNLESS YOU REMOVE THESE COMMENT LINES ---}]} \n + append docgen_header_comments {[comment {--- punk::docgen overwrites this file ---}]} \n + foreach fullpath $matched_paths { + set relpath [punk::mix::util::path_relative $subpath $fullpath] + set tailsegs [file split $relpath] + set module_fullname [join $tailsegs ::] + set docname [string map [list :: _] $module_fullname].man ;#todo - something better - need to ensure unique + set doctools [punk::docgen::get_doctools_comments $fullpath] + if {$doctools ne ""} { + puts stdout "generating doctools output from file $relpath" + set outfile [file join $outdir $docname] + set fd [open $outfile w] + fconfigure $fd -translation binary + puts -nonewline $fd $docgen_header_comments$doctools + close $fd + incr count + lappend newdocs [list $module_fullname $outfile] + } + } + return [list count $count docs $newdocs] + } } } diff --git a/src/modules/punk/mix/commandset/project-999999.0a1.0.tm b/src/modules/punk/mix/commandset/project-999999.0a1.0.tm index 7102ded..91b8ccb 100644 --- a/src/modules/punk/mix/commandset/project-999999.0a1.0.tm +++ b/src/modules/punk/mix/commandset/project-999999.0a1.0.tm @@ -242,7 +242,7 @@ namespace eval punk::mix::commandset::project { set layout_dir $templatebase/layouts/$opt_layout puts stdout ">>> about to call punkcheck::install $layout_dir $projectdir" set resultdict [dict create] - set unpublish [list\ + set antipaths [list\ src/doc/*\ src/doc/include/*\ ] @@ -250,11 +250,11 @@ namespace eval punk::mix::commandset::project { #default antiglob_dir_core will stop .fossil* from being updated - which is generally desirable as these are likely to be customized if {$opt_force} { puts stdout "copying layout files - with force applied - overwrite all-targets" - set resultdict [punkcheck::install $layout_dir $projectdir -installer project.new -overwrite ALL-TARGETS -unpublish_paths $unpublish] + set resultdict [punkcheck::install $layout_dir $projectdir -installer project.new -overwrite ALL-TARGETS -antiglob_paths $antipaths] #file copy -force $layout_dir $projectdir } else { puts stdout "copying layout files - (if source file changed)" - set resultdict [punkcheck::install $layout_dir $projectdir -installer project.new -overwrite installedsourcechanged-targets -unpublish_paths $unpublish] + set resultdict [punkcheck::install $layout_dir $projectdir -installer project.new -overwrite installedsourcechanged-targets -antiglob_paths $antipaths] } puts stdout [punkcheck::summarize_install_resultdict $resultdict] diff --git a/src/modules/punk/mix/templates-999999.0a1.0.tm b/src/modules/punk/mix/templates-999999.0a1.0.tm index 7a0654e..4250125 100644 --- a/src/modules/punk/mix/templates-999999.0a1.0.tm +++ b/src/modules/punk/mix/templates-999999.0a1.0.tm @@ -32,7 +32,7 @@ namespace eval punk::mix::templates { namespace eval capsystem { if {[info commands capprovider.registration] eq ""} { - punk::cap::interface_capprovider.registration create capprovider.registration + punk::cap::class::interface_capprovider.registration create capprovider.registration oo::objdefine capprovider.registration { method get_declarations {} { set decls [list] @@ -46,7 +46,7 @@ namespace eval punk::mix::templates { } if {[info commands provider] eq ""} { - punk::cap::interface_capprovider.provider create provider punk::mix::templates + punk::cap::class::interface_capprovider.provider create provider punk::mix::templates oo::objdefine provider { method register {{capabilityname_glob *}} { #puts registering punk::mix::templates $capabilityname diff --git a/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/mime-1.7.0.tm b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/mime-1.7.0.tm new file mode 100644 index 0000000..fa46076 --- /dev/null +++ b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/mime-1.7.0.tm @@ -0,0 +1,3942 @@ +# mime.tcl - MIME body parts +# +# (c) 1999-2000 Marshall T. Rose +# (c) 2000 Brent Welch +# (c) 2000 Sandeep Tamhankar +# (c) 2000 Dan Kuchler +# (c) 2000-2001 Eric Melski +# (c) 2001 Jeff Hobbs +# (c) 2001-2008 Andreas Kupries +# (c) 2002-2003 David Welton +# (c) 2003-2008 Pat Thoyts +# (c) 2005 Benjamin Riefenstahl +# (c) 2013-2021 Poor Yorick +# +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# Influenced by Borenstein's/Rose's safe-tcl (circa 1993) and Darren New's +# unpublished package of 1999. +# + +# new string features and inline scan are used, requiring 8.3. +package require Tcl 8.5 + +package provide mime 1.7.0 +package require tcl::chan::memchan + + +if {[catch {package require Trf 2.0}]} { + + # Fall-back to tcl-based procedures of base64 and quoted-printable + # encoders + ## + # Warning! + ## + # These are a fragile emulations of the more general calling + # sequence that appears to work with this code here. + ## + # The `__ignored__` arguments are expected to be `--` options on + # the caller's side. (See the uses in `copymessageaux`, + # `buildmessageaux`, `parsepart`, and `getbody`). + + package require base64 2.0 + set ::major [lindex [split [package require md5] .] 0] + + # Create these commands in the mime namespace so that they + # won't collide with things at the global namespace level + + namespace eval ::mime { + proc base64 {-mode what __ignored__ chunk} { + return [base64::$what $chunk] + } + proc quoted-printable {-mode what __ignored__ chunk} { + return [mime::qp_$what $chunk] + } + + if {$::major < 2} { + # md5 v1, result is hex string ready for use. + proc md5 {__ignored__ string} { + return [md5::md5 $string] + } + } else { + # md5 v2, need option to get hex string + proc md5 {__ignored__ string} { + return [md5::md5 -hex $string] + } + } + } + + unset ::major +} + +# +# state variables: +# +# canonicalP: input is in its canonical form +# content: type/subtype +# params: dictionary (keys are lower-case) +# encoding: transfer encoding +# version: MIME-version +# header: dictionary (keys are lower-case) +# lowerL: list of header keys, lower-case +# mixedL: list of header keys, mixed-case +# value: either "file", "parts", or "string" +# +# file: input file +# fd: cached file-descriptor, typically for root +# root: token for top-level part, for (distant) subordinates +# offset: number of octets from beginning of file/string +# count: length in octets of (encoded) content +# +# parts: list of bodies (tokens) +# +# string: input string +# +# cid: last child-id assigned +# + + +namespace eval ::mime { + variable mime + array set mime {uid 0 cid 0} + + # RFC 822 lexemes + variable addrtokenL + lappend addrtokenL \; , < > : . ( ) @ \" \[ ] \\ + variable addrlexemeL { + LX_SEMICOLON LX_COMMA + LX_LBRACKET LX_RBRACKET + LX_COLON LX_DOT + LX_LPAREN LX_RPAREN + LX_ATSIGN LX_QUOTE + LX_LSQUARE LX_RSQUARE + LX_QUOTE + } + + # RFC 2045 lexemes + variable typetokenL + lappend typetokenL \; , < > : ? ( ) @ \" \[ \] = / \\ + variable typelexemeL { + LX_SEMICOLON LX_COMMA + LX_LBRACKET LX_RBRACKET + LX_COLON LX_QUESTION + LX_LPAREN LX_RPAREN + LX_ATSIGN LX_QUOTE + LX_LSQUARE LX_RSQUARE + LX_EQUALS LX_SOLIDUS + LX_QUOTE + } + + variable encList { + ascii US-ASCII + big5 Big5 + cp1250 Windows-1250 + cp1251 Windows-1251 + cp1252 Windows-1252 + cp1253 Windows-1253 + cp1254 Windows-1254 + cp1255 Windows-1255 + cp1256 Windows-1256 + cp1257 Windows-1257 + cp1258 Windows-1258 + cp437 IBM437 + cp737 {} + cp775 IBM775 + cp850 IBM850 + cp852 IBM852 + cp855 IBM855 + cp857 IBM857 + cp860 IBM860 + cp861 IBM861 + cp862 IBM862 + cp863 IBM863 + cp864 IBM864 + cp865 IBM865 + cp866 IBM866 + cp869 IBM869 + cp874 {} + cp932 {} + cp936 GBK + cp949 {} + cp950 {} + dingbats {} + ebcdic {} + euc-cn EUC-CN + euc-jp EUC-JP + euc-kr EUC-KR + gb12345 GB12345 + gb1988 GB1988 + gb2312 GB2312 + iso2022 ISO-2022 + iso2022-jp ISO-2022-JP + iso2022-kr ISO-2022-KR + iso8859-1 ISO-8859-1 + iso8859-2 ISO-8859-2 + iso8859-3 ISO-8859-3 + iso8859-4 ISO-8859-4 + iso8859-5 ISO-8859-5 + iso8859-6 ISO-8859-6 + iso8859-7 ISO-8859-7 + iso8859-8 ISO-8859-8 + iso8859-9 ISO-8859-9 + iso8859-10 ISO-8859-10 + iso8859-13 ISO-8859-13 + iso8859-14 ISO-8859-14 + iso8859-15 ISO-8859-15 + iso8859-16 ISO-8859-16 + jis0201 JIS_X0201 + jis0208 JIS_C6226-1983 + jis0212 JIS_X0212-1990 + koi8-r KOI8-R + koi8-u KOI8-U + ksc5601 KS_C_5601-1987 + macCentEuro {} + macCroatian {} + macCyrillic {} + macDingbats {} + macGreek {} + macIceland {} + macJapan {} + macRoman {} + macRomania {} + macThai {} + macTurkish {} + macUkraine {} + shiftjis Shift_JIS + symbol {} + tis-620 TIS-620 + unicode {} + utf-8 UTF-8 + } + + variable encodings + array set encodings $encList + variable reversemap + # Initialized at the bottom of the file + + variable encAliasList { + ascii ANSI_X3.4-1968 + ascii iso-ir-6 + ascii ANSI_X3.4-1986 + ascii ISO_646.irv:1991 + ascii ASCII + ascii ISO646-US + ascii us + ascii IBM367 + ascii cp367 + cp437 cp437 + cp437 437 + cp775 cp775 + cp850 cp850 + cp850 850 + cp852 cp852 + cp852 852 + cp855 cp855 + cp855 855 + cp857 cp857 + cp857 857 + cp860 cp860 + cp860 860 + cp861 cp861 + cp861 861 + cp861 cp-is + cp862 cp862 + cp862 862 + cp863 cp863 + cp863 863 + cp864 cp864 + cp865 cp865 + cp865 865 + cp866 cp866 + cp866 866 + cp869 cp869 + cp869 869 + cp869 cp-gr + cp936 CP936 + cp936 MS936 + cp936 Windows-936 + iso8859-1 ISO_8859-1:1987 + iso8859-1 iso-ir-100 + iso8859-1 ISO_8859-1 + iso8859-1 latin1 + iso8859-1 l1 + iso8859-1 IBM819 + iso8859-1 CP819 + iso8859-2 ISO_8859-2:1987 + iso8859-2 iso-ir-101 + iso8859-2 ISO_8859-2 + iso8859-2 latin2 + iso8859-2 l2 + iso8859-3 ISO_8859-3:1988 + iso8859-3 iso-ir-109 + iso8859-3 ISO_8859-3 + iso8859-3 latin3 + iso8859-3 l3 + iso8859-4 ISO_8859-4:1988 + iso8859-4 iso-ir-110 + iso8859-4 ISO_8859-4 + iso8859-4 latin4 + iso8859-4 l4 + iso8859-5 ISO_8859-5:1988 + iso8859-5 iso-ir-144 + iso8859-5 ISO_8859-5 + iso8859-5 cyrillic + iso8859-6 ISO_8859-6:1987 + iso8859-6 iso-ir-127 + iso8859-6 ISO_8859-6 + iso8859-6 ECMA-114 + iso8859-6 ASMO-708 + iso8859-6 arabic + iso8859-7 ISO_8859-7:1987 + iso8859-7 iso-ir-126 + iso8859-7 ISO_8859-7 + iso8859-7 ELOT_928 + iso8859-7 ECMA-118 + iso8859-7 greek + iso8859-7 greek8 + iso8859-8 ISO_8859-8:1988 + iso8859-8 iso-ir-138 + iso8859-8 ISO_8859-8 + iso8859-8 hebrew + iso8859-9 ISO_8859-9:1989 + iso8859-9 iso-ir-148 + iso8859-9 ISO_8859-9 + iso8859-9 latin5 + iso8859-9 l5 + iso8859-10 iso-ir-157 + iso8859-10 l6 + iso8859-10 ISO_8859-10:1992 + iso8859-10 latin6 + iso8859-14 iso-ir-199 + iso8859-14 ISO_8859-14:1998 + iso8859-14 ISO_8859-14 + iso8859-14 latin8 + iso8859-14 iso-celtic + iso8859-14 l8 + iso8859-15 ISO_8859-15 + iso8859-15 Latin-9 + iso8859-16 iso-ir-226 + iso8859-16 ISO_8859-16:2001 + iso8859-16 ISO_8859-16 + iso8859-16 latin10 + iso8859-16 l10 + jis0201 X0201 + jis0208 iso-ir-87 + jis0208 x0208 + jis0208 JIS_X0208-1983 + jis0212 x0212 + jis0212 iso-ir-159 + ksc5601 iso-ir-149 + ksc5601 KS_C_5601-1989 + ksc5601 KSC5601 + ksc5601 korean + shiftjis MS_Kanji + utf-8 UTF8 + } + + namespace export {*}{ + copymessage finalize getbody getheader getproperty initialize + mapencoding parseaddress parsedatetime reversemapencoding setheader + uniqueID + } +} + +# ::mime::initialize -- +# +# Creates a MIME part, and returnes the MIME token for that part. +# +# Arguments: +# args Args can be any one of the following: +# ?-canonical type/subtype +# ?-param {key value}?... +# ?-encoding value? +# ?-header {key value}?... ? +# (-file name | -string value | -parts {token1 ... tokenN}) +# +# If the -canonical option is present, then the body is in +# canonical (raw) form and is found by consulting either the -file, +# -string, or -parts option. +# +# In addition, both the -param and -header options may occur zero +# or more times to specify "Content-Type" parameters (e.g., +# "charset") and header keyword/values (e.g., +# "Content-Disposition"), respectively. +# +# Also, -encoding, if present, specifies the +# "Content-Transfer-Encoding" when copying the body. +# +# If the -canonical option is not present, then the MIME part +# contained in either the -file or the -string option is parsed, +# dynamically generating subordinates as appropriate. +# +# Results: +# An initialized mime token. + +proc ::mime::initialize args { + global errorCode errorInfo + + variable mime + + set token [namespace current]::[incr mime(uid)] + # FRINK: nocheck + variable $token + upvar 0 $token state + + if {[catch [list mime::initializeaux $token {*}$args] result eopts]} { + catch {mime::finalize $token -subordinates dynamic} + return -options $eopts $result + } + return $token +} + +# ::mime::initializeaux -- +# +# Configures the MIME token created in mime::initialize based on +# the arguments that mime::initialize supports. +# +# Arguments: +# token The MIME token to configure. +# args Args can be any one of the following: +# ?-canonical type/subtype +# ?-param {key value}?... +# ?-encoding value? +# ?-header {key value}?... ? +# (-file name | -string value | -parts {token1 ... tokenN}) +# +# Results: +# Either configures the mime token, or throws an error. + +proc ::mime::initializeaux {token args} { + global errorCode errorInfo + # FRINK: nocheck + variable $token + upvar 0 $token state + + array set params [set state(params) {}] + set state(encoding) {} + set state(version) 1.0 + + set state(header) {} + set state(lowerL) {} + set state(mixedL) {} + + set state(cid) 0 + + set userheader 0 + + set argc [llength $args] + for {set argx 0} {$argx < $argc} {incr argx} { + set option [lindex $args $argx] + if {[incr argx] >= $argc} { + error "missing argument to $option" + } + set value [lindex $args $argx] + + switch -- $option { + -canonical { + set state(content) [string tolower $value] + } + + -param { + if {[llength $value] != 2} { + error "-param expects a key and a value, not $value" + } + set lower [string tolower [set mixed [lindex $value 0]]] + if {[info exists params($lower)]} { + error "the $mixed parameter may be specified at most once" + } + + set params($lower) [lindex $value 1] + set state(params) [array get params] + } + + -encoding { + set value [string tolower $value[set value {}]] + + switch -- $value { + 7bit - 8bit - binary - quoted-printable - base64 { + } + + default { + error "unknown value for -encoding $state(encoding)" + } + } + set state(encoding) [string tolower $value] + } + + -header { + if {[llength $value] != 2} { + error "-header expects a key and a value, not $value" + } + set lower [string tolower [set mixed [lindex $value 0]]] + if {$lower eq {content-type}} { + error "use -canonical instead of -header $value" + } + if {$lower eq {content-transfer-encoding}} { + error "use -encoding instead of -header $value" + } + if {$lower in {content-md5 mime-version}} { + error {don't go there...} + } + if {$lower ni $state(lowerL)} { + lappend state(lowerL) $lower + lappend state(mixedL) $mixed + } + + set userheader 1 + + array set header $state(header) + lappend header($lower) [lindex $value 1] + set state(header) [array get header] + } + + -file { + set state(file) $value + } + + -parts { + set state(parts) $value + } + + -string { + set state(string) $value + + set state(lines) [split $value \n] + set state(lines.count) [llength $state(lines)] + set state(lines.current) 0 + } + + -root { + # the following are internal options + + set state(root) $value + } + + -offset { + set state(offset) $value + } + + -count { + set state(count) $value + } + + -lineslist { + set state(lines) $value + set state(lines.count) [llength $state(lines)] + set state(lines.current) 0 + #state(string) is needed, but will be built when required + set state(string) {} + } + + default { + error "unknown option $option" + } + } + } + + #We only want one of -file, -parts or -string: + set valueN 0 + foreach value {file parts string} { + if {[info exists state($value)]} { + set state(value) $value + incr valueN + } + } + if {$valueN != 1 && ![info exists state(lines)]} { + error {specify exactly one of -file, -parts, or -string} + } + + if {[set state(canonicalP) [info exists state(content)]]} { + switch -- $state(value) { + file { + set state(offset) 0 + } + + parts { + switch -glob -- $state(content) { + text/* + - + image/* + - + audio/* + - + video/* { + error "-canonical $state(content) and -parts do not mix" + } + + default { + if {$state(encoding) ne {}} { + error {-encoding and -parts do not mix} + } + } + } + } + default {# Go ahead} + } + + if {[lsearch -exact $state(lowerL) content-id] < 0} { + lappend state(lowerL) content-id + lappend state(mixedL) Content-ID + + array set header $state(header) + lappend header(content-id) [uniqueID] + set state(header) [array get header] + } + + set state(version) 1.0 + return + } + + if {$state(params) ne {}} { + error {-param requires -canonical} + } + if {$state(encoding) ne {}} { + error {-encoding requires -canonical} + } + if {$userheader} { + error {-header requires -canonical} + } + if {[info exists state(parts)]} { + error {-parts requires -canonical} + } + + if {[set fileP [info exists state(file)]]} { + if {[set openP [info exists state(root)]]} { + # FRINK: nocheck + variable $state(root) + upvar 0 $state(root) root + + set state(fd) $root(fd) + } else { + set state(root) $token + set state(fd) [open $state(file) RDONLY] + set state(offset) 0 + seek $state(fd) 0 end + set state(count) [tell $state(fd)] + + fconfigure $state(fd) -translation binary + } + } + + set code [catch {mime::parsepart $token} result] + set ecode $errorCode + set einfo $errorInfo + + if {$fileP} { + if {!$openP} { + unset state(root) + catch {close $state(fd)} + } + unset state(fd) + } + + return -code $code -errorinfo $einfo -errorcode $ecode $result +} + +# ::mime::parsepart -- +# +# Parses the MIME headers and attempts to break up the message +# into its various parts, creating a MIME token for each part. +# +# Arguments: +# token The MIME token to parse. +# +# Results: +# Throws an error if it has problems parsing the MIME token, +# otherwise it just sets up the appropriate variables. + +proc ::mime::parsepart {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + if {[set fileP [info exists state(file)]]} { + seek $state(fd) [set pos $state(offset)] start + set last [expr {$state(offset) + $state(count) - 1}] + } else { + set string $state(string) + } + + set vline {} + while 1 { + set blankP 0 + if {$fileP} { + if {($pos > $last) || ([set x [gets $state(fd) line]] <= 0)} { + set blankP 1 + } else { + incr pos [expr {$x + 1}] + } + } else { + if {$state(lines.current) >= $state(lines.count)} { + set blankP 1 + set line {} + } else { + set line [lindex $state(lines) $state(lines.current)] + incr state(lines.current) + set x [string length $line] + if {$x == 0} {set blankP 1} + } + } + + if {!$blankP && [string match *\r $line]} { + set line [string range $line 0 $x-2]] + if {$x == 1} { + set blankP 1 + } + } + + if {!$blankP && ( + [string first { } $line] == 0 + || + [string first \t $line] == 0 + )} { + append vline \n $line + continue + } + + if {$vline eq {}} { + if {$blankP} { + break + } + + set vline $line + continue + } + + if { + [set x [string first : $vline]] <= 0 + || + [set mixed [string trimright [ + string range $vline 0 [expr {$x - 1}]]]] eq {} + } { + error "improper line in header: $vline" + } + set value [string trim [string range $vline [expr {$x + 1}] end]] + switch -- [set lower [string tolower $mixed]] { + content-type { + if {[info exists state(content)]} { + error "multiple Content-Type fields starting with $vline" + } + + if {![catch {set x [parsetype $token $value]}]} { + set state(content) [lindex $x 0] + set state(params) [lindex $x 1] + } + } + + content-md5 { + } + + content-transfer-encoding { + if { + $state(encoding) ne {} + && + $state(encoding) ne [string tolower $value] + } { + error "multiple Content-Transfer-Encoding fields starting with $vline" + } + + set state(encoding) [string tolower $value] + } + + mime-version { + set state(version) $value + } + + default { + if {[lsearch -exact $state(lowerL) $lower] < 0} { + lappend state(lowerL) $lower + lappend state(mixedL) $mixed + } + + array set header $state(header) + lappend header($lower) $value + set state(header) [array get header] + } + } + + if {$blankP} { + break + } + set vline $line + } + + if {![info exists state(content)]} { + set state(content) text/plain + set state(params) [list charset us-ascii] + } + + if {![string match multipart/* $state(content)]} { + if {$fileP} { + set x [tell $state(fd)] + incr state(count) [expr {$state(offset) - $x}] + set state(offset) $x + } else { + # rebuild string, this is cheap and needed by other functions + set state(string) [join [ + lrange $state(lines) $state(lines.current) end] \n] + } + + if {[string match message/* $state(content)]} { + # FRINK: nocheck + variable [set child $token-[incr state(cid)]] + + set state(value) parts + set state(parts) $child + if {$fileP} { + mime::initializeaux $child \ + -file $state(file) -root $state(root) \ + -offset $state(offset) -count $state(count) + } else { + if {[info exists state(encoding)]} { + set strng [join [ + lrange $state(lines) $state(lines.current) end] \n] + switch -- $state(encoding) { + base64 - + quoted-printable { + set strng [$state(encoding) -mode decode -- $strng] + } + default {} + } + mime::initializeaux $child -string $strng + } else { + mime::initializeaux $child -lineslist [ + lrange $state(lines) $state(lines.current) end] + } + } + } + + return + } + + set state(value) parts + + set boundary {} + foreach {k v} $state(params) { + if {$k eq {boundary}} { + set boundary $v + break + } + } + if {$boundary eq {}} { + error "boundary parameter is missing in $state(content)" + } + if {[string trim $boundary] eq {}} { + error "boundary parameter is empty in $state(content)" + } + + if {$fileP} { + set pos [tell $state(fd)] + # This variable is like 'start', for the reasons laid out + # below, in the other branch of this conditional. + set initialpos $pos + } else { + # This variable is like 'start', a list of lines in the + # part. This record is made even before we find a starting + # boundary and used if we run into the terminating boundary + # before a starting boundary was found. In that case the lines + # before the terminator as recorded by tracelines are seen as + # the part, or at least we attempt to parse them as a + # part. See the forceoctet and nochild flags later. We cannot + # use 'start' as that records lines only after the starting + # boundary was found. + set tracelines [list] + } + + set inP 0 + set moreP 1 + set forceoctet 0 + while {$moreP} { + if {$fileP} { + if {$pos > $last} { + # We have run over the end of the part per the outer + # information without finding a terminating boundary. + # We now fake the boundary and force the parser to + # give any new part coming of this a mime-type of + # application/octet-stream regardless of header + # information. + set line "--$boundary--" + set x [string length $line] + set forceoctet 1 + } else { + if {[set x [gets $state(fd) line]] < 0} { + error "end-of-file encountered while parsing $state(content)" + } + } + incr pos [expr {$x + 1}] + } else { + if {$state(lines.current) >= $state(lines.count)} { + error "end-of-string encountered while parsing $state(content)" + } else { + set line [lindex $state(lines) $state(lines.current)] + incr state(lines.current) + set x [string length $line] + } + set x [string length $line] + } + if {[string last \r $line] == $x - 1} { + set line [string range $line 0 [expr {$x - 2}]] + set crlf 2 + } else { + set crlf 1 + } + + if {[string first --$boundary $line] != 0} { + if {$inP && !$fileP} { + lappend start $line + } + continue + } else { + lappend tracelines $line + } + + if {!$inP} { + # Haven't seen the starting boundary yet. Check if the + # current line contains this starting boundary. + + if {$line eq "--$boundary"} { + # Yes. Switch parser state to now search for the + # terminating boundary of the part and record where + # the part begins (or initialize the recorder for the + # lines in the part). + set inP 1 + if {$fileP} { + set start $pos + } else { + set start [list] + } + continue + } elseif {$line eq "--$boundary--"} { + # We just saw a terminating boundary before we ever + # saw the starting boundary of a part. This forces us + # to stop parsing, we do this by forcing the parser + # into an accepting state. We will try to create a + # child part based on faked start position or recorded + # lines, or, if that fails, let the current part have + # no children. + + # As an example note the test case mime-3.7 and the + # referenced file "badmail1.txt". + + set inP 1 + if {$fileP} { + set start $initialpos + } else { + set start $tracelines + } + set forceoctet 1 + # Fall through. This brings to the creation of the new + # part instead of searching further and possible + # running over the end. + } else { + continue + } + } + + # Looking for the end of the current part. We accept both a + # terminating boundary and the starting boundary of the next + # part as the end of the current part. + + if {[set moreP [string compare $line --$boundary--]] + && $line ne "--$boundary"} { + + # The current part has not ended, so we record the line + # if we are inside a part and doing string parsing. + if {$inP && !$fileP} { + lappend start $line + } + continue + } + + # The current part has ended. We now determine the exact + # boundaries, create a mime part object for it and recursively + # parse it deeper as part of that action. + + # FRINK: nocheck + variable [set child $token-[incr state(cid)]] + + lappend state(parts) $child + + set nochild 0 + if {$fileP} { + if {[set count [expr {$pos - ($start + $x + $crlf + 1)}]] < 0} { + set count 0 + } + if {$forceoctet} { + set ::errorInfo {} + if {[catch { + mime::initializeaux $child \ + -file $state(file) -root $state(root) \ + -offset $start -count $count + }]} { + set nochild 1 + set state(parts) [lrange $state(parts) 0 end-1] + } } else { + mime::initializeaux $child \ + -file $state(file) -root $state(root) \ + -offset $start -count $count + } + seek $state(fd) [set start $pos] start + } else { + if {$forceoctet} { + if {[catch { + mime::initializeaux $child -lineslist $start + }]} { + set nochild 1 + set state(parts) [lrange $state(parts) 0 end-1] + } + } else { + mime::initializeaux $child -lineslist $start + } + set start {} + } + if {$forceoctet && !$nochild} { + variable $child + upvar 0 $child childstate + set childstate(content) application/octet-stream + } + set forceoctet 0 + } +} + +# ::mime::parsetype -- +# +# Parses the string passed in and identifies the content-type and +# params strings. +# +# Arguments: +# token The MIME token to parse. +# string The content-type string that should be parsed. +# +# Results: +# Returns the content and params for the string as a two element +# tcl list. + +proc ::mime::parsetype {token string} { + global errorCode errorInfo + # FRINK: nocheck + variable $token + upvar 0 $token state + + variable typetokenL + variable typelexemeL + + set state(input) $string + set state(buffer) {} + set state(lastC) LX_END + set state(comment) {} + set state(tokenL) $typetokenL + set state(lexemeL) $typelexemeL + + set code [catch {mime::parsetypeaux $token $string} result] + set ecode $errorCode + set einfo $errorInfo + + unset {*}{ + state(input) + state(buffer) + state(lastC) + state(comment) + state(tokenL) + state(lexemeL) + } + + return -code $code -errorinfo $einfo -errorcode $ecode $result +} + +# ::mime::parsetypeaux -- +# +# A helper function for mime::parsetype. Parses the specified +# string looking for the content type and params. +# +# Arguments: +# token The MIME token to parse. +# string The content-type string that should be parsed. +# +# Results: +# Returns the content and params for the string as a two element +# tcl list. + +proc ::mime::parsetypeaux {token string} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + if {[parselexeme $token] ne {LX_ATOM}} { + error [format {expecting type (found %s)} $state(buffer)] + } + set type [string tolower $state(buffer)] + + switch -- [parselexeme $token] { + LX_SOLIDUS { + } + + LX_END { + if {$type ne {message}} { + error "expecting type/subtype (found $type)" + } + + return [list message/rfc822 {}] + } + + default { + error [format "expecting \"/\" (found %s)" $state(buffer)] + } + } + + if {[parselexeme $token] ne {LX_ATOM}} { + error [format "expecting subtype (found %s)" $state(buffer)] + } + append type [string tolower /$state(buffer)] + + array set params {} + while 1 { + switch -- [parselexeme $token] { + LX_END { + return [list $type [array get params]] + } + + LX_SEMICOLON { + } + + default { + error [format "expecting \";\" (found %s)" $state(buffer)] + } + } + + switch -- [parselexeme $token] { + LX_END { + return [list $type [array get params]] + } + + LX_ATOM { + } + + default { + error [format "expecting attribute (found %s)" $state(buffer)] + } + } + + set attribute [string tolower $state(buffer)] + + if {[parselexeme $token] ne {LX_EQUALS}} { + error [format {expecting "=" (found %s)} $state(buffer)] + } + + switch -- [parselexeme $token] { + LX_ATOM { + } + + LX_QSTRING { + set state(buffer) [ + string range $state(buffer) 1 [ + expr {[string length $state(buffer)] - 2}]] + } + + default { + error [format {expecting value (found %s)} $state(buffer)] + } + } + set params($attribute) $state(buffer) + } +} + +# ::mime::finalize -- +# +# mime::finalize destroys a MIME part. +# +# If the -subordinates option is present, it specifies which +# subordinates should also be destroyed. The default value is +# "dynamic". +# +# Arguments: +# token The MIME token to parse. +# args Args can be optionally be of the following form: +# ?-subordinates "all" | "dynamic" | "none"? +# +# Results: +# Returns an empty string. + +proc ::mime::finalize {token args} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + array set options [list -subordinates dynamic] + array set options $args + + switch -- $options(-subordinates) { + all { + #TODO: this code path is untested + if {$state(value) eq {parts}} { + foreach part $state(parts) { + eval [linsert $args 0 mime::finalize $part] + } + } + } + + dynamic { + for {set cid $state(cid)} {$cid > 0} {incr cid -1} { + eval [linsert $args 0 mime::finalize $token-$cid] + } + } + + none { + } + + default { + error "unknown value for -subordinates $options(-subordinates)" + } + } + + foreach name [array names state] { + unset state($name) + } + # FRINK: nocheck + unset $token +} + +# ::mime::getproperty -- +# +# mime::getproperty returns the properties of a MIME part. +# +# The properties are: +# +# property value +# ======== ===== +# content the type/subtype describing the content +# encoding the "Content-Transfer-Encoding" +# params a list of "Content-Type" parameters +# parts a list of tokens for the part's subordinates +# size the approximate size of the content (unencoded) +# +# The "parts" property is present only if the MIME part has +# subordinates. +# +# If mime::getproperty is invoked with the name of a specific +# property, then the corresponding value is returned; instead, if +# -names is specified, a list of all properties is returned; +# otherwise, a dictionary of properties is returned. +# +# Arguments: +# token The MIME token to parse. +# property One of 'content', 'encoding', 'params', 'parts', and +# 'size'. Defaults to returning a dictionary of +# properties. +# +# Results: +# Returns the properties of a MIME part + +proc ::mime::getproperty {token {property {}}} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + switch -- $property { + {} { + array set properties [list content $state(content) \ + encoding $state(encoding) \ + params $state(params) \ + size [getsize $token]] + if {[info exists state(parts)]} { + set properties(parts) $state(parts) + } + + return [array get properties] + } + + -names { + set names [list content encoding params] + if {[info exists state(parts)]} { + lappend names parts + } + + return $names + } + + content + - + encoding + - + params { + return $state($property) + } + + parts { + if {![info exists state(parts)]} { + error {MIME part is a leaf} + } + + return $state(parts) + } + + size { + return [getsize $token] + } + + default { + error "unknown property $property" + } + } +} + +# ::mime::getsize -- +# +# Determine the size (in bytes) of a MIME part/token +# +# Arguments: +# token The MIME token to parse. +# +# Results: +# Returns the size in bytes of the MIME token. + +proc ::mime::getsize {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + switch -- $state(value)/$state(canonicalP) { + file/0 { + set size $state(count) + } + + file/1 { + return [file size $state(file)] + } + + parts/0 + - + parts/1 { + set size 0 + foreach part $state(parts) { + incr size [getsize $part] + } + + return $size + } + + string/0 { + set size [string length $state(string)] + } + + string/1 { + return [string length $state(string)] + } + default { + error "Unknown combination \"$state(value)/$state(canonicalP)\"" + } + } + + if {$state(encoding) eq {base64}} { + set size [expr {($size * 3 + 2) / 4}] + } + + return $size +} + + +proc ::mime::getContentType token { + variable $token + upvar 0 $token state + set boundary {} + set res $state(content) + foreach {k v} $state(params) { + set boundary $v + append res ";\n $k=\"$v\"" + } + if {([string match multipart/* $state(content)]) \ + && ($boundary eq {})} { + # we're doing everything in one pass... + set key [clock seconds]$token[info hostname][array get state] + set seqno 8 + while {[incr seqno -1] >= 0} { + set key [md5 -- $key] + } + set boundary "----- =_[string trim [base64 -mode encode -- $key]]" + + append res ";\n boundary=\"$boundary\"" + } + return $res +} + +# ::mime::getheader -- +# +# mime::getheader returns the header of a MIME part. +# +# A header consists of zero or more key/value pairs. Each value is a +# list containing one or more strings. +# +# If mime::getheader is invoked with the name of a specific key, then +# a list containing the corresponding value(s) is returned; instead, +# if -names is specified, a list of all keys is returned; otherwise, a +# dictionary is returned. Note that when a +# key is specified (e.g., "Subject"), the list returned usually +# contains exactly one string; however, some keys (e.g., "Received") +# often occur more than once in the header, accordingly the list +# returned usually contains more than one string. +# +# Arguments: +# token The MIME token to parse. +# key Either a key or '-names'. If it is '-names' a list +# of all keys is returned. +# +# Results: +# Returns the header of a MIME part. + +proc ::mime::getheader {token {key {}}} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + array set header $state(header) + switch -- $key { + {} { + set result {} + lappend result MIME-Version $state(version) + foreach lower $state(lowerL) mixed $state(mixedL) { + foreach value $header($lower) { + lappend result $mixed $value + } + } + set tencoding [getTransferEncoding $token] + if {$tencoding ne {}} { + lappend result Content-Transfer-Encoding $tencoding + } + lappend result Content-Type [getContentType $token] + return $result + } + + -names { + return $state(mixedL) + } + + default { + set lower [string tolower $key] + + switch $lower { + content-transfer-encoding { + return [getTransferEncoding $token] + } + content-type { + return [list [getContentType $token]] + } + mime-version { + return [list $state(version)] + } + default { + if {![info exists header($lower)]} { + error "key $key not in header" + } + return $header($lower) + } + } + } + } +} + + +proc ::mime::getTransferEncoding token { + variable $token + upvar 0 $token state + set res {} + if {[set encoding $state(encoding)] eq {}} { + set encoding [encoding $token] + } + if {$encoding ne {}} { + set res $encoding + } + switch -- $encoding { + base64 + - + quoted-printable { + set converter $encoding + } + 7bit - 8bit - binary - {} { + # Bugfix for [#477088], also [#539952] + # Go ahead + } + default { + error "Can't handle content encoding \"$encoding\"" + } + } + return $res +} + +# ::mime::setheader -- +# +# mime::setheader writes, appends to, or deletes the value associated +# with a key in the header. +# +# The value for -mode is one of: +# +# write: the key/value is either created or overwritten (the +# default); +# +# append: a new value is appended for the key (creating it as +# necessary); or, +# +# delete: all values associated with the key are removed (the +# "value" parameter is ignored). +# +# Regardless, mime::setheader returns the previous value associated +# with the key. +# +# Arguments: +# token The MIME token to parse. +# key The name of the key whose value should be set. +# value The value for the header key to be set to. +# args An optional argument of the form: +# ?-mode "write" | "append" | "delete"? +# +# Results: +# Returns previous value associated with the specified key. + +proc ::mime::setheader {token key value args} { + # FRINK: nocheck + variable internal + variable $token + upvar 0 $token state + + array set options [list -mode write] + array set options $args + + set lower [string tolower $key] + array set header $state(header) + if {[set x [lsearch -exact $state(lowerL) $lower]] < 0} { + #TODO: this code path is not tested + if {$options(-mode) eq {delete}} { + error "key $key not in header" + } + + lappend state(lowerL) $lower + lappend state(mixedL) $key + + set result {} + } else { + set result $header($lower) + } + switch -- $options(-mode) { + append - write { + if {!$internal} { + switch -- $lower { + content-md5 + - + content-type + - + content-transfer-encoding + - + mime-version { + set values [getheader $token $lower] + if {$value ni $values} { + error "key $key may not be set" + } + } + default {# Skip key} + } + } + switch -- $options(-mode) { + append { + lappend header($lower) $value + } + write { + set header($lower) [list $value] + } + } + } + delete { + unset header($lower) + set state(lowerL) [lreplace $state(lowerL) $x $x] + set state(mixedL) [lreplace $state(mixedL) $x $x] + } + + default { + error "unknown value for -mode $options(-mode)" + } + } + + set state(header) [array get header] + return $result +} + +# ::mime::getbody -- +# +# mime::getbody returns the body of a leaf MIME part in canonical form. +# +# If the -command option is present, then it is repeatedly invoked +# with a fragment of the body as this: +# +# uplevel #0 $callback [list "data" $fragment] +# +# (The -blocksize option, if present, specifies the maximum size of +# each fragment passed to the callback.) +# When the end of the body is reached, the callback is invoked as: +# +# uplevel #0 $callback "end" +# +# Alternatively, if an error occurs, the callback is invoked as: +# +# uplevel #0 $callback [list "error" reason] +# +# Regardless, the return value of the final invocation of the callback +# is propagated upwards by mime::getbody. +# +# If the -command option is absent, then the return value of +# mime::getbody is a string containing the MIME part's entire body. +# +# Arguments: +# token The MIME token to parse. +# args Optional arguments of the form: +# ?-decode? ?-command callback ?-blocksize octets? ? +# +# Results: +# Returns a string containing the MIME part's entire body, or +# if '-command' is specified, the return value of the command +# is returned. + +proc ::mime::getbody {token args} { + global errorCode errorInfo + # FRINK: nocheck + variable $token + upvar 0 $token state + + set decode 0 + if {[set pos [lsearch -exact $args -decode]] >= 0} { + set decode 1 + set args [lreplace $args $pos $pos] + } + + array set options [list -command [ + list mime::getbodyaux $token] -blocksize 4096] + array set options $args + if {$options(-blocksize) < 1} { + error "-blocksize expects a positive integer, not $options(-blocksize)" + } + + set code 0 + set ecode {} + set einfo {} + + switch -- $state(value)/$state(canonicalP) { + file/0 { + set fd [open $state(file) RDONLY] + + set code [catch { + fconfigure $fd -translation binary + seek $fd [set pos $state(offset)] start + set last [expr {$state(offset) + $state(count) - 1}] + + set fragment {} + while {$pos <= $last} { + if {[set cc [ + expr {($last - $pos) + 1}]] > $options(-blocksize)} { + set cc $options(-blocksize) + } + incr pos [set len [ + string length [set chunk [read $fd $cc]]]] + switch -exact -- $state(encoding) { + base64 + - + quoted-printable { + if {([set x [string last \n $chunk]] > 0) \ + && ($x + 1 != $len)} { + set chunk [string range $chunk 0 $x] + seek $fd [incr pos [expr {($x + 1) - $len}]] start + } + set chunk [ + $state(encoding) -mode decode -- $chunk] + } + 7bit - 8bit - binary - {} { + # Bugfix for [#477088] + # Go ahead, leave chunk alone + } + default { + error "Can't handle content encoding \"$state(encoding)\"" + } + } + append fragment $chunk + + set cc [expr {$options(-blocksize) - 1}] + while {[string length $fragment] > $options(-blocksize)} { + uplevel #0 $options(-command) [ + list data [string range $fragment 0 $cc]] + + set fragment [ + string range $fragment $options(-blocksize) end] + } + } + if {[string length $fragment] > 0} { + uplevel #0 $options(-command) [list data $fragment] + } + } result] + set ecode $errorCode + set einfo $errorInfo + + catch {close $fd} + } + + file/1 { + set fd [open $state(file) RDONLY] + + set code [catch { + fconfigure $fd -translation binary + + while {[string length [ + set fragment [read $fd $options(-blocksize)]]] > 0} { + uplevel #0 $options(-command) [list data $fragment] + } + } result] + set ecode $errorCode + set einfo $errorInfo + + catch {close $fd} + } + + parts/0 + - + parts/1 { + error {MIME part isn't a leaf} + } + + string/0 + - + string/1 { + switch -- $state(encoding)/$state(canonicalP) { + base64/0 + - + quoted-printable/0 { + set fragment [ + $state(encoding) -mode decode -- $state(string)] + } + + default { + # Not a bugfix for [#477088], but clarification + # This handles no-encoding, 7bit, 8bit, and binary. + set fragment $state(string) + } + } + + set code [catch { + set cc [expr {$options(-blocksize) -1}] + while {[string length $fragment] > $options(-blocksize)} { + uplevel #0 $options(-command) [ + list data [string range $fragment 0 $cc]] + + set fragment [ + string range $fragment $options(-blocksize) end] + } + if {[string length $fragment] > 0} { + uplevel #0 $options(-command) [list data $fragment] + } + } result] + set ecode $errorCode + set einfo $errorInfo + } + default { + error "Unknown combination \"$state(value)/$state(canonicalP)\"" + } + } + + set code [catch { + if {$code} { + uplevel #0 $options(-command) [list error $result] + } else { + uplevel #0 $options(-command) [list end] + } + } result] + set ecode $errorCode + set einfo $errorInfo + + if {$code} { + return -code $code -errorinfo $einfo -errorcode $ecode $result + } + + if {$decode} { + array set params [mime::getproperty $token params] + + if {[info exists params(charset)]} { + set charset $params(charset) + } else { + set charset US-ASCII + } + + set enc [reversemapencoding $charset] + if {$enc ne {}} { + set result [::encoding convertfrom $enc $result] + } else { + return -code error "-decode failed: can't reversemap charset $charset" + } + } + + return $result +} + +# ::mime::getbodyaux -- +# +# Builds up the body of the message, fragment by fragment. When +# the entire message has been retrieved, it is returned. +# +# Arguments: +# token The MIME token to parse. +# reason One of 'data', 'end', or 'error'. +# fragment The section of data data fragment to extract a +# string from. +# +# Results: +# Returns nothing, except when called with the 'end' argument +# in which case it returns a string that contains all of the +# data that 'getbodyaux' has been called with. Will throw an +# error if it is called with the reason of 'error'. + +proc ::mime::getbodyaux {token reason {fragment {}}} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + switch $reason { + data { + append state(getbody) $fragment + return {} + } + + end { + if {[info exists state(getbody)]} { + set result $state(getbody) + unset state(getbody) + } else { + set result {} + } + + return $result + } + + error { + catch {unset state(getbody)} + error $reason + } + + default { + error "Unknown reason \"$reason\"" + } + } +} + +# ::mime::copymessage -- +# +# mime::copymessage copies the MIME part to the specified channel. +# +# mime::copymessage operates synchronously, and uses fileevent to +# allow asynchronous operations to proceed independently. +# +# Arguments: +# token The MIME token to parse. +# channel The channel to copy the message to. +# +# Results: +# Returns nothing unless an error is thrown while the message +# is being written to the channel. + +proc ::mime::copymessage {token channel} { + global errorCode errorInfo + # FRINK: nocheck + variable $token + upvar 0 $token state + + set openP [info exists state(fd)] + + set code [catch {mime::copymessageaux $token $channel} result] + set ecode $errorCode + set einfo $errorInfo + + if {!$openP && [info exists state(fd)]} { + if {![info exists state(root)]} { + catch {close $state(fd)} + } + unset state(fd) + } + + return -code $code -errorinfo $einfo -errorcode $ecode $result +} + +# ::mime::copymessageaux -- +# +# mime::copymessageaux copies the MIME part to the specified channel. +# +# Arguments: +# token The MIME token to parse. +# channel The channel to copy the message to. +# +# Results: +# Returns nothing unless an error is thrown while the message +# is being written to the channel. + +proc ::mime::copymessageaux {token channel} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + array set header $state(header) + + set boundary {} + + set result {} + foreach {mixed value} [getheader $token] { + puts $channel "$mixed: $value" + } + + foreach {k v} $state(params) { + if {$k eq {boundary}} { + set boundary $v + } + } + + set converter {} + set encoding {} + if {$state(value) ne {parts}} { + if {$state(canonicalP)} { + if {[set encoding $state(encoding)] eq {}} { + set encoding [encoding $token] + } + if {$encoding ne {}} { + puts $channel "Content-Transfer-Encoding: $encoding" + } + switch -- $encoding { + base64 + - + quoted-printable { + set converter $encoding + } + 7bit - 8bit - binary - {} { + # Bugfix for [#477088], also [#539952] + # Go ahead + } + default { + error "Can't handle content encoding \"$encoding\"" + } + } + } + } elseif {([string match multipart/* $state(content)]) \ + && ($boundary eq {})} { + # we're doing everything in one pass... + set key [clock seconds]$token[info hostname][array get state] + set seqno 8 + while {[incr seqno -1] >= 0} { + set key [md5 -- $key] + } + set boundary "----- =_[string trim [base64 -mode encode -- $key]]" + + puts $channel ";\n boundary=\"$boundary\"" + } + + if {[info exists state(error)]} { + unset state(error) + } + + switch -- $state(value) { + file { + set closeP 1 + if {[info exists state(root)]} { + # FRINK: nocheck + variable $state(root) + upvar 0 $state(root) root + + if {[info exists root(fd)]} { + set fd $root(fd) + set closeP 0 + } else { + set fd [set state(fd) [open $state(file) RDONLY]] + } + set size $state(count) + } else { + set fd [set state(fd) [open $state(file) RDONLY]] + # read until eof + set size -1 + } + seek $fd $state(offset) start + if {$closeP} { + fconfigure $fd -translation binary + } + + puts $channel {} + + while {$size != 0 && ![eof $fd]} { + if {$size < 0 || $size > 32766} { + set X [read $fd 32766] + } else { + set X [read $fd $size] + } + if {$size > 0} { + set size [expr {$size - [string length $X]}] + } + if {$converter eq {}} { + puts -nonewline $channel $X + } else { + puts -nonewline $channel [$converter -mode encode -- $X] + } + } + + if {$closeP} { + catch {close $state(fd)} + unset state(fd) + } + } + + parts { + if { + ![info exists state(root)] + && + [info exists state(file)] + } { + set state(fd) [open $state(file) RDONLY] + fconfigure $state(fd) -translation binary + } + + switch -glob -- $state(content) { + message/* { + puts $channel {} + foreach part $state(parts) { + mime::copymessage $part $channel + break + } + } + + default { + # Note RFC 2046: See buildmessageaux for details. + # + # The boundary delimiter MUST occur at the + # beginning of a line, i.e., following a CRLF, and + # the initial CRLF is considered to be attached to + # the boundary delimiter line rather than part of + # the preceding part. + # + # - The above means that the CRLF before $boundary + # is needed per the RFC, and the parts must not + # have a closing CRLF of their own. See Tcllib bug + # 1213527, and patch 1254934 for the problems when + # both file/string branches added CRLF after the + # body parts. + + + foreach part $state(parts) { + puts $channel \n--$boundary + mime::copymessage $part $channel + } + puts $channel \n--$boundary-- + } + } + + if {[info exists state(fd)]} { + catch {close $state(fd)} + unset state(fd) + } + } + + string { + if {[catch {fconfigure $channel -buffersize} blocksize]} { + set blocksize 4096 + } elseif {$blocksize < 512} { + set blocksize 512 + } + set blocksize [expr {($blocksize / 4) * 3}] + + # [893516] + fconfigure $channel -buffersize $blocksize + + puts $channel {} + + #TODO: tests don't cover these paths + if {$converter eq {}} { + puts -nonewline $channel $state(string) + } else { + puts -nonewline $channel [$converter -mode encode -- $state(string)] + } + } + default { + error "Unknown value \"$state(value)\"" + } + } + + flush $channel + + if {[info exists state(error)]} { + error $state(error) + } +} + +# ::mime::buildmessage -- +# +# Like copymessage, but produces a string rather than writing the message into a channel. +# +# Arguments: +# token The MIME token to parse. +# +# Results: +# The message. + +proc ::mime::buildmessage token { + global errorCode errorInfo + # FRINK: nocheck + variable $token + upvar 0 $token state + + set openP [info exists state(fd)] + + set code [catch {mime::buildmessageaux $token} result] + if {![info exists errorCode]} { + set ecode {} + } else { + set ecode $errorCode + } + set einfo $errorInfo + + if {!$openP && [info exists state(fd)]} { + if {![info exists state(root)]} { + catch {close $state(fd)} + } + unset state(fd) + } + + return -code $code -errorinfo $einfo -errorcode $ecode $result +} + + +proc ::mime::buildmessageaux token { + set chan [tcl::chan::memchan] + chan configure $chan -translation crlf + copymessageaux $token $chan + seek $chan 0 + chan configure $chan -translation binary + set res [read $chan] + close $chan + return $res +} + +# ::mime::encoding -- +# +# Determines how a token is encoded. +# +# Arguments: +# token The MIME token to parse. +# +# Results: +# Returns the encoding of the message (the null string, base64, +# or quoted-printable). + +proc ::mime::encoding {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + switch -glob -- $state(content) { + audio/* + - + image/* + - + video/* { + return base64 + } + + message/* + - + multipart/* { + return {} + } + default {# Skip} + } + + set asciiP 1 + set lineP 1 + switch -- $state(value) { + file { + set fd [open $state(file) RDONLY] + fconfigure $fd -translation binary + + while {[gets $fd line] >= 0} { + if {$asciiP} { + set asciiP [encodingasciiP $line] + } + if {$lineP} { + set lineP [encodinglineP $line] + } + if {(!$asciiP) && (!$lineP)} { + break + } + } + + catch {close $fd} + } + + parts { + return {} + } + + string { + foreach line [split $state(string) "\n"] { + if {$asciiP} { + set asciiP [encodingasciiP $line] + } + if {$lineP} { + set lineP [encodinglineP $line] + } + if {(!$asciiP) && (!$lineP)} { + break + } + } + } + default { + error "Unknown value \"$state(value)\"" + } + } + + switch -glob -- $state(content) { + text/* { + if {!$asciiP} { + #TODO: this path is not covered by tests + foreach {k v} $state(params) { + if {$k eq "charset"} { + set v [string tolower $v] + if {($v ne "us-ascii") \ + && (![string match {iso-8859-[1-8]} $v])} { + return base64 + } + + break + } + } + } + + if {!$lineP} { + return quoted-printable + } + } + + + default { + if {(!$asciiP) || (!$lineP)} { + return base64 + } + } + } + + return {} +} + +# ::mime::encodingasciiP -- +# +# Checks if a string is a pure ascii string, or if it has a non-standard +# form. +# +# Arguments: +# line The line to check. +# +# Results: +# Returns 1 if \r only occurs at the end of lines, and if all +# characters in the line are between the ASCII codes of 32 and 126. + +proc ::mime::encodingasciiP {line} { + foreach c [split $line {}] { + switch -- $c { + { } - \t - \r - \n { + } + + default { + binary scan $c c c + if {($c < 32) || ($c > 126)} { + return 0 + } + } + } + } + if { + [set r [string first \r $line]] < 0 + || + $r == {[string length $line] - 1} + } { + return 1 + } + + return 0 +} + +# ::mime::encodinglineP -- +# +# Checks if a string is a line is valid to be processed. +# +# Arguments: +# line The line to check. +# +# Results: +# Returns 1 the line is less than 76 characters long, the line +# contains more characters than just whitespace, the line does +# not start with a '.', and the line does not start with 'From '. + +proc ::mime::encodinglineP {line} { + if {([string length $line] > 76) \ + || ($line ne [string trimright $line]) \ + || ([string first . $line] == 0) \ + || ([string first {From } $line] == 0)} { + return 0 + } + + return 1 +} + +# ::mime::fcopy -- +# +# Appears to be unused. +# +# Arguments: +# +# Results: +# + +proc ::mime::fcopy {token count {error {}}} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + if {$error ne {}} { + set state(error) $error + } + set state(doneP) 1 +} + +# ::mime::scopy -- +# +# Copy a portion of the contents of a mime token to a channel. +# +# Arguments: +# token The token containing the data to copy. +# channel The channel to write the data to. +# offset The location in the string to start copying +# from. +# len The amount of data to write. +# blocksize The block size for the write operation. +# +# Results: +# The specified portion of the string in the mime token is +# copied to the specified channel. + +proc ::mime::scopy {token channel offset len blocksize} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + if {$len <= 0} { + set state(doneP) 1 + fileevent $channel writable {} + return + } + + if {[set cc $len] > $blocksize} { + set cc $blocksize + } + + if {[catch { + puts -nonewline $channel [ + string range $state(string) $offset [expr {$offset + $cc - 1}]] + fileevent $channel writable [ + list mime::scopy $token $channel [ + incr offset $cc] [incr len -$cc] $blocksize] + } result] + } { + set state(error) $result + set state(doneP) 1 + fileevent $channel writable {} + } + return +} + +# ::mime::qp_encode -- +# +# Tcl version of quote-printable encode +# +# Arguments: +# string The string to quote. +# encoded_word Boolean value to determine whether or not encoded words +# (RFC 2047) should be handled or not. (optional) +# +# Results: +# The properly quoted string is returned. + +proc ::mime::qp_encode {string {encoded_word 0} {no_softbreak 0}} { + # 8.1+ improved string manipulation routines used. + # Replace outlying characters, characters that would normally + # be munged by EBCDIC gateways, and special Tcl characters "[\]{} + # with =xx sequence + + if {$encoded_word} { + # Special processing for encoded words (RFC 2047) + set regexp {[\x00-\x08\x0B-\x1E\x21-\x24\x3D\x40\x5B-\x5E\x60\x7B-\xFF\x09\x5F\x3F]} + lappend mapChars { } _ + } else { + set regexp {[\x00-\x08\x0B-\x1E\x21-\x24\x3D\x40\x5B-\x5E\x60\x7B-\xFF]} + } + regsub -all -- $regexp $string {[format =%02X [scan "\\&" %c]]} string + + # Replace the format commands with their result + + set string [subst -novariables $string] + + # soft/hard newlines and other + # Funky cases for SMTP compatibility + lappend mapChars " \n" =20\n \t\n =09\n \n\.\n =2E\n "\nFrom " "\n=46rom " + + set string [string map $mapChars $string] + + # Break long lines - ugh + + # Implementation of FR #503336 + if {$no_softbreak} { + set result $string + } else { + set result {} + foreach line [split $string \n] { + while {[string length $line] > 72} { + set chunk [string range $line 0 72] + if {[regexp -- (=|=.)$ $chunk dummy end]} { + + # Don't break in the middle of a code + + set len [expr {72 - [string length $end]}] + set chunk [string range $line 0 $len] + incr len + set line [string range $line $len end] + } else { + set line [string range $line 73 end] + } + append result $chunk=\n + } + append result $line\n + } + + # Trim off last \n, since the above code has the side-effect + # of adding an extra \n to the encoded string and return the + # result. + set result [string range $result 0 end-1] + } + + # If the string ends in space or tab, replace with =xx + + set lastChar [string index $result end] + if {$lastChar eq { }} { + set result [string replace $result end end =20] + } elseif {$lastChar eq "\t"} { + set result [string replace $result end end =09] + } + + return $result +} + +# ::mime::qp_decode -- +# +# Tcl version of quote-printable decode +# +# Arguments: +# string The quoted-printable string to decode. +# encoded_word Boolean value to determine whether or not encoded words +# (RFC 2047) should be handled or not. (optional) +# +# Results: +# The decoded string is returned. + +proc ::mime::qp_decode {string {encoded_word 0}} { + # 8.1+ improved string manipulation routines used. + # Special processing for encoded words (RFC 2047) + + if {$encoded_word} { + # _ == \x20, even if SPACE occupies a different code position + set string [string map [list _ \u0020] $string] + } + + # smash the white-space at the ends of lines since that must've been + # generated by an MUA. + + regsub -all -- {[ \t]+\n} $string \n string + set string [string trimright $string " \t"] + + # Protect the backslash for later subst and + # smash soft newlines, has to occur after white-space smash + # and any encoded word modification. + + #TODO: codepath not tested + set string [string map [list \\ {\\} =\n {}] $string] + + # Decode specials + + regsub -all -nocase {=([a-f0-9][a-f0-9])} $string {\\u00\1} string + + # process \u unicode mapped chars + + return [subst -novariables -nocommands $string] +} + +# ::mime::parseaddress -- +# +# This was originally written circa 1982 in C. we're still using it +# because it recognizes virtually every buggy address syntax ever +# generated! +# +# mime::parseaddress takes a string containing one or more 822-style +# address specifications and returns a list of dictionaries, for each +# address specified in the argument. +# +# Each dictionary contains these properties: +# +# property value +# ======== ===== +# address local@domain +# comment 822-style comment +# domain the domain part (rhs) +# error non-empty on a parse error +# group this address begins a group +# friendly user-friendly rendering +# local the local part (lhs) +# memberP this address belongs to a group +# phrase the phrase part +# proper 822-style address specification +# route 822-style route specification (obsolete) +# +# Note that one or more of these properties may be empty. +# +# Arguments: +# string The address string to parse +# +# Results: +# Returns a list of dictionaries, one element for each address +# specified in the argument. + +proc ::mime::parseaddress {string} { + global errorCode errorInfo + + variable mime + + set token [namespace current]::[incr mime(uid)] + # FRINK: nocheck + variable $token + upvar 0 $token state + + set code [catch {mime::parseaddressaux $token $string} result] + set ecode $errorCode + set einfo $errorInfo + + foreach name [array names state] { + unset state($name) + } + # FRINK: nocheck + catch {unset $token} + + return -code $code -errorinfo $einfo -errorcode $ecode $result +} + +# ::mime::parseaddressaux -- +# +# This was originally written circa 1982 in C. we're still using it +# because it recognizes virtually every buggy address syntax ever +# generated! +# +# mime::parseaddressaux does the actually parsing for mime::parseaddress +# +# Each dictionary contains these properties: +# +# property value +# ======== ===== +# address local@domain +# comment 822-style comment +# domain the domain part (rhs) +# error non-empty on a parse error +# group this address begins a group +# friendly user-friendly rendering +# local the local part (lhs) +# memberP this address belongs to a group +# phrase the phrase part +# proper 822-style address specification +# route 822-style route specification (obsolete) +# +# Note that one or more of these properties may be empty. +# +# Arguments: +# token The MIME token to work from. +# string The address string to parse +# +# Results: +# Returns a list of dictionaries, one for each address specified in the +# argument. + +proc ::mime::parseaddressaux {token string} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + variable addrtokenL + variable addrlexemeL + + set state(input) $string + set state(glevel) 0 + set state(buffer) {} + set state(lastC) LX_END + set state(tokenL) $addrtokenL + set state(lexemeL) $addrlexemeL + + set result {} + while {[addr_next $token]} { + if {[set tail $state(domain)] ne {}} { + set tail @$state(domain) + } else { + set tail @[info hostname] + } + if {[set address $state(local)] ne {}} { + #TODO: this path is not covered by tests + append address $tail + } + + if {$state(phrase) ne {}} { + #TODO: this path is not covered by tests + set state(phrase) [string trim $state(phrase) \"] + foreach t $state(tokenL) { + if {[string first $t $state(phrase)] >= 0} { + #TODO: is this quoting robust enough? + set state(phrase) \"$state(phrase)\" + break + } + } + + set proper "$state(phrase) <$address>" + } else { + set proper $address + } + + if {[set friendly $state(phrase)] eq {}} { + #TODO: this path is not covered by tests + if {[set note $state(comment)] ne {}} { + if {[string first ( $note] == 0} { + set note [string trimleft [string range $note 1 end]] + } + if { + [string last ) $note] + == [set len [expr {[string length $note] - 1}]] + } { + set note [string range $note 0 [expr {$len - 1}]] + } + set friendly $note + } + + if { + $friendly eq {} + && + [set mbox $state(local)] ne {} + } { + #TODO: this path is not covered by tests + set mbox [string trim $mbox \"] + + if {[string first / $mbox] != 0} { + set friendly $mbox + } elseif {[set friendly [addr_x400 $mbox PN]] ne {}} { + } elseif { + [set friendly [addr_x400 $mbox S]] ne {} + && + [set g [addr_x400 $mbox G]] ne {} + } { + set friendly "$g $friendly" + } + + if {$friendly eq {}} { + set friendly $mbox + } + } + } + set friendly [string trim $friendly \"] + + lappend result [list address $address \ + comment $state(comment) \ + domain $state(domain) \ + error $state(error) \ + friendly $friendly \ + group $state(group) \ + local $state(local) \ + memberP $state(memberP) \ + phrase $state(phrase) \ + proper $proper \ + route $state(route)] + + } + + unset {*}{ + state(input) + state(glevel) + state(buffer) + state(lastC) + state(tokenL) + state(lexemeL) + } + + return $result +} + +# ::mime::addr_next -- +# +# Locate the next address in a mime token. +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns 1 if there is another address, and 0 if there is not. + +proc ::mime::addr_next {token} { + global errorCode errorInfo + # FRINK: nocheck + variable $token + upvar 0 $token state + set nocomplain [package vsatisfies [package provide Tcl] 8.4] + foreach prop {comment domain error group local memberP phrase route} { + if {$nocomplain} { + unset -nocomplain state($prop) + } else { + if {[catch {unset state($prop)}]} {set ::errorInfo {}} + } + } + + switch -- [set code [catch {mime::addr_specification $token} result]] { + 0 { + if {!$result} { + return 0 + } + + switch -- $state(lastC) { + LX_COMMA + - + LX_END { + } + default { + # catch trailing comments... + set lookahead $state(input) + mime::parselexeme $token + set state(input) $lookahead + } + } + } + + 7 { + set state(error) $result + + while {1} { + switch -- $state(lastC) { + LX_COMMA + - + LX_END { + break + } + + default { + mime::parselexeme $token + } + } + } + } + + default { + set ecode $errorCode + set einfo $errorInfo + + return -code $code -errorinfo $einfo -errorcode $ecode $result + } + } + + foreach prop {comment domain error group local memberP phrase route} { + if {![info exists state($prop)]} { + set state($prop) {} + } + } + + return 1 +} + +# ::mime::addr_specification -- +# +# Uses lookahead parsing to determine whether there is another +# valid e-mail address or not. Throws errors if unrecognized +# or invalid e-mail address syntax is used. +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns 1 if there is another address, and 0 if there is not. + +proc ::mime::addr_specification {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + set lookahead $state(input) + switch -- [parselexeme $token] { + LX_ATOM + - + LX_QSTRING { + set state(phrase) $state(buffer) + } + + LX_SEMICOLON { + if {[incr state(glevel) -1] < 0} { + return -code 7 "extraneous semi-colon" + } + + catch {unset state(comment)} + return [addr_specification $token] + } + + LX_COMMA { + catch {unset state(comment)} + return [addr_specification $token] + } + + LX_END { + return 0 + } + + LX_LBRACKET { + return [addr_routeaddr $token] + } + + LX_ATSIGN { + set state(input) $lookahead + return [addr_routeaddr $token 0] + } + + default { + return -code 7 [ + format "unexpected character at beginning (found %s)" \ + $state(buffer)] + } + } + + switch -- [parselexeme $token] { + LX_ATOM + - + LX_QSTRING { + append state(phrase) " " $state(buffer) + + return [addr_phrase $token] + } + + LX_LBRACKET { + return [addr_routeaddr $token] + } + + LX_COLON { + return [addr_group $token] + } + + LX_DOT { + set state(local) "$state(phrase)$state(buffer)" + unset state(phrase) + mime::addr_routeaddr $token 0 + mime::addr_end $token + } + + LX_ATSIGN { + set state(memberP) $state(glevel) + set state(local) $state(phrase) + unset state(phrase) + mime::addr_domain $token + mime::addr_end $token + } + + LX_SEMICOLON + - + LX_COMMA + - + LX_END { + set state(memberP) $state(glevel) + if { + $state(lastC) eq "LX_SEMICOLON" + && + ([incr state(glevel) -1] < 0) + } { + #TODO: this path is not covered by tests + return -code 7 "extraneous semi-colon" + } + + set state(local) $state(phrase) + unset state(phrase) + } + + default { + return -code 7 [ + format "expecting mailbox (found %s)" $state(buffer)] + } + } + + return 1 +} + +# ::mime::addr_routeaddr -- +# +# Parses the domain portion of an e-mail address. Finds the '@' +# sign and then calls mime::addr_route to verify the domain. +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns 1 if there is another address, and 0 if there is not. + +proc ::mime::addr_routeaddr {token {checkP 1}} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + set lookahead $state(input) + if {[parselexeme $token] eq "LX_ATSIGN"} { + #TODO: this path is not covered by tests + mime::addr_route $token + } else { + set state(input) $lookahead + } + + mime::addr_local $token + + switch -- $state(lastC) { + LX_ATSIGN { + mime::addr_domain $token + } + + LX_SEMICOLON + - + LX_RBRACKET + - + LX_COMMA + - + LX_END { + } + + default { + return -code 7 [ + format "expecting at-sign after local-part (found %s)" \ + $state(buffer)] + } + } + + if {($checkP) && ($state(lastC) ne "LX_RBRACKET")} { + return -code 7 [ + format "expecting right-bracket (found %s)" $state(buffer)] + } + + return 1 +} + +# ::mime::addr_route -- +# +# Attempts to parse the portion of the e-mail address after the @. +# Tries to verify that the domain definition has a valid form. +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns nothing if successful, and throws an error if invalid +# syntax is found. + +proc ::mime::addr_route {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + set state(route) @ + + while 1 { + switch -- [parselexeme $token] { + LX_ATOM + - + LX_DLITERAL { + append state(route) $state(buffer) + } + + default { + return -code 7 \ + [format "expecting sub-route in route-part (found %s)" \ + $state(buffer)] + } + } + + switch -- [parselexeme $token] { + LX_COMMA { + append state(route) $state(buffer) + while 1 { + switch -- [parselexeme $token] { + LX_COMMA { + } + + LX_ATSIGN { + append state(route) $state(buffer) + break + } + + default { + return -code 7 \ + [format "expecting at-sign in route (found %s)" \ + $state(buffer)] + } + } + } + } + + LX_ATSIGN + - + LX_DOT { + append state(route) $state(buffer) + } + + LX_COLON { + append state(route) $state(buffer) + return + } + + default { + return -code 7 [ + format "expecting colon to terminate route (found %s)" \ + $state(buffer)] + } + } + } +} + +# ::mime::addr_domain -- +# +# Attempts to parse the portion of the e-mail address after the @. +# Tries to verify that the domain definition has a valid form. +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns nothing if successful, and throws an error if invalid +# syntax is found. + +proc ::mime::addr_domain {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + while 1 { + switch -- [parselexeme $token] { + LX_ATOM + - + LX_DLITERAL { + append state(domain) $state(buffer) + } + + default { + return -code 7 [ + format "expecting sub-domain in domain-part (found %s)" \ + $state(buffer)] + } + } + + switch -- [parselexeme $token] { + LX_DOT { + append state(domain) $state(buffer) + } + + LX_ATSIGN { + append state(local) % $state(domain) + unset state(domain) + } + + default { + return + } + } + } +} + +# ::mime::addr_local -- +# +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns nothing if successful, and throws an error if invalid +# syntax is found. + +proc ::mime::addr_local {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + set state(memberP) $state(glevel) + + while 1 { + switch -- [parselexeme $token] { + LX_ATOM + - + LX_QSTRING { + append state(local) $state(buffer) + } + + default { + return -code 7 \ + [format "expecting mailbox in local-part (found %s)" \ + $state(buffer)] + } + } + + switch -- [parselexeme $token] { + LX_DOT { + append state(local) $state(buffer) + } + + default { + return + } + } + } +} + +# ::mime::addr_phrase -- +# +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns nothing if successful, and throws an error if invalid +# syntax is found. + + +proc ::mime::addr_phrase {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + while {1} { + switch -- [parselexeme $token] { + LX_ATOM + - + LX_QSTRING { + append state(phrase) " " $state(buffer) + } + + default { + break + } + } + } + + switch -- $state(lastC) { + LX_LBRACKET { + return [addr_routeaddr $token] + } + + LX_COLON { + return [addr_group $token] + } + + LX_DOT { + append state(phrase) $state(buffer) + return [addr_phrase $token] + } + + default { + return -code 7 [ + format "found phrase instead of mailbox (%s%s)" \ + $state(phrase) $state(buffer)] + } + } +} + +# ::mime::addr_group -- +# +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns nothing if successful, and throws an error if invalid +# syntax is found. + +proc ::mime::addr_group {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + if {[incr state(glevel)] > 1} { + return -code 7 [ + format "nested groups not allowed (found %s)" $state(phrase)] + } + + set state(group) $state(phrase) + unset state(phrase) + + set lookahead $state(input) + while 1 { + switch -- [parselexeme $token] { + LX_SEMICOLON + - + LX_END { + set state(glevel) 0 + return 1 + } + + LX_COMMA { + } + + default { + set state(input) $lookahead + return [addr_specification $token] + } + } + } +} + +# ::mime::addr_end -- +# +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns nothing if successful, and throws an error if invalid +# syntax is found. + +proc ::mime::addr_end {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + switch -- $state(lastC) { + LX_SEMICOLON { + if {[incr state(glevel) -1] < 0} { + return -code 7 "extraneous semi-colon" + } + } + + LX_COMMA + - + LX_END { + } + + default { + return -code 7 [ + format "junk after local@domain (found %s)" $state(buffer)] + } + } +} + +# ::mime::addr_x400 -- +# +# +# Arguments: +# token The MIME token to work from. +# +# Results: +# Returns nothing if successful, and throws an error if invalid +# syntax is found. + +proc ::mime::addr_x400 {mbox key} { + if {[set x [string first /$key= [string toupper $mbox]]] < 0} { + return {} + } + set mbox [string range $mbox [expr {$x + [string length $key] + 2}] end] + + if {[set x [string first / $mbox]] > 0} { + set mbox [string range $mbox 0 [expr {$x - 1}]] + } + + return [string trim $mbox \"] +} + +# ::mime::parsedatetime -- +# +# Fortunately the clock command in the Tcl 8.x core does all the heavy +# lifting for us (except for timezone calculations). +# +# mime::parsedatetime takes a string containing an 822-style date-time +# specification and returns the specified property. +# +# The list of properties and their ranges are: +# +# property range +# ======== ===== +# clock raw result of "clock scan" +# hour 0 .. 23 +# lmonth January, February, ..., December +# lweekday Sunday, Monday, ... Saturday +# mday 1 .. 31 +# min 0 .. 59 +# mon 1 .. 12 +# month Jan, Feb, ..., Dec +# proper 822-style date-time specification +# rclock elapsed seconds between then and now +# sec 0 .. 59 +# wday 0 .. 6 (Sun .. Mon) +# weekday Sun, Mon, ..., Sat +# yday 1 .. 366 +# year 1900 ... +# zone -720 .. 720 (minutes east of GMT) +# +# Arguments: +# value Either a 822-style date-time specification or '-now' +# if the current date/time should be used. +# property The property (from the list above) to return +# +# Results: +# Returns the string value of the 'property' for the date/time that was +# specified in 'value'. + +namespace eval ::mime { + variable WDAYS_SHORT [list Sun Mon Tue Wed Thu Fri Sat] + variable WDAYS_LONG [list Sunday Monday Tuesday Wednesday Thursday \ + Friday Saturday] + + # Counting months starts at 1, so just insert a dummy element + # at index 0. + variable MONTHS_SHORT [list {} \ + Jan Feb Mar Apr May Jun \ + Jul Aug Sep Oct Nov Dec] + variable MONTHS_LONG [list {} \ + January February March April May June July \ + August Sepember October November December] +} +proc ::mime::parsedatetime {value property} { + if {$value eq "-now"} { + set clock [clock seconds] + } elseif {[regexp {^(.*) ([+-])([0-9][0-9])([0-9][0-9])$} $value \ + -> value zone_sign zone_hour zone_min] + } { + set clock [clock scan $value -gmt 1] + if {[info exists zone_min]} { + set zone_min [scan $zone_min %d] + set zone_hour [scan $zone_hour %d] + set zone [expr {60 * ($zone_min + 60 * $zone_hour)}] + if {$zone_sign eq "+"} { + set zone -$zone + } + incr clock $zone + } + } else { + set clock [clock scan $value] + } + + switch -- $property { + clock { + return $clock + } + + hour { + set value [clock format $clock -format %H] + } + + lmonth { + variable MONTHS_LONG + return [lindex $MONTHS_LONG \ + [scan [clock format $clock -format %m] %d]] + } + + lweekday { + variable WDAYS_LONG + return [lindex $WDAYS_LONG [clock format $clock -format %w]] + } + + mday { + set value [clock format $clock -format %d] + } + + min { + set value [clock format $clock -format %M] + } + + mon { + set value [clock format $clock -format %m] + } + + month { + variable MONTHS_SHORT + return [lindex $MONTHS_SHORT [ + scan [clock format $clock -format %m] %d]] + } + + proper { + set gmt [clock format $clock -format "%Y-%m-%d %H:%M:%S" -gmt true] + if {[set diff [expr {($clock-[clock scan $gmt]) / 60}]] < 0} { + set s - + set diff [expr {-($diff)}] + } else { + set s + + } + set zone [format %s%02d%02d $s [ + expr {$diff / 60}] [expr {$diff % 60}]] + + variable WDAYS_SHORT + set wday [lindex $WDAYS_SHORT [clock format $clock -format %w]] + variable MONTHS_SHORT + set mon [lindex $MONTHS_SHORT [ + scan [clock format $clock -format %m] %d]] + + return [ + clock format $clock -format "$wday, %d $mon %Y %H:%M:%S $zone"] + } + + rclock { + #TODO: these paths are not covered by tests + if {$value eq "-now"} { + return 0 + } else { + return [expr {[clock seconds] - $clock}] + } + } + + sec { + set value [clock format $clock -format %S] + } + + wday { + return [clock format $clock -format %w] + } + + weekday { + variable WDAYS_SHORT + return [lindex $WDAYS_SHORT [clock format $clock -format %w]] + } + + yday { + set value [clock format $clock -format %j] + } + + year { + set value [clock format $clock -format %Y] + } + + zone { + set value [string trim [string map [list \t { }] $value]] + if {[set x [string last { } $value]] < 0} { + return 0 + } + set value [string range $value [expr {$x + 1}] end] + switch -- [set s [string index $value 0]] { + + - - { + if {$s eq "+"} { + #TODO: This path is not covered by tests + set s {} + } + set value [string trim [string range $value 1 end]] + if {( + [string length $value] != 4) + || + [scan $value %2d%2d h m] != 2 + || + $h > 12 + || + $m > 59 + || + ($h == 12 && $m > 0) + } { + error "malformed timezone-specification: $value" + } + set value $s[expr {$h * 60 + $m}] + } + + default { + set value [string toupper $value] + set z1 [list UT GMT EST EDT CST CDT MST MDT PST PDT] + set z2 [list 0 0 -5 -4 -6 -5 -7 -6 -8 -7] + if {[set x [lsearch -exact $z1 $value]] < 0} { + error "unrecognized timezone-mnemonic: $value" + } + set value [expr {[lindex $z2 $x] * 60}] + } + } + } + + date2gmt + - + date2local + - + dst + - + sday + - + szone + - + tzone + - + default { + error "unknown property $property" + } + } + + if {[set value [string trimleft $value 0]] eq {}} { + #TODO: this path is not covered by tests + set value 0 + } + return $value +} + +# ::mime::uniqueID -- +# +# Used to generate a 'globally unique identifier' for the content-id. +# The id is built from the pid, the current time, the hostname, and +# a counter that is incremented each time a message is sent. +# +# Arguments: +# +# Results: +# Returns the a string that contains the globally unique identifier +# that should be used for the Content-ID of an e-mail message. + +proc ::mime::uniqueID {} { + variable mime + + return <[pid].[clock seconds].[incr mime(cid)]@[info hostname]> +} + +# ::mime::parselexeme -- +# +# Used to implement a lookahead parser. +# +# Arguments: +# token The MIME token to operate on. +# +# Results: +# Returns the next token found by the parser. + +proc ::mime::parselexeme {token} { + # FRINK: nocheck + variable $token + upvar 0 $token state + + set state(input) [string trimleft $state(input)] + + set state(buffer) {} + if {$state(input) eq {}} { + set state(buffer) end-of-input + return [set state(lastC) LX_END] + } + + set c [string index $state(input) 0] + set state(input) [string range $state(input) 1 end] + + if {$c eq "("} { + set noteP 0 + set quoteP 0 + + while 1 { + append state(buffer) $c + + #TODO: some of these paths are not covered by tests + switch -- $c/$quoteP { + (/0 { + incr noteP + } + + \\/0 { + set quoteP 1 + } + + )/0 { + if {[incr noteP -1] < 1} { + if {[info exists state(comment)]} { + append state(comment) { } + } + append state(comment) $state(buffer) + + return [parselexeme $token] + } + } + + default { + set quoteP 0 + } + } + + if {[set c [string index $state(input) 0]] eq {}} { + set state(buffer) "end-of-input during comment" + return [set state(lastC) LX_ERR] + } + set state(input) [string range $state(input) 1 end] + } + } + + if {$c eq "\""} { + set firstP 1 + set quoteP 0 + + while 1 { + append state(buffer) $c + + switch -- $c/$quoteP { + "\\/0" { + set quoteP 1 + } + + "\"/0" { + if {!$firstP} { + return [set state(lastC) LX_QSTRING] + } + set firstP 0 + } + + default { + set quoteP 0 + } + } + + if {[set c [string index $state(input) 0]] eq {}} { + set state(buffer) "end-of-input during quoted-string" + return [set state(lastC) LX_ERR] + } + set state(input) [string range $state(input) 1 end] + } + } + + if {$c eq {[}} { + set quoteP 0 + + while 1 { + append state(buffer) $c + + switch -- $c/$quoteP { + \\/0 { + set quoteP 1 + } + + ]/0 { + return [set state(lastC) LX_DLITERAL] + } + + default { + set quoteP 0 + } + } + + if {[set c [string index $state(input) 0]] eq {}} { + set state(buffer) "end-of-input during domain-literal" + return [set state(lastC) LX_ERR] + } + set state(input) [string range $state(input) 1 end] + } + } + + if {[set x [lsearch -exact $state(tokenL) $c]] >= 0} { + append state(buffer) $c + + return [set state(lastC) [lindex $state(lexemeL) $x]] + } + + while 1 { + append state(buffer) $c + + switch -- [set c [string index $state(input) 0]] { + {} - " " - "\t" - "\n" { + break + } + + default { + if {[lsearch -exact $state(tokenL) $c] >= 0} { + break + } + } + } + + set state(input) [string range $state(input) 1 end] + } + + return [set state(lastC) LX_ATOM] +} + +# ::mime::mapencoding -- +# +# mime::mapencodings maps tcl encodings onto the proper names for their +# MIME charset type. This is only done for encodings whose charset types +# were known. The remaining encodings return {} for now. +# +# Arguments: +# enc The tcl encoding to map. +# +# Results: +# Returns the MIME charset type for the specified tcl encoding, or {} +# if none is known. + +proc ::mime::mapencoding {enc} { + + variable encodings + + if {[info exists encodings($enc)]} { + return $encodings($enc) + } + return {} +} + +# ::mime::reversemapencoding -- +# +# mime::reversemapencodings maps MIME charset types onto tcl encoding names. +# Those that are unknown return {}. +# +# Arguments: +# mimeType The MIME charset to convert into a tcl encoding type. +# +# Results: +# Returns the tcl encoding name for the specified mime charset, or {} +# if none is known. + +proc ::mime::reversemapencoding {mimeType} { + + variable reversemap + + set lmimeType [string tolower $mimeType] + if {[info exists reversemap($lmimeType)]} { + return $reversemap($lmimeType) + } + return {} +} + +# ::mime::word_encode -- +# +# Word encodes strings as per RFC 2047. +# +# Arguments: +# charset The character set to encode the message to. +# method The encoding method (base64 or quoted-printable). +# string The string to encode. +# ?-charset_encoded 0 or 1 Whether the data is already encoded +# in the specified charset (default 1) +# ?-maxlength maxlength The maximum length of each encoded +# word to return (default 66) +# +# Results: +# Returns a word encoded string. + +proc ::mime::word_encode {charset method string {args}} { + + variable encodings + + if {![info exists encodings($charset)]} { + error "unknown charset '$charset'" + } + + if {$encodings($charset) eq {}} { + error "invalid charset '$charset'" + } + + if {$method ne "base64" && $method ne "quoted-printable"} { + error "unknown method '$method', must be base64 or quoted-printable" + } + + # default to encoded and a length that won't make the Subject header to long + array set options [list -charset_encoded 1 -maxlength 66] + array set options $args + + if {$options(-charset_encoded)} { + set unencoded_string [::encoding convertfrom $charset $string] + } else { + set unencoded_string $string + } + + set string_length [string length $unencoded_string] + + if {!$string_length} { + return {} + } + + set string_bytelength [string bytelength $unencoded_string] + + # the 7 is for =?, ?Q?, ?= delimiters of the encoded word + set maxlength [expr {$options(-maxlength) - [string length $encodings($charset)] - 7}] + switch -exact -- $method { + base64 { + if {$maxlength < 4} { + error "maxlength $options(-maxlength) too short for chosen charset and encoding" + } + set count 0 + set maxlength [expr {($maxlength / 4) * 3}] + while {$count < $string_length} { + set length 0 + set enc_string {} + while {$length < $maxlength && $count < $string_length} { + set char [string range $unencoded_string $count $count] + set enc_char [::encoding convertto $charset $char] + if {$length + [string length $enc_char] > $maxlength} { + set length $maxlength + } else { + append enc_string $enc_char + incr count + incr length [string length $enc_char] + } + } + set encoded_word [string map [ + list \n {}] [base64 -mode encode -- $enc_string]] + append result "=?$encodings($charset)?B?$encoded_word?=\n " + } + # Trim off last "\n ", since the above code has the side-effect + # of adding an extra "\n " to the encoded string. + + set result [string range $result 0 end-2] + } + quoted-printable { + if {$maxlength < 1} { + error "maxlength $options(-maxlength) too short for chosen charset and encoding" + } + set count 0 + while {$count < $string_length} { + set length 0 + set encoded_word {} + while {$length < $maxlength && $count < $string_length} { + set char [string range $unencoded_string $count $count] + set enc_char [::encoding convertto $charset $char] + set qp_enc_char [qp_encode $enc_char 1] + set qp_enc_char_length [string length $qp_enc_char] + if {$qp_enc_char_length > $maxlength} { + error "maxlength $options(-maxlength) too short for chosen charset and encoding" + } + if { + $length + [string length $qp_enc_char] > $maxlength + } { + set length $maxlength + } else { + append encoded_word $qp_enc_char + incr count + incr length [string length $qp_enc_char] + } + } + append result "=?$encodings($charset)?Q?$encoded_word?=\n " + } + # Trim off last "\n ", since the above code has the side-effect + # of adding an extra "\n " to the encoded string. + + set result [string range $result 0 end-2] + } + {} { + # Go ahead + } + default { + error "Can't handle content encoding \"$method\"" + } + } + return $result +} + +# ::mime::word_decode -- +# +# Word decodes strings that have been word encoded as per RFC 2047. +# +# Arguments: +# encoded The word encoded string to decode. +# +# Results: +# Returns the string that has been decoded from the encoded message. + +proc ::mime::word_decode {encoded} { + + variable reversemap + + if {[regexp -- {=\?([^?]+)\?(.)\?([^?]*)\?=} $encoded \ + - charset method string] != 1 + } { + error "malformed word-encoded expression '$encoded'" + } + + set enc [reversemapencoding $charset] + if {$enc eq {}} { + error "unknown charset '$charset'" + } + + switch -exact -- $method { + b - + B { + set method base64 + } + q - + Q { + set method quoted-printable + } + default { + error "unknown method '$method', must be B or Q" + } + } + + switch -exact -- $method { + base64 { + set result [base64 -mode decode -- $string] + } + quoted-printable { + set result [qp_decode $string 1] + } + {} { + # Go ahead + } + default { + error "Can't handle content encoding \"$method\"" + } + } + + return [list $enc $method $result] +} + +# ::mime::field_decode -- +# +# Word decodes strings that have been word encoded as per RFC 2047 +# and converts the string from the original encoding/charset to UTF. +# +# Arguments: +# field The string to decode +# +# Results: +# Returns the decoded string in UTF. + +proc ::mime::field_decode {field} { + # ::mime::field_decode is broken. Here's a new version. + # This code is in the public domain. Don Libes + + # Step through a field for mime-encoded words, building a new + # version with unencoded equivalents. + + # Sorry about the grotesque regexp. Most of it is sensible. One + # notable fudge: the final $ is needed because of an apparent bug + # in the regexp engine where the preceding .* otherwise becomes + # non-greedy - perhaps because of the earlier ".*?", sigh. + + while {[regexp {(.*?)(=\?(?:[^?]+)\?(?:.)\?(?:[^?]*)\?=)(.*)$} $field \ + ignore prefix encoded field] + } { + # don't allow whitespace between encoded words per RFC 2047 + if {{} ne $prefix} { + if {![string is space $prefix]} { + append result $prefix + } + } + + set decoded [word_decode $encoded] + foreach {charset - string} $decoded break + + append result [::encoding convertfrom $charset $string] + } + append result $field + return $result +} + +## One-Shot Initialization + +::apply {{} { + variable encList + variable encAliasList + variable reversemap + + foreach {enc mimeType} $encList { + if {$mimeType eq {}} continue + set reversemap([string tolower $mimeType]) $enc + } + + foreach {enc mimeType} $encAliasList { + set reversemap([string tolower $mimeType]) $enc + } + + # Drop the helper variables + unset encList encAliasList + +} ::mime} + + +variable ::mime::internal 0 diff --git a/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/cap-0.1.0.tm b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/cap-0.1.0.tm index 34bed4c..4cc6f30 100644 --- a/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/cap-0.1.0.tm +++ b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/cap-0.1.0.tm @@ -14,20 +14,36 @@ # @@ Meta End +#*** !doctools +#[manpage_begin punk::cap 0 0.1.0] +#[copyright "2023 JMNoble - BSD licensed"] +#[titledesc {Module API}] +#[moddesc {punk capabilities plugin system}] +#[require punk::cap] +#[description] +#[list_begin definitions] # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Requirements ##e.g package require frobz +package require oolib + -#concepts: -# A capability may be something like providing a folder of files, or just a data dictionary, and/or an API -# -# capability handler - a package/namespace which may provide validation and standardised ways of looking up provider data -# registered (or not) using register_capabilityname -# capability provider - a package which registers as providing one or more capablities. -# registered using register_package -# the capabilitylist is a list of 2-element lists where the first element is the capabilityname and the second element is a (possibly empty) dict of data relevant to that capability -# A capabilityname may appear multiple times. ie a package may register that it provides the capability with multiple datasets. + +# mkdoc markdown +#' --- +#' author: JMNoble +#' --- +#' ## Concepts: +#' > A **capability** may be something like providing a folder of files, or just a data dictionary, and/or an API +#' +#' > **capability handler** - a package/namespace which may provide validation and standardised ways of looking up provider data +#' registered (or not) using register_capabilityname +#' +#' > **capability provider** - a package which registers as providing one or more capablities. +#' registered using register_package +#' the capabilitylist is a list of 2-element lists where the first element is the capabilityname and the second element is a (possibly empty) dict of data relevant to that capability +#' A capabilityname may appear multiple times. ie a package may register that it provides the capability with multiple datasets. # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ @@ -35,32 +51,99 @@ namespace eval punk::cap { variable pkgcapsdeclared [dict create] variable pkgcapsaccepted [dict create] variable caps [dict create] - if {[info commands [namespace current]::interface_caphandler.registry] eq ""} { - oo::class create [namespace current]::interface_caphandler.registry { - method pkg_register {pkg capname capdict fullcapabilitylist} { - #handler may override and return 0 (indicating don't register)e.g if pkg capdict data wasn't valid - #overridden handler must be able to handle multiple calls for same pkg - but it may return 1 or 0 as it wishes. - return 1 ;#default to permit - } - method pkg_unregister {pkg} { - return ;#unregistration return is ignored - review + + namespace eval class { + if {[info commands [namespace current]::interface_caphandler.registry] eq ""} { + #Handler classes + oo::class create [namespace current]::interface_caphandler.registry { + method pkg_register {pkg capname capdict fullcapabilitylist} { + #*** + #[call [class interface_caphandler.registry] [method pkg_register] [arg pkg] [arg capname] [arg capdict] [arg fullcapabilitylist]] + #handler may override and return 0 (indicating don't register)e.g if pkg capdict data wasn't valid + #overridden handler must be able to handle multiple calls for same pkg - but it may return 1 or 0 as it wishes. + return 1 ;#default to permit + } + method pkg_unregister {pkg} { + #*** + #[call [class interface_caphandler.registry] [method pkg_unregister] [arg pkg]] + return ;#unregistration return is ignored - review + } } - } + oo::class create [namespace current]::interface_caphandler.sysapi { - oo::class create [namespace current]::interface_capprovider.registration { - method get_declarations {} { - error "interface_capprovider.registration not implemented by provider" } - } - oo::class create [namespace current]::interface_capprovider.provider { - method register {{capabilityname_glob *}} { + + #Provider classes + oo::class create [namespace current]::interface_capprovider.registration { + method get_declarations {} { + #*** + #[call [class interface_capprovider.registration] [method pkg_unregister] [arg pkg]] + error "interface_capprovider.registration not implemented by provider" + } } - method capabilities {} { + oo::class create [namespace current]::interface_capprovider.provider { + variable provider_pkg + variable registrationobj + constructor {providerpkg} { + variable provider_pkg + if {$providerpkg in [list "" "::"]} { + error "interface_capprovider.provider constructor error. Invalid provider '$providerpkg'" + } + if {![namespace exists ::$providerpkg]} { + error "interface_capprovider.provider constructor error. Invalid provider '$providerpkg' - matching namespace not found" + } + + set registrationobj ::${providerpkg}::capsystem::capprovider.registration + if {[info commands $registrationobj] eq ""} { + error "capprovider.provider constructor error. Missing capprovider.registration interface at '$obj' (command not found) interface_capprovider.regstration instantiation must precede interface_capprovider.provider" + } + + set provider_pkg [string trim $providerpkg ""] + } + method register {{capabilityname_glob *}} { + #*** + #[call [class interface_capprovider.provider] [method register] [opt capabilityname_glob]] + variable provider_pkg + set all_decls [$registrationobj get_declarations] + set register_decls [lsearch -all -inline -index 0 $all_decls $capabilityname_glob] + punk::cap::register_package $provider_pkg $register_decls + } + method capabilities {} { + #*** + #[call [class interface_capprovider.provider] [method capabilities]] + variable provider_pkg + variable registrationobj + + set capabilities [list] + set decls [$registrationobj get_declarations] + foreach decl $decls { + lassign $decl capname capdict + if {$capname ni $capabilities} { + lappend capabilities $capname + } + } + return $capname + } } } + } ;# end namespace class + namespace eval capsystem { + proc get_caphandler_registry {capname} { + set ns [::punk::cap::get_handler $capname]::capsystem + if {[namespace exists ${ns}]} { + if {[info command ${ns}::caphandler.registry] ne ""} { + if {[info object isa object ${ns}::caphandler.registry]} { + return ${ns}::caphandler.registry + } + } + } + return "" + } } + + #Not all capabilities have to be registered. #A package registering as a provider using register_package can include capabilitynames in it's capabilitylist which have no associated capnamespace (handler). #such unregistered capabilitynames may be used just to flag something, or have datamembers significant to callers cooperatively interested in that capname. @@ -88,7 +171,7 @@ namespace eval punk::cap { } if {[llength [set providers [dict get $caps $capname providers]]]} { #some provider(s) were in place before the handler was registered - if {[set capreg [get_caphandler_registry $capname]] ne ""} { + if {[set capreg [punk::cap::capsystem::get_caphandler_registry $capname]] ne ""} { foreach pkg $providers { set fullcapabilitylist [dict get $pkgcapsdeclared $pkg] foreach capspec $fullcapabilitylist { @@ -131,10 +214,31 @@ namespace eval punk::cap { } } proc exists {capname} { + #*** !doctools + # [call [fun exists] [arg capname]] + # Return a boolean indicating if the named capability exists (0|1) + + # mkdoc markdown + #' + #' ## **exists(capname)** + #' + #' > return a boolean indicating the existence of a capability + #' + #' > Arguments: + #' + #' > - *capname* - string indicating the name of the capability + #' + #' > Returns: 0|1 + #' variable caps return [dict exists $caps $capname] } proc has_handler {capname} { + #*** !doctools + # [call [fun has_handler] [arg capname]] + # Return a boolean indicating if the named capability has a handler package installed (0|1) + + variable caps return [expr {[dict exists $caps $capname handler] && [dict get $caps $capname handler] ne ""}] } @@ -157,20 +261,9 @@ namespace eval punk::cap { if {[set handler [get_handler $capname]] eq ""} { error "punk::cap::call_handler $capname $args - no handler registered for capability $capname" } - set obj ${handler}::$capname + set obj ${handler}::api_$capname $obj [lindex $args 0] {*}[lrange $args 1 end] } - proc get_caphandler_registry {capname} { - set ns [get_handler $capname]::capsystem - if {[namespace exists ${ns}]} { - if {[info command ${ns}::caphandler.registry] ne ""} { - if {[info object isa object ${ns}::caphandler.registry]} { - return ${ns}::caphandler.registry - } - } - } - return "" - } proc get_providers {capname} { variable caps if {[dict exists $caps $capname]} { @@ -188,6 +281,11 @@ namespace eval punk::cap { if {[string match ::* $pkg]} { set pkg [string range $pkg 2 end] } + if {[dict exists $pkgcapsaccepted $pkg]} { + set pkg_already_accepted [dict get $pkgcapsaccepted $pkg] + } else { + set pkg_already_accepted [list] + } #for each capability # - ensure 1st element is a single word # - ensure that if 2nd element (capdict) is present - it is dict shaped @@ -199,6 +297,11 @@ namespace eval punk::cap { if {[expr {[llength $capdict] %2 != 0}]} { error "register_package error. pkg:'$pkg' The second element for capname:'$capname' doesn't appear to be a valid dict. Problematic entry: '$capspec'" } + if {$capspec in $pkg_already_accepted} { + #review - multiple handlers? if so - will need to record which handler(s) accepted the capspec + puts stderr "register_package pkg $pkg already has capspec marked as accepted: $capspec" + continue + } if {[dict exists $caps $capname]} { set cap_pkgs [dict get $caps $capname providers] } else { @@ -207,7 +310,7 @@ namespace eval punk::cap { } #todo - if there's a caphandler - call it's init/validation callback for the pkg set do_register 1 ;#default assumption unless vetoed by handler - if {[set capreg [get_caphandler_registry $capname]] ne ""} { + if {[set capreg [punk::cap::capsystem::get_caphandler_registry $capname]] ne ""} { #Note that the interface_caphandler.registry instance must be able to handle multiple calls for same pkg set do_register [$capreg pkg_register $pkg $capname $capdict $capabilitylist] } @@ -219,17 +322,23 @@ namespace eval punk::cap { dict lappend pkgcapsaccepted $pkg $capspec ;#if pkg is being registered prior to handler-registration - the handler may undo this entry } } - #another call to register_pkg with same pkg may have been made (most likely with different capname) so we must append + #another call to register_pkg with same pkg may have been made (most likely with different capname) so we must append - but check not already present #dict lappend pkgcapsdeclared $pkg $capabilitylist if {[dict exists $pkgcapsdeclared $pkg]} { - set caps [dict get $pkgcapsdeclared $pkg] - lappend caps {*}$capabilitylist - dict set pkgcapsdeclared $pkg $caps + set capspecs [dict get $pkgcapsdeclared $pkg] + foreach spec $capspecs { + if {$spec ni $capspecs} { + lappend capspecs $spec + } + } + dict set pkgcapsdeclared $pkg $capspecs } else { dict set pkgcapsdeclared $pkg $capabilitylist } } - proc unregister_package {pkg} { + + #todo! + proc unregister_package {pkg {capname *}} { variable pkgcapsdeclared variable caps if {[string match ::* $pkg]} { @@ -245,13 +354,13 @@ namespace eval punk::cap { set pkglist [dict get $cap_info providers] set posn [lsearch $pkglist $pkg] if {$posn >= 0} { - if {[set capreg [get_caphandler_registry $capname]] ne ""} { + if {[set capreg [punk::cap::capsystem::get_caphandler_registry $capname]] ne ""} { #review # it seems not useful to allow the callback to block this unregister action #the pkg may have multiple datasets for each capname so callback will only be called for first dataset we encounter #vetoing unregister would make this more complex for no particular advantage - #if per capability deregistration required this should probably be a separate thing (e.g disable_capability?) - $capreg pkg_unregister $pkg + #if per dataset deregistration required this should probably be a separate thing + $capreg pkg_unregister $pkg $capname } set pkglist [lreplace $pkglist $posn $posn] dict set caps $capname providers $pkglist @@ -398,21 +507,22 @@ namespace eval punk::cap { - - - - - - - - - - - # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::cap [namespace eval punk::cap { variable version + variable pkg punk::cap set version 0.1.0 + variable README.md [string map [list %pkg% $pkg %ver% $version] { + # punk capabilities system + ## pkg: %pkg% version: %ver% + + punk::cap base namespace + }] + return $version }] -return \ No newline at end of file +return + +#*** !doctools +#[list_end] +#[manpage_end] diff --git a/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/cap/handlers/templates-0.1.0.tm b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/cap/handlers/templates-0.1.0.tm index 28a25e6..75a925d 100644 --- a/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/cap/handlers/templates-0.1.0.tm +++ b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/cap/handlers/templates-0.1.0.tm @@ -35,10 +35,14 @@ namespace eval punk::cap::handlers::templates { namespace eval capsystem { #interfaces for punk::cap to call into if {[info commands caphandler.registry] eq ""} { - punk::cap::interface_caphandler.registry create caphandler.registry + punk::cap::class::interface_caphandler.registry create caphandler.registry oo::objdefine caphandler.registry { method pkg_register {pkg capname capdict caplist} { #caplist may not be complete set - which somewhat reduces its utility here regarding any decisions based on the context of this capname/capdict (review - remove this arg?) + + # -- --- --- --- --- --- --- ---- --- + # validation of capdict + # -- --- --- --- --- --- --- ---- --- if {![dict exists $capdict relpath]} { puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of '$capname' capability, but is missing 'relpath' key" return 0 @@ -52,16 +56,28 @@ namespace eval punk::cap::handlers::templates { set tpath [file normalize [file join $tmfile [dict get $capdict relpath]]] ;#relpath is relative to the tm *file* - not it's containing folder if {![file isdirectory $tpath]} { puts stderr "punk::cap::handlers::templates::capsystem pkg_register WARNING - unable to validate relpath location [dict get $capdict relpath] ($tpath) for package '$pkg' which is attempting to register with punk::cap as a provider of '$capname' capability" + return 0 } + + + # -- --- --- --- --- --- --- ---- --- + # update package internal data + # -- --- --- --- --- --- --- ---- --- if {$capname ni $::punk::cap::handlers::templates::handled_caps} { lappend ::punk::cap::handlers::templates::handled_caps $capname } - if {[info commands punk::cap::handlers::templates::$capname] eq ""} { - punk::cap::handlers::templates::api create ::punk::cap::handlers::templates::$capname $capname - } set cname [string map [list . _] $capname] upvar ::punk::cap::handlers::templates::pkg_folders_$cname pfolders dict lappend pfolders $pkg $tpath + + + # -- --- --- --- --- --- --- ---- --- + # instantiation of api at punk::cap::handlers::templates::api_$capname + # -- --- --- --- --- --- --- ---- --- + if {[info commands ::punk::cap::handlers::templates::$capname] eq ""} { + punk::cap::handlers::templates::class::api create ::punk::cap::handlers::templates::api_$capname $capname + } + return 1 } method pkg_unregister {pkg} { @@ -84,36 +100,38 @@ namespace eval punk::cap::handlers::templates { #handler api for clients of this capability - called via punk::cap::call_handler ?args? # -- --- --- --- --- --- --- namespace export * - - oo::class create api { - #return a dict keyed on folder with source pkg as value - constructor {capname} { - variable capabilityname - variable cname - set cname [string map [list . _] $capname] - set capabilityname $capname - } - method folders {} { - variable capabilityname - variable cname - upvar punk::cap::handlers::templates::pkg_folders_$cname pkg_folders - package require punk::cap - set capinfo [punk::cap::capability $capabilityname] - # e.g {punk.templates {handler punk::mix::templates providers ::somepkg}} - - #use the order of pkgs as registered with punk::cap - may have been modified with punk::cap::promote_package/demote_package - set pkgs [dict get $capinfo providers] - set folderdict [dict create] - foreach pkg $pkgs { - foreach pfolder [dict get $pkg_folders $pkg] { - dict set folderdict $pfolder [list source $pkg sourcetype package] + namespace eval class { + oo::class create api { + #return a dict keyed on folder with source pkg as value + constructor {capname} { + variable capabilityname + variable cname + set cname [string map [list . _] $capname] + set capabilityname $capname + } + method folders {} { + variable capabilityname + variable cname + upvar punk::cap::handlers::templates::pkg_folders_$cname pkg_folders + package require punk::cap + set capinfo [punk::cap::capability $capabilityname] + # e.g {punk.templates {handler punk::mix::templates providers ::somepkg}} + + #use the order of pkgs as registered with punk::cap - may have been modified with punk::cap::promote_package/demote_package + set pkgs [dict get $capinfo providers] + set folderdict [dict create] + foreach pkg $pkgs { + foreach pfolder [dict get $pkg_folders $pkg] { + dict set folderdict $pfolder [list source $pkg sourcetype package] + } } + return $folderdict } - return $folderdict } } + } diff --git a/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/mix-0.2.tm b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/mix-0.2.tm index d09dfca..482c79a 100644 --- a/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/mix-0.2.tm +++ b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/mix-0.2.tm @@ -5,7 +5,7 @@ package require punk::cap::handlers::templates ;#handler for templates cap punk::cap::register_capabilityname punk.templates ::punk::cap::handlers::templates package require punk::mix::templates ;#registers as provider pkg for 'punk.templates' capability with punk::cap -#punk::mix::templates::provider register * +punk::mix::templates::provider register * package require punk::mix::base package require punk::mix::cli diff --git a/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/mix/cli-0.3.tm b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/mix/cli-0.3.tm index 6967226..790cfc6 100644 --- a/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/mix/cli-0.3.tm +++ b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/mix/cli-0.3.tm @@ -170,7 +170,8 @@ namespace eval punk::mix::cli { } cd $sourcefolder #use run so that stdout visible as it goes - if {![catch {run --timeout=5000 -debug [info nameofexecutable] $sourcefolder/make.tcl {*}$args} exitinfo]} { + if {![catch {run --timeout=55000 -debug [info nameofexecutable] $sourcefolder/make.tcl {*}$args} exitinfo]} { + #todo - notify if exit because of timeout! puts stderr "exitinfo: $exitinfo" set exitcode [dict get $exitinfo exitcode] } else { diff --git a/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/mix/commandset/doc-0.1.0.tm b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/mix/commandset/doc-0.1.0.tm index 6184a38..0b7c292 100644 --- a/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/mix/commandset/doc-0.1.0.tm +++ b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/mix/commandset/doc-0.1.0.tm @@ -18,7 +18,11 @@ ## Requirements ##e.g package require frobz - +package require punk ;# for treefilenames +package require punk::repo +package require punk::docgen ;#inline doctools - generate doctools .man files at src/docgen prior to using kettle to producing .html .md etc +package require punk::mix::cli ;#punk::mix::cli::lib used for kettle_call +package require punk::mix::util ;#for path_relative # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ @@ -38,6 +42,30 @@ namespace eval punk::mix::commandset::doc { puts stderr "No current project dir - unable to build docs" return } + #user may delete the comment containing "--- punk::docgen::overwrites" and then manually edit, and we won't overwrite + #we still generate output in src/docgen so user can diff and manually update if thats what they prefer + set oldfiles [glob -nocomplain -dir $projectdir/src/doc -type f _module_*] + foreach maybedoomed $oldfiles { + set fd [open $maybedoomed r] + set data [read $fd] + close $fd + if {[string match "*--- punk::docgen overwrites *" $data]} { + file delete -force $maybedoomed + } + } + set generated [lib::do_docgen modules] + if {[dict get $generated count] > 0} { + #review + set doclist [dict get $generated docs] + foreach dinfo $doclist { + lassign $dinfo module fpath + set target $projectdir/src/doc/_module_[file tail $fpath] + if {![file exists $target]} { + file copy $fpath $target + } + } + } + if {[file exists $projectdir/src/doc]} { set original_wd [pwd] cd $projectdir/src @@ -125,6 +153,7 @@ namespace eval punk::mix::commandset::doc { cd $original_wd } proc validate {} { + #todo - run and validate punk::docgen output set projectdir [punk::repo::find_project] if {$projectdir eq ""} { puts stderr "No current project dir - unable to check doc status" @@ -154,6 +183,49 @@ namespace eval punk::mix::commandset::doc { namespace eval lib { variable pkg set pkg punk::mix::commandset::doc + proc do_docgen {{project_subpath modules}} { + set projectdir [punk::repo::find_project] + set outdir [file join $projectdir src docgen] + set subpath [file join $projectdir $project_subpath] + if {![file isdirectory $subpath]} { + puts stderr "WARNING punk::mix::commandset::doc unable to find subpath $subpath during do_docgen - skipping inline doctools generation" + return + } + if {[file isdirectory $outdir]} { + if {[catch { + file delete -force $outdir + }]} { + error "do_docgen failed to delete existing $outdir" + } + } + file mkdir $outdir + + set matched_paths [punk::treefilenames $subpath *.tm] + set count 0 + set newdocs [list] + set docgen_header_comments "" + append docgen_header_comments {[comment {--- punk::docgen generated from inline doctools comments ---}]} \n + append docgen_header_comments {[comment {--- punk::docgen DO NOT EDIT DOCS HERE UNLESS YOU REMOVE THESE COMMENT LINES ---}]} \n + append docgen_header_comments {[comment {--- punk::docgen overwrites this file ---}]} \n + foreach fullpath $matched_paths { + set relpath [punk::mix::util::path_relative $subpath $fullpath] + set tailsegs [file split $relpath] + set module_fullname [join $tailsegs ::] + set docname [string map [list :: _] $module_fullname].man ;#todo - something better - need to ensure unique + set doctools [punk::docgen::get_doctools_comments $fullpath] + if {$doctools ne ""} { + puts stdout "generating doctools output from file $relpath" + set outfile [file join $outdir $docname] + set fd [open $outfile w] + fconfigure $fd -translation binary + puts -nonewline $fd $docgen_header_comments$doctools + close $fd + incr count + lappend newdocs [list $module_fullname $outfile] + } + } + return [list count $count docs $newdocs] + } } } diff --git a/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/mix/templates-0.1.0.tm b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/mix/templates-0.1.0.tm index 8d52517..46065bd 100644 --- a/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/mix/templates-0.1.0.tm +++ b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/mix/templates-0.1.0.tm @@ -26,17 +26,19 @@ namespace eval punk::mix::templates { variable pkg punk::mix::templates variable cap_provider - punk::cap::register_package punk::mix::templates [list\ - {punk.templates {relpath ../templates}}\ - ] + #punk::cap::register_package punk::mix::templates [list\ + # {punk.templates {relpath ../templates}}\ + #] + namespace eval capsystem { if {[info commands capprovider.registration] eq ""} { - punk::cap::interface_capprovider.registration create capprovider.registration + punk::cap::class::interface_capprovider.registration create capprovider.registration oo::objdefine capprovider.registration { method get_declarations {} { set decls [list] - lappend decls punk.templates {relpath ../templates} - lappend decls punk.templates {relpath ../templates2} + lappend decls [list punk.templates {relpath ../templates}] + lappend decls [list punk.templates {relpath ../templates2}] + lappend decls [list punk.test {something blah}] return $decls } } @@ -44,7 +46,7 @@ namespace eval punk::mix::templates { } if {[info commands provider] eq ""} { - punk::cap::interface_capprovider.provider create provider + punk::cap::class::interface_capprovider.provider create provider punk::mix::templates oo::objdefine provider { method register {{capabilityname_glob *}} { #puts registering punk::mix::templates $capabilityname diff --git a/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punkcheck-0.1.0.tm b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punkcheck-0.1.0.tm index 41d8759..0dc9523 100644 --- a/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punkcheck-0.1.0.tm +++ b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punkcheck-0.1.0.tm @@ -1078,7 +1078,7 @@ namespace eval punkcheck { } proc install_non_tm_files {srcdir basedir args} { #set keys [dict keys $args] - #adjust the default anti_glob_dir_core entries so that .fossil-custom, .fossil-settings are copied + #adjust the default antiglob_dir_core entries so that .fossil-custom, .fossil-settings are copied set antiglob_dir_core [punkcheck::default_antiglob_dir_core] set posn [lsearch $antiglob_dir_core ".fossil*"] if {$posn >=0} { @@ -1168,7 +1168,7 @@ namespace eval punkcheck { -antiglob_file "" \ -antiglob_dir_core "\uFFFF"\ -antiglob_dir {}\ - -unpublish_paths {}\ + -antiglob_paths {}\ -overwrite no-targets\ -source_checksum comparestore\ -punkcheck_folder target\ @@ -1225,8 +1225,8 @@ namespace eval punkcheck { # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_antiglob_dir [dict get $opts -antiglob_dir] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- - set opt_unpublish_paths [dict get $opts -unpublish_paths] ;#todo - combine with config file in source tree .punkcheckpublish (?) - set unpublish_paths_matched [list] + set opt_antiglob_paths [dict get $opts -antiglob_paths] ;#todo - combine with config file in source tree .punkcheckpublish (?) + set antiglob_paths_matched [list] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set known_whats [list no-targets newer-targets older-targets all-targets installedsourcechanged-targets synced-targets] set overwrite_what [string tolower [dict get $opts -overwrite]]; #accept any case for value to allow emphasis by caller e.g -overwrite NEWER-TARGETS @@ -1347,11 +1347,11 @@ namespace eval punkcheck { if {$target_relative_to_punkcheck_dir eq "."} { set target_relative_to_punkcheck_dir "" } - foreach unpub $opt_unpublish_paths { + foreach unpub $opt_antiglob_paths { #puts "testing folder - globmatchpath $unpub $relative_source_dir" if {[globmatchpath $unpub $relative_source_dir]} { - lappend unpublish_paths_matched $current_source_dir - return [list files_copied {} files_skipped {} sources_unchanged {} punkcheck_records $punkcheck_records unpublish_paths_matched $unpublish_paths_matched srcdir $srcdir tgtdir $tgtdir punkcheck_folder $punkcheck_folder] + lappend antiglob_paths_matched $current_source_dir + return [list files_copied {} files_skipped {} sources_unchanged {} punkcheck_records $punkcheck_records antiglob_paths_matched $antiglob_paths_matched srcdir $srcdir tgtdir $tgtdir punkcheck_folder $punkcheck_folder] } } @@ -1418,16 +1418,16 @@ namespace eval punkcheck { set relative_target_path [file join $relative_target_dir $m] set relative_source_path [file join $relative_source_dir $m] set punkcheck_target_relpath [file join $target_relative_to_punkcheck_dir $m] - set is_unpublished 0 - foreach unpub $opt_unpublish_paths { - #puts "testing file - globmatchpath $unpub vs $relative_source_path" - if {[globmatchpath $unpub $relative_source_path]} { - lappend unpublish_paths_matched $current_source_dir - set is_unpublished 1 + set is_antipath 0 + foreach antipath $opt_antiglob_paths { + #puts "testing file - globmatchpath $antipath vs $relative_source_path" + if {[globmatchpath $antipath $relative_source_path]} { + lappend antiglob_paths_matched $current_source_dir + set is_antipath 1 break } } - if {$is_unpublished} { + if {$is_antipath} { continue } #puts stdout " checking file : $current_source_dir/$m" @@ -1642,7 +1642,7 @@ namespace eval punkcheck { lappend files_copied {*}[dict get $sub_result files_copied] lappend files_skipped {*}[dict get $sub_result files_skipped] lappend sources_unchanged {*}[dict get $sub_result sources_unchanged] - lappend unpublish_paths_matched {*}[dict get $sub_result unpublish_paths_matched] + lappend antiglob_paths_matched {*}[dict get $sub_result antiglob_paths_matched] set punkcheck_records [dict get $sub_result punkcheck_records] } @@ -1664,7 +1664,7 @@ namespace eval punkcheck { } } - return [list files_copied $files_copied files_skipped $files_skipped sources_unchanged $sources_unchanged unpublish_paths_matched $unpublish_paths_matched punkcheck_records $punkcheck_records punkcheck_folder $punkcheck_folder srcdir $srcdir tgtdir $tgtdir] + return [list files_copied $files_copied files_skipped $files_skipped sources_unchanged $sources_unchanged antiglob_paths_matched $antiglob_paths_matched punkcheck_records $punkcheck_records punkcheck_folder $punkcheck_folder srcdir $srcdir tgtdir $tgtdir] } proc summarize_install_resultdict {resultdict} { set msg "" diff --git a/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil-0.9.tm b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil-0.9.tm new file mode 100644 index 0000000..5925851 --- /dev/null +++ b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil-0.9.tm @@ -0,0 +1,80 @@ +# textutil.tcl -- +# +# Utilities for manipulating strings, words, single lines, +# paragraphs, ... +# +# Copyright (c) 2000 by Ajuba Solutions. +# Copyright (c) 2000 by Eric Melski +# Copyright (c) 2002 by Joe English +# Copyright (c) 2001-2006 by Andreas Kupries +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: textutil.tcl,v 1.17 2006/09/21 06:46:24 andreas_kupries Exp $ + +# ### ### ### ######### ######### ######### +## Requirements + +package require Tcl 8.2 + +namespace eval ::textutil {} + +# ### ### ### ######### ######### ######### +## API implementation +## All through sub-packages imported here. + +package require textutil::string +package require textutil::repeat +package require textutil::adjust +package require textutil::split +package require textutil::tabify +package require textutil::trim +package require textutil::wcswidth + +namespace eval ::textutil { + # Import the miscellaneous string command for public export + + namespace import -force string::chop string::tail + namespace import -force string::cap string::uncap string::capEachWord + namespace import -force string::longestCommonPrefix + namespace import -force string::longestCommonPrefixList + + # Import the repeat commands for public export + + namespace import -force repeat::strRepeat repeat::blank + + # Import the adjust commands for public export + + namespace import -force adjust::adjust adjust::indent adjust::undent + + # Import the split commands for public export + + namespace import -force split::splitx split::splitn + + # Import the trim commands for public export + + namespace import -force trim::trim trim::trimleft trim::trimright + namespace import -force trim::trimPrefix trim::trimEmptyHeading + + # Import the tabify commands for public export + + namespace import -force tabify::tabify tabify::untabify + namespace import -force tabify::tabify2 tabify::untabify2 + + # Re-export all the imported commands + + namespace export chop tail cap uncap capEachWord + namespace export longestCommonPrefix longestCommonPrefixList + namespace export strRepeat blank + namespace export adjust indent undent + namespace export splitx splitn + namespace export trim trimleft trimright trimPrefix trimEmptyHeading + namespace export tabify untabify tabify2 untabify2 +} + + +# ### ### ### ######### ######### ######### +## Ready + +package provide textutil 0.9 diff --git a/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/adjust-0.7.3.tm b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/adjust-0.7.3.tm new file mode 100644 index 0000000..d47c82f --- /dev/null +++ b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/adjust-0.7.3.tm @@ -0,0 +1,761 @@ +# trim.tcl -- +# +# Various ways of trimming a string. +# +# Copyright (c) 2000 by Ajuba Solutions. +# Copyright (c) 2000 by Eric Melski +# Copyright (c) 2002-2004 by Johannes-Heinrich Vogeler +# Copyright (c) 2001-2006 by Andreas Kupries +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: adjust.tcl,v 1.16 2011/12/13 18:12:56 andreas_kupries Exp $ + +# ### ### ### ######### ######### ######### +## Requirements + +package require Tcl 8.2 +package require textutil::repeat +package require textutil::string + +namespace eval ::textutil::adjust {} + +# ### ### ### ######### ######### ######### +## API implementation + +namespace eval ::textutil::adjust { + namespace import -force ::textutil::repeat::strRepeat +} + +proc ::textutil::adjust::adjust {text args} { + if {[string length [string trim $text]] == 0} { + return "" + } + + Configure $args + Adjust text newtext + + return $newtext +} + +proc ::textutil::adjust::Configure {args} { + variable Justify left + variable Length 72 + variable FullLine 0 + variable StrictLength 0 + variable Hyphenate 0 + variable HyphPatterns ; # hyphenation patterns (TeX) + + set args [ lindex $args 0 ] + foreach { option value } $args { + switch -exact -- $option { + -full { + if { ![ string is boolean -strict $value ] } then { + error "expected boolean but got \"$value\"" + } + set FullLine [ string is true $value ] + } + -hyphenate { + # the word exceeding the length of line is tried to be + # hyphenated; if a word cannot be hyphenated to fit into + # the line processing stops! The length of the line should + # be set to a reasonable value! + + if { ![ string is boolean -strict $value ] } then { + error "expected boolean but got \"$value\"" + } + set Hyphenate [string is true $value] + if { $Hyphenate && ![info exists HyphPatterns(_LOADED_)]} { + error "hyphenation patterns not loaded!" + } + } + -justify { + set lovalue [ string tolower $value ] + switch -exact -- $lovalue { + left - + right - + center - + plain { + set Justify $lovalue + } + default { + error "bad value \"$value\": should be center, left, plain or right" + } + } + } + -length { + if { ![ string is integer $value ] } then { + error "expected positive integer but got \"$value\"" + } + if { $value < 1 } then { + error "expected positive integer but got \"$value\"" + } + set Length $value + } + -strictlength { + # the word exceeding the length of line is moved to the + # next line without hyphenation; words longer than given + # line length are cut into smaller pieces + + if { ![ string is boolean -strict $value ] } then { + error "expected boolean but got \"$value\"" + } + set StrictLength [ string is true $value ] + } + default { + error "bad option \"$option\": must be -full, -hyphenate, \ + -justify, -length, or -strictlength" + } + } + } + + return "" +} + +# ::textutil::adjust::Adjust +# +# History: +# rewritten on 2004-04-13 for bugfix tcllib-bugs-882402 (jhv) + +proc ::textutil::adjust::Adjust { varOrigName varNewName } { + variable Length + variable FullLine + variable StrictLength + variable Hyphenate + + upvar $varOrigName orig + upvar $varNewName text + + set pos 0; # Cursor after writing + set line "" + set text "" + + + if {!$FullLine} { + regsub -all -- "(\n)|(\t)" $orig " " orig + regsub -all -- " +" $orig " " orig + regsub -all -- "(^ *)|( *\$)" $orig "" orig + } + + set words [split $orig] + set numWords [llength $words] + set numline 0 + + for {set cnt 0} {$cnt < $numWords} {incr cnt} { + + set w [lindex $words $cnt] + set wLen [string length $w] + + # the word $w doesn't fit into the present line + # case #1: we try to hyphenate + + if {$Hyphenate && ($pos+$wLen >= $Length)} { + # Hyphenation instructions + set w2 [textutil::adjust::Hyphenation $w] + + set iMax [llength $w2] + if {$iMax == 1 && [string length $w] > $Length} { + # word cannot be hyphenated and exceeds linesize + + error "Word \"$w2\" can\'t be hyphenated\ + and exceeds linesize $Length!" + } else { + # hyphenating of $w was successfull, but we have to look + # that every sylable would fit into the line + + foreach x $w2 { + if {[string length $x] >= $Length} { + error "Word \"$w\" can\'t be hyphenated\ + to fit into linesize $Length!" + } + } + } + + for {set i 0; set w3 ""} {$i < $iMax} {incr i} { + set syl [lindex $w2 $i] + if {($pos+[string length " $w3$syl-"]) > $Length} {break} + append w3 $syl + } + for {set w4 ""} {$i < $iMax} {incr i} { + set syl [lindex $w2 $i] + append w4 $syl + } + + if {[string length $w3] && [string length $w4]} { + # hyphenation was successfull: redefine + # list of words w => {"$w3-" "$w4"} + + set x [lreplace $words $cnt $cnt "$w4"] + set words [linsert $x $cnt "$w3-"] + set w [lindex $words $cnt] + set wLen [string length $w] + incr numWords + } + } + + # the word $w doesn't fit into the present line + # case #2: we try to cut the word into pieces + + if {$StrictLength && ([string length $w] > $Length)} { + # cut word into two pieces + set w2 $w + + set over [expr {$pos+2+$wLen-$Length}] + + incr Length -1 + set w3 [string range $w2 0 $Length] + incr Length + set w4 [string range $w2 $Length end] + + set x [lreplace $words $cnt $cnt $w4] + set words [linsert $x $cnt $w3 ] + set w [lindex $words $cnt] + set wLen [string length $w] + incr numWords + } + + # continuing with the normal procedure + + if {($pos+$wLen < $Length)} { + # append word to current line + + if {$pos} {append line " "; incr pos} + append line $w + incr pos $wLen + } else { + # line full => write buffer and begin a new line + + if {[string length $text]} {append text "\n"} + append text [Justification $line [incr numline]] + set line $w + set pos $wLen + } + } + + # write buffer and return! + + if {[string length $text]} {append text "\n"} + append text [Justification $line end] + return $text +} + +# ::textutil::adjust::Justification +# +# justify a given line +# +# Parameters: +# line text for justification +# index index for line in text +# +# Returns: +# the justified line +# +# Remarks: +# Only lines with size not exceeding the max. linesize provided +# for text formatting are justified!!! + +proc ::textutil::adjust::Justification { line index } { + variable Justify + variable Length + variable FullLine + + set len [string length $line]; # length of current line + + if { $Length <= $len } then { + # the length of current line ($len) is equal as or greater than + # the value provided for text formatting ($Length) => to avoid + # inifinite loops we leave $line unchanged and return! + + return $line + } + + # Special case: + # for the last line, and if the justification is set to 'plain' + # the real justification is 'left' if the length of the line + # is less than 90% (rounded) of the max length allowed. This is + # to avoid expansion of this line when it is too small: without + # it, the added spaces will 'unbeautify' the result. + # + + set justify $Justify + if { ( "$index" == "end" ) && \ + ( "$Justify" == "plain" ) && \ + ( $len < round($Length * 0.90) ) } then { + set justify left + } + + # For a left justification, nothing to do, but to + # add some spaces at the end of the line if requested + + if { "$justify" == "left" } then { + set jus "" + if { $FullLine } then { + set jus [strRepeat " " [ expr { $Length - $len } ]] + } + return "${line}${jus}" + } + + # For a right justification, just add enough spaces + # at the beginning of the line + + if { "$justify" == "right" } then { + set jus [strRepeat " " [ expr { $Length - $len } ]] + return "${jus}${line}" + } + + # For a center justification, add half of the needed spaces + # at the beginning of the line, and the rest at the end + # only if needed. + + if { "$justify" == "center" } then { + set mr [ expr { ( $Length - $len ) / 2 } ] + set ml [ expr { $Length - $len - $mr } ] + set jusl [strRepeat " " $ml] + set jusr [strRepeat " " $mr] + if { $FullLine } then { + return "${jusl}${line}${jusr}" + } else { + return "${jusl}${line}" + } + } + + # For a plain justification, it's a little bit complex: + # + # if some spaces are missing, then + # + # 1) sort the list of words in the current line by decreasing size + # 2) foreach word, add one space before it, except if it's the + # first word, until enough spaces are added + # 3) rebuild the line + + if { "$justify" == "plain" } then { + set miss [ expr { $Length - [ string length $line ] } ] + + # Bugfix tcllib-bugs-860753 (jhv) + + set words [split $line] + set numWords [llength $words] + + if {$numWords < 2} { + # current line consists of less than two words - we can't + # insert blanks to achieve a plain justification => leave + # $line unchanged and return! + + return $line + } + + for {set i 0; set totalLen 0} {$i < $numWords} {incr i} { + set w($i) [lindex $words $i] + if {$i > 0} {set w($i) " $w($i)"} + set wLen($i) [string length $w($i)] + set totalLen [expr {$totalLen+$wLen($i)}] + } + + set miss [expr {$Length - $totalLen}] + + # len walks through all lengths of words of the line under + # consideration + + for {set len 1} {$miss > 0} {incr len} { + for {set i 1} {($i < $numWords) && ($miss > 0)} {incr i} { + if {$wLen($i) == $len} { + set w($i) " $w($i)" + incr wLen($i) + incr miss -1 + } + } + } + + set line "" + for {set i 0} {$i < $numWords} {incr i} { + set line "$line$w($i)" + } + + # End of bugfix + + return "${line}" + } + + error "Illegal justification key \"$justify\"" +} + +proc ::textutil::adjust::SortList { list dir index } { + + if { [ catch { lsort -integer -$dir -index $index $list } sl ] != 0 } then { + error "$sl" + } + + return $sl +} + +# Hyphenation utilities based on Knuth's algorithm +# +# Copyright (C) 2001-2003 by Dr.Johannes-Heinrich Vogeler (jhv) +# These procedures may be used as part of the tcllib + +# textutil::adjust::Hyphenation +# +# Hyphenate a string using Knuth's algorithm +# +# Parameters: +# str string to be hyphenated +# +# Returns: +# the hyphenated string + +proc ::textutil::adjust::Hyphenation { str } { + + # if there are manual set hyphenation marks e.g. "Recht\-schrei\-bung" + # use these for hyphenation and return + + if {[regexp {[^\\-]*[\\-][.]*} $str]} { + regsub -all {(\\)(-)} $str {-} tmp + return [split $tmp -] + } + + # Don't hyphenate very short words! Minimum length for hyphenation + # is set to 3 characters! + + if { [string length $str] < 4 } then { return $str } + + # otherwise follow Knuth's algorithm + + variable HyphPatterns; # hyphenation patterns (TeX) + + set w ".[string tolower $str]."; # transform to lower case + set wLen [string length $w]; # and add delimiters + + # Initialize hyphenation weights + + set s {} + for {set i 0} {$i < $wLen} {incr i} { + lappend s 0 + } + + for {set i 0} {$i < $wLen} {incr i} { + set kmax [expr {$wLen-$i}] + for {set k 1} {$k < $kmax} {incr k} { + set sw [string range $w $i [expr {$i+$k}]] + if {[info exists HyphPatterns($sw)]} { + set hw $HyphPatterns($sw) + set hwLen [string length $hw] + for {set l1 0; set l2 0} {$l1 < $hwLen} {incr l1} { + set c [string index $hw $l1] + if {[string is digit $c]} { + set sPos [expr {$i+$l2}] + if {$c > [lindex $s $sPos]} { + set s [lreplace $s $sPos $sPos $c] + } + } else { + incr l2 + } + } + } + } + } + + # Replace all even hyphenation weigths by zero + + for {set i 0} {$i < [llength $s]} {incr i} { + set c [lindex $s $i] + if {!($c%2)} { set s [lreplace $s $i $i 0] } + } + + # Don't start with a hyphen! Take also care of words enclosed in quotes + # or that someone has forgotten to put a blank between a punctuation + # character and the following word etc. + + for {set i 1} {$i < ($wLen-1)} {incr i} { + set c [string range $w $i end] + if {[regexp {^[:alpha:][.]*} $c]} { + for {set k 1} {$k < ($i+1)} {incr k} { + set s [lreplace $s $k $k 0] + } + break + } + } + + # Don't separate the last character of a word with a hyphen + + set max [expr {[llength $s]-2}] + if {$max} {set s [lreplace $s $max end 0]} + + # return the syllabels of the hyphenated word as a list! + + set ret "" + set w ".$str." + for {set i 1} {$i < ($wLen-1)} {incr i} { + if {[lindex $s $i]} { append ret - } + append ret [string index $w $i] + } + return [split $ret -] +} + +# textutil::adjust::listPredefined +# +# Return the names of the hyphenation files coming with the package. +# +# Parameters: +# None. +# +# Result: +# List of filenames (without directory) + +proc ::textutil::adjust::listPredefined {} { + variable here + return [glob -type f -directory $here -tails *.tex] +} + +# textutil::adjust::getPredefined +# +# Retrieve the full path for a predefined hyphenation file +# coming with the package. +# +# Parameters: +# name Name of the predefined file. +# +# Results: +# Full path to the file, or an error if it doesn't +# exist or is matching the pattern *.tex. + +proc ::textutil::adjust::getPredefined {name} { + variable here + + if {![string match *.tex $name]} { + return -code error \ + "Illegal hyphenation file \"$name\"" + } + set path [file join $here $name] + if {![file exists $path]} { + return -code error \ + "Unknown hyphenation file \"$path\"" + } + return $path +} + +# textutil::adjust::readPatterns +# +# Read hyphenation patterns from a file and store them in an array +# +# Parameters: +# filNam name of the file containing the patterns + +proc ::textutil::adjust::readPatterns { filNam } { + + variable HyphPatterns; # hyphenation patterns (TeX) + + # HyphPatterns(_LOADED_) is used as flag for having loaded + # hyphenation patterns from the respective file (TeX format) + + if {[info exists HyphPatterns(_LOADED_)]} { + unset HyphPatterns(_LOADED_) + } + + # the array xlat provides translation from TeX encoded characters + # to those of the ISO-8859-1 character set + + set xlat(\"s) \337; # 223 := sharp s " + set xlat(\`a) \340; # 224 := a, grave + set xlat(\'a) \341; # 225 := a, acute + set xlat(\^a) \342; # 226 := a, circumflex + set xlat(\"a) \344; # 228 := a, diaeresis " + set xlat(\`e) \350; # 232 := e, grave + set xlat(\'e) \351; # 233 := e, acute + set xlat(\^e) \352; # 234 := e, circumflex + set xlat(\`i) \354; # 236 := i, grave + set xlat(\'i) \355; # 237 := i, acute + set xlat(\^i) \356; # 238 := i, circumflex + set xlat(\~n) \361; # 241 := n, tilde + set xlat(\`o) \362; # 242 := o, grave + set xlat(\'o) \363; # 243 := o, acute + set xlat(\^o) \364; # 244 := o, circumflex + set xlat(\"o) \366; # 246 := o, diaeresis " + set xlat(\`u) \371; # 249 := u, grave + set xlat(\'u) \372; # 250 := u, acute + set xlat(\^u) \373; # 251 := u, circumflex + set xlat(\"u) \374; # 252 := u, diaeresis " + + set fd [open $filNam RDONLY] + set status 0 + + while {[gets $fd line] >= 0} { + + switch -exact $status { + PATTERNS { + if {[regexp {^\}[.]*} $line]} { + # End of patterns encountered: set status + # and ignore that line + set status 0 + continue + } else { + # This seems to be pattern definition line; to process it + # we have first to do some editing + # + # 1) eat comments in a pattern definition line + # 2) eat braces and coded linefeeds + + set z [string first "%" $line] + if {$z > 0} { set line [string range $line 0 [expr {$z-1}]] } + + regsub -all {(\\n|\{|\})} $line {} tmp + set line $tmp + + # Now $line should consist only of hyphenation patterns + # separated by white space + + # Translate TeX encoded characters to ISO-8859-1 characters + # using the array xlat defined above + + foreach x [array names xlat] { + regsub -all {$x} $line $xlat($x) tmp + set line $tmp + } + + # split the line and create a lookup array for + # the repective hyphenation patterns + + foreach item [split $line] { + if {[string length $item]} { + if {![string match {\\} $item]} { + # create index for hyphenation patterns + + set var $item + regsub -all {[0-9]} $var {} idx + # store hyphenation patterns as elements of an array + + set HyphPatterns($idx) $item + } + } + } + } + } + EXCEPTIONS { + if {[regexp {^\}[.]*} $line]} { + # End of patterns encountered: set status + # and ignore that line + set status 0 + continue + } else { + # to be done in the future + } + } + default { + if {[regexp {^\\endinput[.]*} $line]} { + # end of data encountered, stop processing and + # ignore all the following text .. + break + } elseif {[regexp {^\\patterns[.]*} $line]} { + # begin of patterns encountered: set status + # and ignore that line + set status PATTERNS + continue + } elseif {[regexp {^\\hyphenation[.]*} $line]} { + # some particular cases to be treated separately + set status EXCEPTIONS + continue + } else { + set status 0 + } + } + } + } + + close $fd + set HyphPatterns(_LOADED_) 1 + + return +} + +####################################################### + +# @c The specified block is indented +# @c by ing each line. The first +# @c lines ares skipped. +# +# @a text: The paragraph to indent. +# @a prefix: The string to use as prefix for each line +# @a prefix: of with. +# @a skip: The number of lines at the beginning to leave untouched. +# +# @r Basically , but indented a certain amount. +# +# @i indent +# @n This procedure is not checked by the testsuite. + +proc ::textutil::adjust::indent {text prefix {skip 0}} { + set text [string trimright $text] + + set res [list] + foreach line [split $text \n] { + if {[string compare "" [string trim $line]] == 0} { + lappend res {} + } else { + set line [string trimright $line] + if {$skip <= 0} { + lappend res $prefix$line + } else { + lappend res $line + } + } + if {$skip > 0} {incr skip -1} + } + return [join $res \n] +} + +# Undent the block of text: Compute LCP (restricted to whitespace!) +# and remove that from each line. Note that this preverses the +# shaping of the paragraph (i.e. hanging indent are _not_ flattened) +# We ignore empty lines !! + +proc ::textutil::adjust::undent {text} { + + if {$text == {}} {return {}} + + set lines [split $text \n] + set ne [list] + foreach l $lines { + if {[string length [string trim $l]] == 0} continue + lappend ne $l + } + set lcp [::textutil::string::longestCommonPrefixList $ne] + + if {[string length $lcp] == 0} {return $text} + + regexp "^(\[\t \]*)" $lcp -> lcp + + if {[string length $lcp] == 0} {return $text} + + set len [string length $lcp] + + set res [list] + foreach l $lines { + if {[string length [string trim $l]] == 0} { + lappend res {} + } else { + lappend res [string range $l $len end] + } + } + return [join $res \n] +} + +# ### ### ### ######### ######### ######### +## Data structures + +namespace eval ::textutil::adjust { + variable here [file dirname [info script]] + + variable Justify left + variable Length 72 + variable FullLine 0 + variable StrictLength 0 + variable Hyphenate 0 + variable HyphPatterns + + namespace export adjust indent undent +} + +# ### ### ### ######### ######### ######### +## Ready + +package provide textutil::adjust 0.7.3 diff --git a/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/dehypht.tex b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/dehypht.tex new file mode 100644 index 0000000..8f1dfb0 --- /dev/null +++ b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/dehypht.tex @@ -0,0 +1,902 @@ +% This is `dehypht.tex' as of 03 March 1999. +% +% Copyright (C) 1988,1991 Rechenzentrum der Ruhr-Universitaet Bochum +% [german hyphen patterns] +% Copyright (C) 1993,1994,1999 Bernd Raichle/DANTE e.V. +% [macros, adaption for TeX 2] +% +% ----------------------------------------------------------------- +% IMPORTANT NOTICE: +% +% This program can be redistributed and/or modified under the terms +% of the LaTeX Project Public License Distributed from CTAN +% archives in directory macros/latex/base/lppl.txt; either +% version 1 of the License, or any later version. +% ----------------------------------------------------------------- +% +% +% This file contains german hyphen patterns following traditional +% hyphenation rules and includes umlauts and sharp s, but without +% `c-k' and triple consonants. It is based on hyphen patterns +% containing 5719 german hyphen patterns with umlauts in the +% recommended version of September 27, 1990. +% +% For use with TeX generated by +% +% Norbert Schwarz +% Rechenzentrum Ruhr-Universitaet Bochum +% Universitaetsstrasse 150 +% D-44721 Bochum, FRG +% +% +% Adaption of these patterns for TeX, Version 2.x and 3.x and +% all fonts in T1/`Cork'/EC/DC and/or OT1/CM encoding by +% +% Bernd Raichle +% Stettener Str. 73 +% D-73732 Esslingen, FRG +% Email: raichle@Informatik.Uni-Stuttgart.DE +% +% +% Error reports in case of UNCHANGED versions to +% +% DANTE e.V., Koordinator `german.sty' +% Postfach 10 18 40 +% D-69008 Heidelberg, FRG +% Email: german@Dante.DE +% +% or one of the addresses given above. +% +% +% Changes: +% 1990-09-27 First version of `ghyphen3.tex' (Norbert Schwarz) +% 1991-02-13 PC umlauts changed to ^^xx (Norbert Schwarz) +% 1993-08-27 Umlauts/\ss changed to "a/\3 macros, added macro +% definitions and additional logic to select correct +% patterns/encoding (Bernd Raichle) +% 1994-02-13 Release of `ghyph31.tex' V3.1a (Bernd Raichle) +% 1999-03-03 Renamed file to `dehypht.tex' according to the +% naming scheme using the ISO country code `de', the +% common part `hyph' for all hyphenation patterns files, +% and the additional postfix `t' for traditional, +% removed wrong catcode change of ^^e (the comment +% character %) and ^^f (the character &), +% do _not_ change \catcode, \lccode, \uccode to avoid +% problems with other hyphenation pattern files, +% changed code to distinguish TeX 2.x/3.x, +% changed license conditions to LPPL (Bernd Raichle) +% +% +% For more information see the additional documentation +% at the end of this file. +% +% ----------------------------------------------------------------- +% +\message{German Traditional Hyphenation Patterns % + `dehypht' Version 3.2a <1999/03/03>} +\message{(Formerly known under the name `ghyph31' and `ghyphen'.)} +% +% +% Next we define some commands which are used inside the patterns. +% To keep them local, we enclose the rest of the file in a group +% (The \patterns command globally changes the hyphenation trie!). +% +\begingroup +% +% +% Make sure that doublequote is not active: +\catcode`\"=12 +% +% +% Because ^^e4 is used in the following macros which is read by +% TeX 2.x as ^^e or %, the comment character of TeX, some trick +% has to be found to avoid this problem. The same is true for the +% character ^^f or & in the TeX 2.x code. +% Therefore in the code the exclamationmark ! is used instead of +% the circumflex ^ and its \catcode is set appropriately +% (normally \catcode`\!=12, in the code \catcode`\!=7). +% +% The following \catcode, \lccode assignments and macro definitions +% are defined in such a way that the following \pattern{...} list +% can be used for both, TeX 2.x and TeX 3.x. +% +% We first change the \lccode of ^^Y to make sure that we can +% include this character in the hyphenation patterns. +% +\catcode`\^^Y=11 \lccode`\^^Y=`\^^Y +% +% Then we have to define some macros depending on the TeX version. +% Therefore we have to distinguish TeX version 2.x and 3.x: +% +\ifnum`\@=`\^^40 % true => TeX 3.x + % + % For TeX 3: + % ---------- + % + % Assign appropriate \catcode and \lccode values for all + % accented characters used in the patterns (\uccode changes are + % not used within \patterns{...} and thus not necessary): + % + \catcode"E4=11 \catcode"C4=11 % \"a \"A + \catcode"F6=11 \catcode"D6=11 % \"o \"O + \catcode"FC=11 \catcode"DC=11 % \"u \"U + \catcode"FF=11 \catcode"DF=11 % \ss SS + % + \lccode"C4="E4 \uccode"C4="C4 \lccode"E4="E4 \uccode"E4="C4 + \lccode"D6="F6 \uccode"D6="D6 \lccode"F6="F6 \uccode"F6="D6 + \lccode"DC="FC \uccode"DC="DC \lccode"FC="FC \uccode"FC="DC + \lccode"DF="FF \uccode"DF="DF \lccode"FF="FF \uccode"FF="DF + % + % In the following definitions we use ??xy instead of ^^xy + % to avoid errors when reading the following macro definitions + % with TeX 2.x (remember ^^e(4) is the comment character): + % + \catcode`\?=7 + % + % Define the accent macro " in such a way that it + % expands to single letters in font encoding T1. + \catcode`\"=13 + \def"#1{\ifx#1a??e4\else \ifx#1o??f6\else \ifx#1u??fc\else + \errmessage{Hyphenation pattern file corrupted!}% + \fi\fi\fi} + % + % - patterns with umlauts are ok + \def\n#1{#1} + % + % For \ss which exists in T1 _and_ OT1 encoded fonts but with + % different glyph codes, duplicated patterns for both encodings + % are included. Thus you can use these hyphenation patterns for + % T1 and OT1 encoded fonts: + % - define \3 to be code `\^^ff (\ss in font encoding T1) + % - define \9 to be code `\^^Y (\ss in font encoding OT1) + \def\3{??ff} + \def\9{??Y} + % - duplicated patterns to support font encoding OT1 are ok + \def\c#1{#1} + % >>>>>> UNCOMMENT the next line, if you do not want + % >>>>>> to use fonts in font encoding OT1 + %\def\c#1{} + % + \catcode`\?=12 + % +\else + % + % For TeX 2: + % ---------- + % + % Define the accent macro " to throw an error message. + \catcode`\"=13 + \def"#1{\errmessage{Hyphenation pattern file corrupted!}} + % + % - ignore all patterns with umlauts + \def\n#1{} + % + % With TeX 2 fonts in encoding T1 can be used, but all glyphs + % in positions > 127 can not be used in hyphenation patterns. + % Thus only patterns with glyphs in OT1 positions are included: + % - define \3 to be code ^^Y (\ss in CM font encoding) + % - define \9 to throw an error message + \def\3{^^Y} + \def\9{\errmessage{Hyphenation pattern file corrupted!}} + % - ignore all duplicated patterns with \ss in T1 encoding + \def\c#1{} + % +\fi +% +% +\patterns{% +.aa6l .ab3a4s .ab3ei .abi2 .ab3it .ab1l .ab1r .ab3u .ad3o4r .alti6 +.ana3c .an5alg .an1e .ang8s .an1s .ap1p .ar6sc .ar6ta .ar6tei .as2z +.au2f1 .au2s3 .be5erb .be3na .ber6t5r .bie6r5 .bim6s5t .brot3 .bru6s +.ch6 .che6f5 .da8c .da2r .dar5in .dar5u .den6ka .de5r6en .des6pe +.de8spo .de3sz .dia3s4 .dien4 .dy2s1 .ehren5 .eine6 .ei6n5eh .ei8nen +.ein5sa .en6der .en6d5r .en3k4 .en8ta8 .en8tei .en4t3r .epo1 .er6ban +.er6b5ei .er6bla .er6d5um .er3ei .er5er .er3in .er3o4b .erwi5s .es1p +.es8t .ex1a2 .ex3em .fal6sc .fe6st5a .flu4g3 .furch8 .ga6ner .ge3n4a +\n{.ge5r"o} .ges6 .halb5 .halbe6 .hal6br .haup4 .hau4t .heima6 .he4r3e +.her6za .he5x .hin3 .hir8sc .ho4c .hu3sa .hy5o .ibe5 .ima6ge .in1 +.ini6 .is5chi .jagd5 .kal6k5o .ka6ph .ki4e .kop6f3 .kraf6 \n{.k"u5ra} +.lab6br .liie6 .lo6s5k \n{.l"o4s3t} .ma5d .mi2t1 .no6th .no6top +.obe8ri .ob1l .obs2 .ob6st5e .or3c .ort6s5e .ost3a .oste8r .pe4re +.pe3ts .ph6 .po8str .rau4m3 .re5an .ro8q .ru5the \n{.r"u5be} +\n{.r"u8stet} .sch8 .se6e .se5n6h .se5ra .si2e .spi6ke .st4 .sy2n +.tages5 .tan6kl .ta8th .te6e .te8str .to6der .to8nin .to6we .um1 +.umpf4 .un1 .une6 .unge5n .ur1c .ur5en .ve6rin .vora8 .wah6l5 .we8ges +.wo6r .wor3a .wun4s .zi4e .zuch8 \n{."ande8re} \n{."och8} aa1c aa2gr +aal5e aa6r5a a5arti aa2s1t aat2s 6aba ab3art 1abdr 6abel aben6dr +ab5erk ab5err ab5esse 1abf 1abg \n{1abh"a} ab1ir 1abko a1bl ab1la +5ablag a6bla\3 \c{a6bla\9} ab4ler ab1lu \n{a8bl"a} \n{5a6bl"o} abma5c +1abn ab1ra ab1re 5a6brec ab1ro ab1s ab8sk abs2z 3abtei ab1ur 1abw +5abze 5abzu \n{ab1"an} \n{ab"au8} a4ce. a5chal ach5art ach5au a1che +a8chent ach6er. a6ch5erf a1chi ach1l ach3m ach5n a1cho ach3re a1chu +ach1w a1chy \n{ach5"af} ack1o acks6t ack5sta a1d 8ad. a6d5ac ad3ant +ad8ar 5addi a8dein ade5o8 adi5en 1adj 1adle ad1op a2dre 3adres adt1 +1adv \n{a6d"a} a1e2d ae1r a1er. 1aero 8afa a3fal af1an a5far a5fat +af1au a6fentl a2f1ex af1fr af5rau af1re 1afri af6tent af6tra aft5re +a6f5um \n{8af"a} ag5abe 5a4gent ag8er ages5e 1aggr ag5las ag1lo a1gn +ag2ne 1agog a6g5und a1ha a1he ah5ein a4h3erh a1hi ahl1a ah1le ah4m3ar +ahn1a a5ho ahra6 ahr5ab ah1re ah8rei ahren8s ahre4s3 ahr8ti ah1ru a1hu +\n{ah8"o} ai3d2s ai1e aif6 a3inse ai4re. a5isch. ais8e a3ismu ais6n +aiso6 a1j 1akad a4kade a1ke a1ki 1akko 5akro1 a5lal al5ans 3al8arm +al8beb al8berw alb5la 3album al1c a1le a6l5e6be a4l3ein a8lel a8lerb +a8lerh a6lert 5a6l5eth 1algi al4gli al3int al4lab al8lan al4l3ar +alle3g a1lo a4l5ob al6schm al4the altist5 al4t3re 8a1lu alu5i a6lur +alu3ta \n{a1l"a} a6mate 8ame. 5a6meise am6m5ei am6mum am2n ampf3a +am6schw am2ta a1mu \n{a1m"a} a3nac a1nad anadi5e an3ako an3alp 3analy +an3ame an3ara a1nas an5asti a1nat anat5s an8dent ande4s3 an1ec an5eis +an1e2k 4aner. a6n5erd a8nerf a6n5erke 1anfa 5anfert \n{1anf"a} 3angab +5angebo an3gli ang6lis an2gn 3angri ang5t6 \n{5anh"a} ani5g ani4ka +an5i8on an1kl an6kno an4kro 1anl anma5c anmar4 3annah anne4s3 a1no +5a6n1o2d 5a6n3oma 5a6nord 1anr an1sa 5anschl an4soz an1st 5anstal +an1s2z 5antenn an1th \n{5anw"a} a5ny an4z3ed 5anzeig 5anzieh 3anzug +\n{an1"a} \n{5an"as} \n{a1n"o} \n{an"o8d} a1os a1pa 3apfel a2ph1t +\n{aph5"a6} a1pi 8apl apo1c apo1s a6poste a6poth 1appa ap1pr a1pr +\n{a5p"a} \n{a3p"u} a1ra a4r3af ar3all 3arbei 2arbt ar1c 2a1re ar3ein +ar2gl 2a1ri ari5es ar8kers ar6les ar4nan ar5o6ch ar1o2d a1rol ar3ony +a8ror a3ros ar5ox ar6schl 8artei ar6t5ri a1ru a1ry 1arzt arz1w +\n{ar8z"a} \n{ar"a8m} \n{ar"o6} \n{ar5"om} \n{ar1"u2} a1sa a6schec +asch5l asch3m a6schn a3s4hi as1pa asp5l a8steb as5tev 1asth a6stoc +a1str ast3re 8a1ta ata5c ata3la a6tapf ata5pl a1te a6teli aten5a +ate5ran 6atf 6atg a1th at3hal 1athl 2a1ti 5atlant 3atlas 8atmus 6atn +a1to a6t5ops ato6ra a6t5ort. 4a1tr a6t5ru at2t1h \n{at5t6h"a} 6a1tu +atz1w \n{a1t"a} \n{a1t"u} au1a au6bre auch3a au1e aue4l 5aufent +\n{3auff"u} 3aufga 1aufn auf1t 3auftr 1aufw 3auge. au4kle aule8s 6aum +au8mar aum5p 1ausb 3ausd 1ausf 1ausg au8sin 3auss au4sta 1ausw 1ausz +aut5eng au1th 1auto au\3e8 \c{au\9e8} a1v ave5r6a aver6i a1w a6wes a1x +a2xia a6xio a1ya a1z azi5er. 8a\3 \c{8a\9} 1ba 8ba8del ba1la ba1na +ban6k5r ba5ot bardi6n ba1ro basten6 bau3sp 2b1b bb6le b2bli 2b1c 2b1d +1be be1a be8at. be1ch 8becht 8becke. be5el be1en bee8rei be5eta bef2 +8beff be1g2 \n{beh"o8} bei1s 6b5eisen bei3tr b8el bel8o belu3t be3nac +bend6o be6ners be6nerw be4nor ben4se6 bens5el \n{be1n"a} \n{be1n"u} +be1o2 b8er. be1ra be8rac ber8gab. ber1r \n{be1r"u} bes8c bes5erh +bes2p be5tha bet5sc be1un be1ur 8bex be6zwec 2b1f8 bfe6st5e 2b1g2 +bga2s5 bge1 2b1h bhole6 1bi bi1bl b6ie bi1el bi1la \n{bil"a5} bi1na +bi4nok bi5str bi6stu bi5tr bit4t5r b1j 2b1k2 \n{bk"u6} bl8 b6la. +6b1lad 6blag 8blam 1blat b8latt 3blau. b6lav 3ble. b1leb b1led +8b1leg 8b1leh 8bleid 8bleih 6b3lein blei3s ble4m3o 4blich b4lind +8bling b2lio 5blit b4litz b1loh 8b1los 1blu 5blum 2blun blut3a blut5sc +\n{3bl"a} \n{bl"as5c} \n{5bl"o} \n{3bl"u} \n{bl"u8sc} 2b1m 2b1n 1bo +bo1ch bo5d6s boe5 8boff 8bonk bo1ra b1ort 2b1p2 b1q 1br brail6 brast8 +bre4a b5red 8bref 8b5riem b6riga bro1s b1rup b2ruz \n{8br"oh} +\n{br"os5c} 8bs b1sa b8sang b2s1ar b1sc bs3erl bs3erz b8sof b1s2p +bst1h b3stru \n{b5st"a} b6sun 2b1t b2t1h 1bu bu1ie bul6k b8ure bu6sin +6b1v 2b1w 1by1 by6te. 8b1z bzi1s \n{1b"a} \n{b5"a6s5} \n{1b"u} +\n{b6"u5bere} \n{b"uge6} \n{b"ugel5e} \n{b"ur6sc} 1ca cag6 ca5la ca6re +ca5y c1c 1ce celi4c celich5 ce1ro c8h 2ch. 1chae ch1ah ch3akt cha6mer +8chanz 5chara 3chari 5chato 6chb 1chef 6chei ch3eil ch3eis 6cherkl +6chf 4chh 5chiad 5chias 6chins 8chj chl6 5chlor 6ch2m 2chn6 ch8nie +5cho. 8chob choi8d 6chp ch3ren ch6res \n{ch3r"u} 2chs 2cht cht5ha +cht3hi 5chthon ch6tin 6chuh chu4la 6ch3unt chut6t 8chw 1ci ci5tr c2k +2ck. ck1ei 4ckh ck3l ck3n ck5o8f ck1r 2cks ck5stra ck6s5u c2l 1c8o +con6ne 8corb cos6t c3q 1c6r 8c1t 1cu 1cy \n{5c"a1} \n{c"o5} 1da. +8daas 2dabg 8dabr 6dabt 6dabw 1dac da2gr 6d5alk 8d5amt dan6ce. +dani5er dan8ker 2danl danla6 6dans 8danzi 6danzu d1ap da2r1a8 2d1arb +d3arc dar6men 4d3art 8darz 1dat 8datm 2d1auf 2d1aus 2d1b 2d1c 2d1d +d5de d3d2h \n{dd"amme8} 1de 2deal de5an de3cha de1e defe6 6deff 2d1ehr +5d4eic de5isc de8lar del6s5e del6spr de4mag de8mun de8nep dene6r +8denge. 8dengen de5o6d 2deol de5ram 8derdb der5ein de1ro der1r d8ers +der5um de4s3am de4s3an de4sau de6sil de4sin de8sor de4spr de2su 8deul +de5us. 2d1f df2l 2d1g 2d1h 1di dia5c di5ara dice5 di3chr di5ena di1gn +di1la dil8s di1na 8dind 6dinf 4d3inh 2d1ins di5o6d di3p4t di8sen dis1p +di5s8per di6s5to dis5tra di8tan di8tin d1j 6dje 2dju 2d1k 2d1l 2d1m +2d1n6 dni6 dnje6 1do 6d5obe do6berf 6d5ony do3ran 6dord 2d1org dor4t3h +do6ste 6doth dott8e 2d1p d5q dr4 1drah 8drak d5rand 6dre. 4drech +d6reck 4d3reg 8d3reic d5reife 8drem 8d1ren 2drer 8dres. 6d5rh 1dria +d1ric 8drind droi6 dro5x 1dru 8drut \n{dr"os5c} \n{1dr"u} \n{dr"u5b} +\n{dr"u8sc} 2ds d1sa d6san dsat6 d1sc 5d6scha. 5dschik dse8e d8serg +8dsl d1sp d4spak ds2po \n{d8sp"a} d1st \n{d1s"u} 2dt d1ta d1te d1ti +d1to dt1s6 d1tu \n{d5t"a} 1du du5als du1b6 du1e duf4t3r 4d3uh du5ie +8duml 8dumw 2d1und du8ni 6d5unt dur2c durch3 6durl 6dursa 8durt du1s +du8schr 2d1v 2d1w dwa8l 2d1z \n{1d"a} \n{6d"ah} \n{8d"and} \n{d"a6r} +\n{d"o8bl} \n{d5"ol} \n{d"or6fl} \n{d"o8sc} \n{d5"o4st} \n{d"os3te} +\n{1d"u} ea4ben e1ac e1ah e1akt e1al. e5alf e1alg e5a8lin e1alk e1all +e5alp e1alt e5alw e1am e1and ea6nim e1ar. e5arf e1ark e5arm e3art +e5at. e6ate e6a5t6l e8ats e5att e6au. e1aus e1b e6b5am ebens5e +eb4lie eb4ser eb4s3in e1che e8cherz e1chi ech3m 8ech3n ech1r ech8send +ech4su e1chu eck5an e5cl e1d ee5a ee3e ee5g e1ei ee5isc eei4s3t +ee6lend e1ell \n{ee5l"o} e1erd ee3r4e ee8reng eere6s5 \n{ee5r"a} +ee6tat e1ex e1f e6fau e8fe8b 3effek ef3rom ege6ra eglo6si 1egy e1ha +e6h5ach eh5ans e6hap eh5auf e1he e1hi ehl3a eh1le ehl5ein eh1mu ehn5ec +e1ho ehr1a eh1re ehre6n eh1ri eh1ru ehr5um e1hu eh1w e1hy \n{e1h"a} +\n{e1h"o} \n{e3h"ut} ei1a eia6s ei6bar eich3a eich5r ei4dar ei6d5ei +ei8derf ei3d4sc ei1e 8eifen 3eifri 1eign eil1d ei6mab ei8mag ein1a4 +ei8nat ei8nerh ei8ness ei6nete ein1g e8ini ein1k ei6n5od ei8nok ei4nor +\n{e3ins"a} ei1o e1irr ei5ru ei8sab ei5schn ei6s5ent ei8sol ei4t3al +eit3ar eit1h ei6thi ei8tho eit8samt ei6t5um e1j 1ekd e1ke e1ki e1k2l +e1kn ekni4 e1la e2l1al 6elan e6lanf e8lanl e6l5ans el3arb el3arm +e6l3art 5e6lasti e6lauge elbst5a e1le 6elef ele6h e6l5ehe e8leif +e6l5einh 1elek e8lel 3eleme e6lemen e6lente el5epi e4l3err e6l5ersc +elf2l elg2 e6l5ins ell8er 4e1lo e4l3ofe el8soh el8tent 5eltern e1lu +elut2 \n{e1l"a} \n{e1l"u} em8dei em8meis 4emo emo5s 1emp1f 1empt 1emto +e1mu emurk4 emurks5 \n{e1m"a} en5a6ben en5achs en5ack e1nad en5af +en5all en3alt en1am en3an. en3ant en3anz en1a6p en1ar en1a6s 6e1nat +en3auf en3aus en2ce enda6l end5erf end5erg en8dess 4ene. en5eck +e8neff e6n5ehr e6n5eim en3eis 6enem. 6enen e4nent 4ener. e8nerd +e6n3erf e4nerg 5energi e6n5erla en5ers e6nerst en5erw 6enes e6n5ess +e2nex en3glo 2eni enni6s5 ennos4 enns8 e1no e6nober eno8f en5opf +e4n3ord en8sers ens8kl en1sp ens6por en5t6ag enta5go en8terbu en6tid +3entla ent5ric 5entwic 5entwu 1entz enu5i e3ny en8zan \n{en1"of} +\n{e1n"os} \n{e1n"ug} eo1c e5o6fe e5okk e1on. e3onf e5onk e5onl e5onr +e5opf e5ops e5or. e1ord e1org eo5r6h eo1t e1pa e8pee e6p5e6g ep5ent +e1p2f e1pi 5epid e6pidem e1pl 5epos e6pos. ep4p3a e1pr \n{e1p"a} e1q +e1ra. er5aal 8eraba e5rabel er5a6ben e5rabi er3abs er3ach era5e +era5k6l er3all er3amt e3rand e3rane er3ans e5ranz. e1rap er3arc +e3rari er3a6si e1rat erat3s er3auf e3raum 3erbse er1c e1re 4e5re. +er3eck er5egg er5e2h 2erei e3rei. e8reine er5einr 6eren. e4r3enm +4erer. e6r5erm er5ero er5erst e4r3erz er3ess \n{5erf"ul} er8gan. +5ergebn er2g5h \n{5erg"anz} \n{5erh"ohu} 2e1ri eri5ak e6r5iat e4r3ind +e6r5i6n5i6 er5ins e6r5int er5itio er1kl \n{3erkl"a} \n{5erl"os.} +ermen6s er6nab 3ernst 6e1ro. e1rod er1o2f e1rog 6e3roi ero8ide e3rol +e1rom e1ron e3rop8 e2r1or e1ros e1rot er5ox ersch4 5erstat er6t5ein +er2t1h er5t6her 2e1ru eruf4s3 e4r3uhr er3ums e5rus 5erwerb e1ry er5zwa +er3zwu \n{er"a8m} \n{er5"as} \n{er"o8} \n{e3r"os.} \n{e6r1"u2b} e1sa +esa8b e8sap e6s5a6v e1sc esch4l ese1a es5ebe eserve5 e8sh es5ill +es3int es4kop e2sl eso8b e1sp espei6s5 es2po es2pu 5essenz e6stabs +e6staf e6st5ak est3ar e8stob e1str est5res es3ur e2sz \n{e1s"u} e1ta +et8ag etari5e eta8ta e1te eten6te et5hal e5thel e1ti 1etn e1to e1tr +et3rec e8tscha et8se et6tei et2th et2t1r e1tu etu1s et8zent et8zw +\n{e1t"a} \n{e1t"o} \n{e1t"u} eu1a2 eu1e eue8rei eu5fe euin5 euk2 +e1um. eu6nio e5unter eu1o6 eu5p 3europ eu1sp eu5str eu8zo e1v eval6s +eve5r6en ever4i e1w e2wig ex1or 1exp 1extr ey3er. e1z \n{e1"a2} +\n{e5"o8} \n{e1"u} e8\3es \c{e8\9es} fa6ch5i fade8 fa6del fa5el. +fal6lo falt8e fa1na fan4gr 6fanl 6fap far6ba far4bl far6r5a 2f1art +fa1sc fau8str fa3y 2f1b2 6f1c 2f1d 1fe 2f1eck fe6dr feh6lei f6eim +8feins f5eis fel5en 8feltern 8femp fe5rant 4ferd. ferri8 fe8stof +fe6str fe6stum fe8tag fet6ta fex1 2ff f1fa f6f5arm f5fe ffe5in ffe6la +ffe8ler ff1f f1fla ff3lei ff4lie ff8sa ff6s5ta 2f1g2 fgewen6 4f1h 1fi +fid4 fi3ds fieb4 fi1la fi8lei fil4m5a f8in. fi1na 8finf fi8scho fi6u +6f1j 2f1k2 f8lanz fl8e 4f3lein 8flib 4fling f2lix 6f3lon 5flop 1flor +\n{5f8l"ac} \n{3fl"ot} 2f1m 2f1n 1fo foh1 f2on fo6na 2f1op fo5ra +for8mei for8str for8th for6t5r fo5ru 6f5otte 2f1p8 f1q fr6 f5ram +1f8ran f8ra\3 \c{f8ra\9} f8re. frei1 5frei. f3reic f3rest f1rib +8f1ric 6frig 1fris fro8na \n{fr"as5t} 2fs f1sc f2s1er f5str +\n{fs3t"at} 2ft f1tak f1te ft5e6h ftere6 ft1h f1ti f5to f1tr ft5rad +ft1sc ft2so f1tu ftwi3d4 ft1z 1fu 6f5ums 6funf fun4ka fu8\3end +\c{fu8\9end} 6f1v 2f1w 2f1z \n{1f"a} \n{f"a1c} \n{8f"arm} \n{6f"aug} +\n{f"a8\3} \n{\c{f"a8\9}} \n{f"ode3} \n{8f"of} \n{3f"or} \n{1f"u} +\n{f"un4f3u} 1ga ga6bl 6gabw 8gabz g3a4der ga8ho ga5isc 4gak ga1la +6g5amt ga1na gan5erb gan6g5a ga5nj 6ganl 8gansc 6garb 2g1arc 2g1arm +ga5ro 6g3arti ga8sa ga8sc ga6stre 2g1atm 6g5auf gau5fr g5aus 2g1b g5c +6gd g1da 1ge ge1a2 ge6an ge8at. ge1e2 ge6es gef2 8geff ge1g2l ge1im +4g3eise geist5r gel8bra gelt8s \n{ge5l"o} ge8nin gen3k 6g5entf +\n{ge3n"a} ge1or ge1ra ge6rab ger8au \n{8gerh"o} ger8ins ge1ro 6g5erz. +\n{ge1r"a} \n{ge1r"u} ge1s ges2p ge5unt 4g3ex3 2g1f8 2g1g g1ha 6g1hei +5ghel. g5henn 6g1hi g1ho 1ghr \n{g1h"o} 1gi gi5la gi8me. gi1na +4g3ins gi3str g1j 2g1k 8gl. 1glad g5lag glan4z3 1glas 6glass 5glaub +g3lauf 1gle. g5leb 3gleic g3lein 5gleis 1glem 2gler 8g3leu gli8a +g2lie 3glied 1g2lik 1g2lim g6lio 1gloa 5glom 1glon 1glop g1los g4loss +g5luf 1g2ly \n{1gl"u} 2g1m gn8 6gn. 1gna 8gnach 2gnah g1nas g8neu +g2nie g3nis 1gno 8gnot 1go goe1 8gof 2gog 5gogr 6g5oh goni5e 6gonist +go1ra 8gord 2g1p2 g1q 1gr4 g5rahm gra8m gra4s3t 6g1rec gre6ge 4g3reic +g5reit 8grenn gri4e g5riem 5grif 2grig g5ring 6groh 2grot gro6\3 +\c{gro6\9} 4grut 2gs gs1ab g5sah gs1ak gs1an gs8and gs1ar gs1au g1sc +gs1ef g5seil gs5ein g2s1er gs1in g2s1o gso2r gs1pr g2s1u 2g1t g3te +g2t1h 1gu gu5as gu2e 2gue. 6gued 4g3uh 8gums 6g5unt gu1s gut3h gu2tu +4g1v 2g1w gy1n g1z \n{1g"a} \n{8g"a8m} \n{6g"arm} \n{1g"o} \n{1g"u} +\n{6g"ub} 1haa hab8r ha8del hade4n 8hae ha5el. haf6tr 2hal. ha1la +hal4b5a 6hale 8han. ha1na han6dr han6ge. 2hani h5anth 6hanz 6harb +h3arbe h3arme ha5ro ha2t1h h1atm hau6san ha8\3 \c{ha8\9} h1b2 h1c h1d +he2bl he3cho h3echt he5d6s 5heft h5e6he. hei8ds h1eif 2hein he3ism +he5ist. heit8s3 hek6ta hel8lau 8helt he6mer 1hemm 6h1emp hen5end +hen5klo hen6tri he2nu 8heo he8q her3ab he5rak her3an 4herap her3au +h3erbi he1ro he8ro8b he4r3um her6z5er he4spe he1st heta6 het5am he5th +heu3sc he1xa hey5e h1f2 h1g hgol8 h1h h1iat hie6r5i hi5kt hil1a2 +hil4fr hi5nak hin4ta hi2nu hi5ob hirn5e hir6ner hi1sp hi1th hi5tr +5hitz h1j h6jo h1k2 hlabb4 hla4ga hla6gr h5lai hl8am h1las h1la\3 +\c{h1la\9} hl1c h1led h3lein h5ler. h2lif h2lim h8linf hl5int h2lip +h2lit h4lor h3lose \n{h1l"as} hme5e h2nee h2nei hn3eig h2nel hne8n +hne4p3f hn8erz h6netz h2nip h2nit h1nol hn5sp h2nuc h2nud h2nul hoch1 +1hoh hoh8lei 2hoi ho4l3ar 1holz h2on ho1ra 6horg 5horn. ho3sl hos1p +ho4spi h1p hpi6 h1q 6hr h1rai h8rank h5raum hr1c hrcre8 h1red h3reg +h8rei. h4r3erb h8rert hrg2 h1ric hr5ins h2rom hr6t5erl hr2t1h hr6t5ra +hr8tri h6rum hr1z hs3ach h6s5amt h1sc h6s5ec h6s5erl hs8erle h4sob +h1sp h8spa\3 \c{h8spa\9} h8spel hs6po h4spun h1str h4s3tum hs3und +\n{h1s"u} h5ta. h5tab ht3ac ht1ak ht3ang h5tanz ht1ar ht1at h5taub +h1te h2t1ec ht3eff ht3ehe h4t3eif h8teim h4t3ein ht3eis h6temp h8tentf +hte8ren \n{h6terf"u} h8tergr h4t3erh h6t5ersc h8terst h8tese h8tess +h2t1eu h4t3ex ht1he ht5hu h1ti ht5rak hts3ah ht1sc ht6sex ht8sk ht8so +h1tu htz8 \n{h5t"um} hub5l hu6b5r huh1l h5uhr. huld5a6 hu8lent +\n{hu8l"a} h5up. h1v h5weib h3weis h1z \n{h"a8kl} \n{h"al8s} +\n{h"ama8tu8} \n{h"a8sche.} \n{h"at1s} \n{h"au4s3c} \n{2h"o.} +\n{2h"oe} \n{8h"oi} \n{h"o6s} \n{h"os5c} \n{h"uhne6} \n{h"ul4s3t} +\n{h"utte8re} i5adn i1af i5ak. i1al. i1al1a i1alb i1ald i5alei i1alf +i1alg i3alh i1alk i1all i1alp i1alr i1als i1alt i1alv i5alw i3alz +i1an. ia5na i3and ian8e ia8ne8b i1ang i3ank i5ann i1ant i1anz i6apo +i1ar. ia6rab i5arr i1as. i1asm i1ass i5ast. i1at. i5ats i1au i5azz +i6b5eig i6b5eis ib2le i4blis i6brig i6b5unt \n{i6b"ub} i1che ich5ei +i6cherb i1chi ich5ins ich1l ich3m ich1n i1cho icht5an icht3r i1chu +ich1w ick6s5te ic5l i1d id3arm 3ideal ide8na 3ideol \n{ide5r"o} i6diot +id5rec id1t ie1a ie6b5ar iebe4s3 ie2bl ieb1r ie8bra ie4bre \n{ie8b"a} +ie2dr ie1e8 ie6f5ad ief5f ie2f1l ie4fro ief1t i1ei ie4l3ec ie8lei +ie4lek i3ell i1en. i1end ien6e i3enf i5enn ien6ne. i1enp i1enr +i5ensa ien8stal i5env i1enz ie5o ier3a4b ie4rap i2ere ie4rec ie6r5ein +ie6r5eis ier8er i3ern. ie8rum ie8rund ie6s5che ie6tau ie8tert ie5the +ie6t5ri i1ett ie5un iex5 2if i1fa if5ang i6fau if1fr if5lac i5f6lie +i1fre ift5a if6t5r ig3art 2ige i8gess ig5he i5gla ig2ni i5go ig3rot +ig3s2p i1ha i8ham i8hans i1he i1hi ih1n ih1r i1hu i8hum ih1w 8i1i ii2s +ii2t i1j i1k i6kak i8kerz i6kes ik4ler i6k5unt 2il i5lac i1lag il3ans +i5las i1lau il6auf i1le ile8h i8lel il2fl il3ipp il6l5enn i1lo ilt8e +i1lu \n{i1l"a} i8mart imb2 i8mele i8mid imme6l5a i1mu \n{i1m"a} +\n{i5m"o} ina5he i1nat in1au inau8s 8ind. in4d3an 5index ind2r 3indus +i5nec i2n1ei i8nerw 3infek 1info 5ingeni ing5s6o 5inhab ini5er. 5inj +\n{in8k"at} in8nan i1no inoi8d in3o4ku in5sau in1sp 5inspe 5instit +5instru ins4ze 5intere 5interv in3the in5t2r i5ny \n{in"a2} \n{i1n"ar} +\n{in1"as} \n{in"o8} \n{in5"od} \n{i1n"os} 2io io1a8 io1c iode4 io2di +ioi8 i1ol. i1om. i1on. i5onb ion2s1 i1ont i5ops i5o8pt i1or. +i3oral io3rat i5orc i1os. i1ot. i1o8x 2ip i1pa i1pi i1p2l i1pr i1q +i1ra ir6bl i1re i1ri ir8me8d ir2m1o2 ir8nak i1ro ir5rho ir6schl +ir6sch5r i5rus i5ry \n{i5r"a} i1sa i8samt i6sar i2s1au i8scheh i8schei +isch5m isch3r \n{isch"a8} is8ele ise3ra i4s3erh is3err isi6de i8sind +is4kop ison5e is6por i8s5tum i5sty \n{i5s"o} i1ta it5ab. i2t1a2m +i8tax i1te i8tersc i1thi i1tho i5thr \n{it8h"a} i1ti i8ti8d iti6kl +itmen4 i1to i8tof it3ran it3rau i1tri itri5o it1sc it2se it5spa it8tru +i1tu it6z5erg it6z1w \n{i1t"a} \n{it"a6r5e} \n{it"at2} \n{it"ats5} +\n{i1t"u} i1u iu6r 2i1v i6vad iva8tin i8vei i6v5ene i8verh i2vob i8vur +i1w iwi2 i5xa i1xe i1z ize8n i8zir i6z5w \n{i"a8m} \n{i1"a6r} +\n{i5"at.} \n{i5"av} \n{i1"o8} \n{i"u8} i6\35ers \c{i6\95ers} ja5la +je2t3r 6jm 5jo jo5as jo1ra jou6l ju5cha jugen4 jugend5 jung5s6 ju1s +\n{3j"a} 1ka 8kachs 8kakz ka1la kal5d kam5t ka1na 2kanl 8kapf ka6pl +ka5r6a 6k3arbe ka1ro kar6p5f 4k3arti 8karz \n{ka1r"a} kasi5e ka6teb +kat8ta kauf6s kau3t2 2k1b 2k1c 4k1d kehr6s kehrs5a 8keic 2k1eig 6k5ein +6k5eis ke6lar ke8leis ke8lo 8kemp k5ente. k3entf 8k5ents 6kentz ke1ra +k5erlau 2k1f8 2k1g 2k1h ki5fl 8kik king6s5 6kinh ki5os ki5sp ki5th +\n{8ki8"o} 2k1k2 kl8 1kla 8klac k5lager kle4br k3leib 3kleid kle5isc +4k3leit k3lek 6k5ler. 5klet 2klic 8klig k2lim k2lin 5klip 5klop k3lor +\n{1kl"a} 2k1m kmani5e kn8 6kner k2ni \n{kn"a8} 1k2o ko1a2 ko6de. +ko1i koi8t ko6min ko1op ko1or ko6pht ko3ra kor6d5er ko5ru ko5t6sc k3ou +3kow 6k5ox 2k1p2 k1q 1kr8 4k3rad 2k1rec 4k3reic kre5ie 2krib 6krig +2krip 6kroba 2ks k1sa k6sab ksal8s k8samt k6san k1sc k2s1ex k5spat +k5spe k8spil ks6por k1spr kst8 k2s1uf 2k1t kta8l kt5a6re k8tein kte8re +k2t1h k8tinf kt3rec kt1s 1ku ku1ch kuck8 k3uhr ku5ie kum2s1 kunfts5 +kun2s kunst3 ku8rau ku4ro kurz1 ku1st 4kusti ku1ta ku8\3 \c{ku8\9} +6k1v 2k1w ky5n 2k1z \n{1k"a} \n{k"a4m} \n{4k3"ami} \n{k"ase5} \n{1k"o} +\n{k"o1c} \n{k"o1s} \n{1k"u} \n{k"u1c} \n{k"ur6sc} \n{k"u1s} 1la. +8labf 8labh lab2r 2l1abs lach3r la8dr 5ladu 8ladv 6laff laf5t la2gn +5laken 8lamb la6mer 5lampe. 2l1amt la1na 1land lan4d3a lan4d3r lan4gr +8lanme 6lann 8lanw \n{6lan"a} 8lappa lap8pl lap6pr l8ar. la5ra lar4af +la8rag la8ran la6r5a6s l3arbe la8rei 6larm. la8sa la1sc la8sta lat8i +6l5atm 4lauss 4lauto 1law 2lb l8bab l8bauf l8bede l4b3ins l5blo +lbst5an lbst3e 8lc l1che l8chert l1chi lch3m l5cho lch5w 6ld l4d3ei +ld1re \n{l6d"ub} le2bl le8bre lecht6s5 led2r 6leff le4gas 1lehr lei6br +le8inf 8leinn 5leistu 4lektr le6l5ers lemo2 8lemp l8en. 8lends +6lendun le8nend len8erw 6l5ents 4l3entw 4lentz 8lenzy 8leoz 6lepi +le6pip 8lepo 1ler l6er. 8lerbs 6l5erde le8reis le8rend le4r3er 4l3erg +l8ergr 6lerkl 6l5erzie \n{8ler"o} 8lesel lesi5e le3sko le3tha let1s +5leuc 4leuro leu4s3t le5xe 6lexp l1f 2l1g lgend8 l8gh lglie3 lglied6 +6l1h 1li li1ar li1as 2lick li8dr li1en lien6n li8ers li8ert 2lie\3 +\c{2lie\9} 3lig li8ga8b li1g6n li1l8a 8limb li1na 4l3indu lings5 +4l3inh 6linj link4s3 4linkt 2lint 8linv lion5s6t 4lipp 5lipt 4lisam +livi5e 6l1j 6l1k l8keim l8kj lk2l lko8f lkor8 lk2sa lk2se 6ll l1la +ll3a4be l8labt ll8anl ll1b ll1c ll1d6 l1le l4l3eim l6l5eise ller3a +l4leti l5lip l1lo ll3ort ll5ov ll6spr llte8 l1lu ll3urg \n{l1l"a} +\n{l5l"u} \n{l6l"ub} 2l1m l6m5o6d 6ln l1na l1no 8lobl lo6br 3loch. +l5o4fen 5loge. 5lohn 4l3ohr 1lok l2on 4l3o4per lo1ra 2l1ord 6lorg +4lort lo1ru 1los. lo8sei 3losig lo6ve lowi5 6l1p lp2f l8pho l8pn +lp4s3te l2pt l1q 8l1r 2ls l1sa l6sarm l1sc l8sec l6s5erg l4s3ers l8sh +l5s6la l1sp ls4por ls2pu l1str l8suni \n{l1s"u} 2l1t lt5amp l4t3ein +l5ten l6t5eng l6t5erp l4t3hei lt3her l2t1ho l6t5i6b lti1l \n{l8tr"o} +lt1sc lt6ser lt4s3o lt5ums lu8br lu2dr lu1en8 8lu8fe luft3a luf8tr +lu6g5r 2luh l1uhr lu5it 5luk 2l1umf 2l1umw 1lun 6l5u6nio 4l3unte lu5ol +4lurg 6lurs l3urt lu4sto lu3str lu6st5re lu8su lu6tal lu6t5e6g lu8terg +lu3the lu6t5or lu2t1r lu6\35 \c{lu6\95} l1v lve5r6u 2l1w 1ly lya6 +6lymp ly1no l8zess l8zo8f l3zwei lz5wu \n{3l"and} \n{l"a5on} +\n{l"a6sc} \n{l"at1s} \n{5l"auf} \n{2l"aug} \n{l"au6s5c} \n{l"a5v} +\n{l1"ol} \n{1l"os} \n{l"o1\36t} \n{\c{l"o1\96t}} \n{6l1"ube} 1ma +8mabg ma5chan mad2 ma5el 4magg mag8n ma1la ma8lau mal5d 8malde mali5e +malu8 ma8lut 2m1amp 3man mand2 man3ds 8mangr mani5o 8m5anst 6mappa +4m3arbe mar8kr ma1r4o mar8schm 3mas ma1sc \n{ma1t"o} 4m5auf ma5yo 2m1b +mb6r 2m1c 2m1d \n{md6s"a} 1me me1ch me5isc 5meld mel8sa 8memp me5nal +men4dr men8schl men8schw 8mentsp me1ra mer4gl me1ro 3mes me6s5ei me1th +me8\3 \c{me8\9} 2m1f6 2m1g 2m1h 1mi mi1a mi6ale mi1la 2m1imm mi1na +\n{mi5n"u} mi4s3an mit1h mi5t6ra 3mitt mitta8 mi6\35 \c{mi6\95} 6mj +2m1k8 2m1l 2m1m m6mad m6m5ak m8menth m8mentw mme6ra m2mn mm5sp mm5ums +mmut5s \n{m8m"an} m1n8 m5ni 1mo mo5ar mo4dr 8mof mo8gal mo4kla mol5d +m2on mon8do mo4n3od mont8a 6m5ony mopa6 mo1ra mor8d5a mo1sc mo1sp 5mot +moy5 2mp m1pa mpfa6 mpf3l mphe6 m1pi mpin6 m1pl mp2li m2plu mpo8ste +m1pr \n{mpr"a5} mp8th mput6 mpu5ts \n{m1p"o} 8m1q 2m1r 2ms ms5au m1sc +msch4l ms6po m3spri m1str 2m1t mt1ar m8tein m2t1h mt6se \n{mt8s"a} +mu5e 6m5uh mumi1 1mun mun6dr muse5e mu1ta 2m1v mvol2 mvoll3 2m1w 1my +2m1z \n{m"a6kl} \n{1m"an} \n{m"a1s} \n{m"a5tr} \n{m"au4s3c} \n{3m"a\3} +\n{\c{3m"a\9}} \n{m"ob2} \n{6m"ol} \n{1m"u} \n{5m"un} \n{3m"ut} 1na. +n5ab. 8nabn n1abs n1abz \n{na6b"a} na2c nach3e 3nacht 1nae na5el +n1afr 1nag 1n2ah na8ha na8ho 1nai 6nair na4kol n1akt nal1a 8naly 1nama +na4mer na1mn n1amp 8n1amt 5nanc nan6ce n1and n6and. 2n1ang 1nani +1nann n1ans 8nanw 5napf. 1n2ar. na2ra 2n1arc n8ard 1nari n8ark +6n1arm 5n6ars 2n1art n8arv 6natm nat6s5e 1naue 4nauf n3aug 5naui n5auk +na5um 6nausb 6nauto 1nav 2nax 3naz 1na\3 \c{1na\9} n1b2 nbau5s n1c +nche5e nch5m 2n1d nda8d n2d1ak nd5ans n2d1ei nde8lac ndel6sa n8derhi +nde4se nde8stal n2dj ndnis5 n6d5or6t nd3rec nd3rot nd8samt nd6sau +ndt1h n8dumd 1ne ne5as ne2bl 6n5ebn 2nec 5neei ne5en ne1g4l 2negy +4n1ein 8neis 4n3e4lem 8nemb 2n1emp nen1a 6n5energ nen3k 8nentb +4n3en3th 8nentl 8n5entn 8n5ents ne1ra ne5r8al ne8ras 8nerbi 6n5erde. +nere5i6d nerfor6 \n{6n5erh"o} \n{8nerl"o} 2n1err n8ers. 6n5ertra +2n1erz nesi3e net1h neu4ra neu5sc 8neu\3 \c{8neu\9} n1f nf5f nf2l +nflei8 nf5lin nft8st n8g5ac ng5d ng8en nge8ram ngg2 ng1h n6glic ng3rip +ng8ru ng2se4 ng2si n2g1um n1gy \n{n8g"al} n1h nhe6r5e 1ni ni1bl +\n{ni5ch"a} ni8dee n6ie ni1en nie6s5te niet5h ni8etn 4n3i6gel n6ik +ni1la 2n1imp ni5na 2n1ind 8ninf 6n5inh ni8nit 6n5inn 2n1ins 4n1int +n6is ni3str ni1th ni1tr n1j n6ji n8kad nk5ans n1ke n8kerla n1ki nk5inh +\n{n5kl"o} n1k2n n8k5not nk3rot \n{n8kr"u} nk5spo nk6t5r n8kuh +\n{n6k"ub} n5l6 nli4mi n1m nmen4s n1na n8nerg nni5o n1no nn4t3ak nnt1h +nnu1e n1ny \n{n1n"a} \n{n1n"o} \n{n1n"u} no5a no4b3la 4n3obs 2nobt +noche8 no6die no4dis no8ia no5isc 6n5o6leu no4mal noni6er 2n1onk n1ony +4n3o4per 6nopf 6nopti no3ra no4ram nor6da 4n1org 2n1ort n6os no1st +8nost. no8tan no8ter noty6pe 6n5ox n1p2 n1q n1r \n{nr"os3} 6ns n1sac +ns3ang n1sc n8self n8s5erf n8serg n6serk ns5erw n8sint n1s2pe n1spr +n6s5tat. n5s6te. n6stob n1str n1ta n4t3a4go nt5anh nt3ark nt3art +n1te nt3eis nte5n6ar nte8nei nter3a nte6rei nt1ha nt6har n3ther nt5hie +n3thus n1ti nti1c n8tinh nti1t ntlo6b ntmen8 n1to nt3o4ti n1tr ntra5f +ntra5ut nt8rea nt3rec nt8rep n4t3rin nt8rop n4t3rot \n{n4tr"u} nt1s +nts6an nt2sk n1tu nt1z \n{n1t"a} \n{n1t"o} \n{n8t"ol} \n{n1t"u} 1nu +nu1a nu5el nu5en 4n1uhr nu5ie 8numl 6n5ums 6n5umw 2n1und 6nuni 6n5unr +2n1unt 2nup 2nu6r n5uri nu3skr nu5ta n1v 8n1w 1nys n1za n6zab n2z1ar +n6zaus nzi4ga n8zof n6z5unt n1zw n6zwir \n{1n"ac} \n{5n"ae} \n{5n"ai} +\n{n8"al} \n{n"a6m} \n{n"a6re} \n{n5"arz} \n{5n"aus} \n{n1"ol} +\n{1n"ot} \n{n5"oz} \n{5n"u.} \n{6n1"u2b} \n{5n"u\3} \n{\c{5n"u\9}} +o5ab. oa2l o8ala o1a2m o1an ob1ac obe4ra o6berh 5o4bers o4beru +obe6ser 1obj o1bl o2bli ob5sk 3obst. ob8sta obst5re ob5sz o1che +oche8b o8chec o3chi och1l och3m ocho8f o3chro och3to o3chu och1w o1d +o2d1ag od2dr ode5i ode6n5e od1tr o5e6b o5e6der. oe8du o1ef o1e2l +o1e2p o1er. o5e8x o1fa of8fan 1offi of8fin of6f5la o5fla o1fr 8o1g +og2n o1ha o1he o6h5eis o1hi ohl1a oh1le oh4l3er 5ohm. oh2ni o1ho +oh1re oh1ru o1hu oh1w o1hy \n{o1h"a} o5ia o1id. o8idi oi8dr o5ids +o5isch. oiset6 o1ism o3ist. o5i6tu o1j o1k ok2l ok3lau \n{o8kl"a} +1okta o1la old5am old5r o1le ole5in ole1r ole3u ol6gl ol2kl olk4s1 +ol8lak ol8lauf. ol6lel ol8less o1lo ol1s ol6sk o1lu oly1e2 5olym +o2mab om6an o8mau ombe4 o8merz om5sp o1mu o8munt \n{o1m"a} \n{o1m"o} +o1na ona8m on1ax on8ent o6n5erb 8oni oni5er. on1k on6n5a6b o1no ono1c +o4nokt 1ons onts8 \n{o1n"a} oo8f 1oog oo2pe oo2sa o1pa 3o4pera o3pfli +opf3lo opf3r o1pi o1pl o2pli o5p6n op8pa op6pl o1pr o3p4ter 1opti +\n{o1p"a} \n{o5p"o} o1q o1ra. o3rad o8radd 1oram o6rang o5ras o8rauf +or5cha or4d3a4m or8dei or8deu 1ordn or4dos o1re o5re. ore2h o8r5ein +ore5isc or6enn or8fla or8fli 1orga 5orgel. or2gl o1ri 5o6rient or8nan +\n{or8n"a} o1ro or1r2h or6t5an or8tau or8tere o1rus o1ry \n{o1r"a} +\n{or1"u2} o1sa osa3i 6ose o8serk o1sk o6ske o6ski os2kl os2ko os2kr +osni5e o2s1o2d o3s4per o4stam o6stau o3stra ost3re osu6 o6s5ur o5s6ze +o1ta ot3auf o6taus o1te o6terw o1th othe5u o2th1r o1ti o1to oto1a +ot1re o1tri o1tro ot1sc o3tsu ot6t5erg ot2t3h ot2t5r \n{ot8t"o} o1tu +ou3e ouf1 ou5f6l o5u6gr ou5ie ou6rar ou1t6a o1v o1wa o1we o6wer. o1wi +owid6 o1wo o5wu o1xe oy5al. oy1e oy1i o5yo o1z oza2r 1o2zea ozo3is +\n{o"o8} o\35elt \c{o\95elt} o\31t \c{o\91t} 3paa pa6ce 5pad pag2 1pak +pa1la pa8na8t pani5el pa4nor pan1s2 1pap pap8s pa8rei par8kr paro8n +par5o6ti part8e 5partei 3partn pas6sep pa4tha 1pau 6paug pau3sc p1b +8p5c 4p1d 1pe 4peic pe5isc 2pek pen3k pen8to8 p8er pe1ra pere6 per5ea +per5eb pe4rem 2perr per8ran 3pers 4persi \n{pe3r"u} pe4sta pet2s +p2f1ec p4fei pf1f pf2l 5pflanz pf8leg pf3lei 2pft pf3ta p1g 1ph 2ph. +2p1haf 6phb 8phd 6p5heit ph5eme 6phg phi6e 8phk 6phn p5holl pht2 +ph3tha 4ph3the phu6 6phz pi1en pi5err pi1la pi1na 5pinse pioni8e 1pis +pi1s2k pi1th p1k pl8 5pla p2lau 4plei p3lein 2pler 6p5les 2plig p6lik +6p5ling p2liz plo8min 6p1m p1n 1p2o 8poh 5pol po8lan poly1 po3ny po1ra +2porn por4t3h \n{po5r"o} 5poti p1pa p6p5ei ppe6la pp5f p2p1h p1pi pp1l +ppp6 pp5ren pp1s \n{p5p"o} pr6 3preis 1pres 2p3rig 5prinz 1prob 1prod +5prog pro8pt pro6t5a prote5i 8pro\3 \c{8pro\9} \n{pr"a3l} \n{1pr"as} +\n{pr"ate4} \n{1pr"uf} p5schl 2pst 1p2sy p1t p8to8d pt1s 5p6ty 1pu +pu1b2 2puc pu2dr puf8fr 6p5uh pun8s pu8rei pu5s6h pu1ta p1v p3w 5py +py5l p1z \n{p"a6der} \n{p5"a6m} \n{p"a8nu} \n{8p"ar} \n{p"at5h} +\n{p"at1s} qu6 1qui 8rabk ra6bla 3rable ra2br r1abt 6rabz ra4dan ra2dr +5rafal ra4f3er ra5gla ra2g3n 6raha ral5am 5rald 4ralg ra8lins 2rall +ral5t 8ramei r3anal r6and ran8der ran4dr 8ranf 6ranga 5rangi ran8gli +r3angr rans5pa 8ranw r8anz. ra5or 6rapf ra5pl rap6s5er 2r1arb 1rarh +r1arm ra5ro 2r1art 6r1arz ra8tei ra6t5he 6ratl ra4t3ro r5atta raue4n +6raus. r5austa rau8tel raut5s ray1 r1b rb5lass r6bler rb4lie rbon6n +r8brecht \n{rb6s5t"a} r8ces r1che rch1l rch3m rch3re rch3tr rch1w 8rd +r1da r8dachs r8dap rda5ro rde5ins rdio5 r8dir rd3ost r1dr r8drau 1re. +re1ak 3reakt re3als re6am. re1as 4reben re6bl rech5a r8edi re3er +8reff 3refl 2reh 5reha r4ei. reich6s5 8reier 6reign re5imp 4r3eina +6r3einb 6reing 6r5einn 6reinr 4r3eins r3eint reli3e 8r5elt 6rempf +2remt ren5a6b ren8gl r3enni 1reno 5rente 4r3enth 8rentl 4r3entw 8rentz +ren4zw re1on requi5 1rer rer4bl 6rerbs 4r3erd \n{8rerh"o} 8rerkl +4r3erla \n{8rerl"o} 4r3erns \n{6r5ern"a} rer5o 6r5erreg r5ertr r5erwec +\n{r5er"o} re2sa re8schm 2ress re5u8ni 6rewo 2r1ex r1f r8ferd rf4lie +8r1g r8gah rge4bl rge5na rgest4 rg6ne r2gni2 r8gob r4g3ret rg8sel r1h8 +r2hy 5rhyt ri1ar ri5cha rid2g r2ie rieg4s5 ri8ei ri1el ri6ele ri1en +ri3er. ri5ers. ri6fan ri8fer ri8fr 1r2ig ri8kn ri5la \n{rim"a8} +ri1na r8inde rin4ga rin6gr 1rinn 6rinner rino1 r8insp 4rinst +\n{ri1n"a} ri5o6ch ri1o2d ri3o6st 2r1ir r2is ri3sko ri8spr \n{ri8st"u} +ri5sv r2it 6r5i6tal ri5tr ri6ve. 8r1j 6rk r1ke rkehrs5 r1ki r3klin +r1k2n rk3str rk4t3an rk6to r6kuh \n{rk"a4s3t} r1l r5li rline5a 6r1m +r6manl rma4p r4m3aph r8minf r8mob rm5sa 2rn r1na rna8be r5ne rn2ei +r6neif r6nex r6nh rn1k r1no r6n5oc rn1sp \n{r1n"a} \n{r1n"u} ro6bern +6robs ro1ch 3rock. ro5de ro1e 4rofe ro8hert 1rohr ro5id ro1in ro5isc +6rolym r2on 6roog ro6phan r3ort ro1s2p ro5s6w ro4tau ro1tr ro6ts 5rout +r1p rpe8re rp2f r2ps r2pt r1q 2rr r1ra r1re rrer6 rr6hos \n{r5rh"o} +r1ri r1ro rro8f rr8or rror5a r1ru r3ry \n{r1r"a} \n{r1r"o} \n{r1r"u} +2r1s r6sab r4sanf rse6e rse5na r2sh r6ska r6ski rs2kl r8sko r2sl rs2p +r6stauf r8sterw r8stran rswi3d4 r2sz 2r1t rt3art r8taut r5tei rt5eige +r8tepe r4t3erh r8terla r4t3hei r5t6hu r4t3int rt5reif rt1sc rt6ser +rt6s5o rt6s5u rt5und r8turt rube6 ru1en 1r4uf ruf4st ru1ie 2r1umg +2r1uml 2rums run8der run4d5r 6rundz 6runf 8runs 2r1unt 2r1ur r6us +ru6sta ru3str ru6tr 1ruts r1v rven1 rvi2c r1w r1x r1za rz5ac r6z5al +r8z1ar r8zerd r6z5erf rz8erh rz4t3h r8zum \n{r"a4ste} \n{r"au8sc} +\n{r1"of} \n{5r"ohr} \n{r"o5le} \n{3r"oll} \n{5r"omis} \n{r1"or} +\n{r"o2sc} \n{3r"ump} 1sa. 1saa s3a4ben sa2bl 2s1abs 6s1abt 6sabw +3sack. 6s3a4der 1saf sa1fa 4s1aff sa5fr 1sag 1sai sa1i2k1 4s1akt 1sal +sa1la 4s3alpi 6salter salz3a 1sam s5anb san2c 1sand s5angeh 6sanl +2s1ans 6s3antr 8s1anw s1ap s6aph 8sapo sap5p6 s8ar. 2s1arb 3sarg +s1arm sa5ro 2s1art 6s1arz 1sas 1sat sat8a 2s1atl sa8tom 3s8aue s5auff +sau5i s6aur 2s1aus 5s6ause 2s1b2 2sca s4ce 8sch. 3scha. 5schade +3schaf 3schal sch5ame 8schanc 8schb 1sche 6schef 8schex 2schf 2schg +2schh 1schi 2schk 5schlag 5schlu \n{6schm"a\3} \n{\c{6schm"a\9}} +6schna\3 \c{6schna\9} 1scho 6schord 6schp 3schri 8schric 8schrig +8schrou 6schs 2scht sch3ta sch3tr 1schu 8schunt 6schv 2schz \n{5sch"o} +\n{5sch"u} 2sco scre6 6scu 2s1d 1se se5an se1ap se6ben se5ec see5i6g +se3erl 8seff se6han se8hi \n{se8h"o} 6s5eid. 2s1eig s8eil 5sein. +sei5n6e 6s5einh 3s8eit 3sel. se4lar selb4 6s3e4lem se8lerl 2s1emp +sen3ac se5nec 6s5ents 4sentz s8er. se8reim ser5inn \n{8serm"a} +8s5erzi \n{6ser"of} se1um 8sexa 6sexp 2s1f2 sfal8ler 2s3g2 sge5b2 s1h +s8hew 5s6hip 5s4hop 1si 2siat si1b sicht6s 6s5i6dee siege6s5 si1en +si5err si1f2 si1g2n si6g5r si8kau sik1i si4kin si2kl \n{si8k"u} si1la +sil6br si1na 2s1inf sin5gh 2s1inh sinne6s5 2s1ins si5ru si5str 4s1j +s1k2 6sk. 2skau skel6c skelch5 s6kele 1s2ki. 3s4kin. s6kiz s8kj +6skn 2skow 3skrib 3skrip 2sku \n{8sk"u} s1l s8lal slei3t s4low 2s1m +s1n 6sna 6snot 1so so1ch 2s1odo so4dor 6s5o4fen solo3 s2on so5of 4sope +so1ra 2s1ord 4sorga sou5c so3un 4s3ox sp2 8spaa 5spal 1span 2spap +s2pec s4peis 1spek s6perg 4spers s6pes 2s1pf 8sphi \n{1s2ph"a} 1spi +spi4e 6s5pig 6spinse 2spis 2spla 2spol 5s6pom 6s5pos 6spoti 1spra +3s8prec 6spreis 5spring 6sprob 1spru s2pul 1s2pur 6spy \n{5sp"an} +\n{1sp"u} s1q 2s1r 2s1s2 sse8nu ssini6s ssoi6r 2st. 1sta 4stafe 2stag +sta3la 6stale 4stalg 8stalk 8stamt 6st5anf 4stans 6stanw 6starb sta4te +6staus 2stb 6stc 6std 1ste 4steil 3s2tel st3elb 8stemb 6steppi 8stese +8stesse 6stf 2stg 2sth st1ha st3hei s8t1hi st1ho st5hu 1sti sti4el +4stigm sti3na 6stind 4stinf sti8r 2stk 2stl 2stm 1sto 6stoll. 4st3ope +6stopf. 6stord 6stp 5stra. 4strai 3s4tral 6s5traum 3stra\3 +\c{3stra\9} 3strec 6s3tref 8streib 5streif 6streno 6stres 6strev +5s6tria 6strig 5strik 8strisi 3s4troa s8troma st5rose 4struf 3strum +\n{6str"ag} 2st1s6 2stt 1stu stu5a 4stuc 2stue 8stun. 2stv 2stw s2tyl +6stz \n{1st"a} \n{8st"ag} \n{1st"o} \n{1st"u} \n{8st"uch} \n{4st"ur.} +1su su2b1 3suc su1e su2fe su8mar 6sumfa 8sumk 2s1unt sup1p2 6s5u6ran +6surte 2s1v 2s1w 1sy 8syl. sy5la syn1 sy2na syne4 s1z s4zend 5s6zene. +8szu \n{1s"a} \n{6s5"and} \n{6s"augi} \n{6s"au\3} \n{\c{6s"au\9}} +\n{5s"om} \n{2s1"u2b} \n{1s"uc} \n{s"u8di} \n{1s"un} \n{5s"u\3} +\n{\c{5s"u\9}} taats3 4tab. taba6k ta8ban tab2l ta6bre 4tabs t3absc +8tabz 6t3acht ta6der 6tadr tad6s tad2t 1tafe4 1tag ta6ga6 ta8gei +tage4s tag6s5t tah8 tahl3 tai6ne. ta5ir. tak8ta tal3au 1tale ta8leng +tal5ert 6t5a6mer 6tamp tampe6 2t1amt tan5d6a tan8dr tands5a tani5e +6tanl 2tanr t3ans 8t5antr tanu6 t5anw 8tanwa tan8zw ta8rau 6tarbe +1tari 2tark 2t1arm ta1ro 2tart t3arti 6tarz ta1sc ta6sien ta8stem +ta8sto t5aufb 4taufn 8taus. 5tause 8tausf 6tausg t5ausl 2t1b2 2t1c +t6chu 2t1d te2am tea4s te8ben 5techn 4teff te4g3re te6hau 2tehe te4hel +2t1ehr te5id. teig5l 6teign tei8gr 1teil 4teinh t5einhe 4teis t5eisen +8teiw te8lam te4lar 4telek 8telem te6man te6n5ag ten8erw ten5k tens4p +ten8tro 4t3entw 8tentz te6pli 5teppi ter5a6b te3ral ter5au 8terbar +t5erbe. 6terben 8terbs 4t3erbt t5erde. ter5ebe ter5ein te8rers terf4 +\n{8terh"o} \n{6terkl"a} ter8nor ter6re. t8erscha t5e6sel te8stau +t3euro te1xa tex3e 8texp tex6ta 2t1f2 2t1g2 2th. th6a 5tha. 2thaa +6t1hab 6t5haf t5hah 8thak 3thal. 6thals 6t3hand 2t1hau 1the. 3t4hea +t1heb t5heil t3heit t3helf 1theo 5therap 5therf 6t5herz 1thes 1thet +5thi. 2t1hil t3him 8thir 3this t5hj 2th1l 2th1m th1n t5hob t5hof +4tholz 6thopti 1thr6 4ths t1hum 1thy \n{4t1h"a} \n{2t1h"o} \n{t1h"u} +ti1a2m ti1b tie6fer ti1en ti8gerz tig3l ti8kin ti5lat 1tilg t1ind +tin4k3l ti3spa ti5str 5tite ti5tr ti8vel ti8vr 2t1j 2t1k2 2t1l tl8a +2t1m8 2t1n 3tobe 8tobj to3cha 5tocht 8tock tode4 to8del to8du to1e +6t5o6fen to1in toi6r 5toll. to8mene t2ons 2t1ony to4per 5topf. 6topt +to1ra to1s to6ska tos2l 2toti to1tr t8ou 2t1p2 6t1q tr6 tra5cha +tra8far traf5t 1trag tra6gl tra6gr t3rahm 1trai t6rans tra3sc tra6st +3traue t4re. 2trec t3rech t8reck 6t1red t8ree 4t1reg 3treib 4treif +8t3reis 8trepo tre6t5r t3rev 4t3rez 1trib t6rick tri6er 2trig t8rink +tri6o5d trizi5 tro1a 3troc trocke6 troi8d tro8man. tro3ny 5tropf +6t5rosa t5ro\3 \c{t5ro\9} 5trub 5trup trut5 \n{1tr"ag} \n{6t1r"oh} +\n{5tr"ub} \n{tr"u3bu} \n{t1r"uc} \n{t1r"us} 2ts ts1ab t1sac tsa8d +ts1ak t6s5alt ts1an ts1ar ts3auf t3schr \n{t5sch"a} tse6e tsee5i +tsein6s ts3ent ts1er t8serf t4serk t8sh 5t6sik t4s3int ts5ort. +t5s6por t6sprei t1st t6s5tanz ts1th t6stit t4s3tor 1t2sua t2s1uf +t8sum. t2s1u8n t2s1ur 2t1t tt5eif tte6sa tt1ha tt8ret tt1sc tt8ser +tt5s6z 1tuc tuch5a 1tu1e 6tuh t5uhr tu1i tu6it 1tumh 6t5umr 1tums +8tumt 6tund 6tunf 2t1unt tu5ra tu6rau tu6re. tu4r3er 2t1v 2t1w 1ty1 +ty6a ty8la 8tym 6ty6o 2tz tz5al tz1an tz1ar t8zec tzeh6 tzehn5 t6z5ei. +t6zor t4z3um \n{t6z"au} \n{5t"ag} \n{6t"ah} \n{t5"alt} \n{t8"an} +\n{t"are8} \n{8t"a8st} \n{6t"au\3} \n{\c{6t"au\9}} \n{t5"offen} +\n{8t"o8k} \n{1t"on} \n{4t"ub} \n{t6"u5ber.} \n{5t"uch} \n{1t"ur.} +u3al. u5alb u5alf u3alh u5alk u3alp u3an. ua5na u3and u5ans u5ar. +ua6th u1au ua1y u2bab ubi5er. u6b5rit ubs2k \n{u5b"o} \n{u8b"ub} 2uc +u1che u6ch5ec u1chi uch1l uch3m uch5n uch1r uch5to ucht5re u1chu uch1w +uck1a uck5in u1d ud4a u1ei u6ela uene8 u6ep u1er uer1a ue8rerl uer5o +u8esc u2est u8ev u1fa u2f1ei u4f3ent u8ferh uf1fr uf1l uf1ra uf1re +\n{uf1r"a} \n{uf1r"u} uf1s2p uf1st uft1s u8gabt u8gad u6gap ugeb8 u8gn +ugo3s4 u1ha u1he u1hi uh1le u1ho uh1re u1hu uh1w \n{u1h"a} \n{u1h"o} +6ui ui5en u1ig u3ins uin8tes u5isch. u1j 6uk u1ke u1ki u1kl u8klu +u1k6n u5ky u1la uld8se u1le ul8lac ul6lau ul6le6l ul6lo ulni8 u1lo +ulo6i ult6a ult8e u1lu ul2vr \n{u1l"a} \n{u1l"o} 3umfan 5umlau umo8f +um8pho u1mu umu8s \n{u5m"o} u1n1a un2al un6at unau2 6und. 5undein +un4d3um 3undzw \n{und"u8} \n{un8d"ub} une2b un1ec une2h un3eis 3unfal +\n{1unf"a} 5ungea \n{3ungl"u} ung2s1 \n{un8g"a} 1u2nif un4it un8kro +unk5s u1no unpa2 uns2p unvol4 unvoll5 u5os. u1pa u1pi u1p2l u1pr +up4s3t up2t1a u1q u1ra ur5abs ura8d ur5ah u6rak ur3alt u6rana u6r5ans +u8rap ur5a6ri u8ratt u1re ur3eig ur8gri u1ri ur5ins 3urlau urmen6 +ur8nan u1ro 3ursac ur8sau ur8sei ur4sk 3urtei u1ru uru5i6 uru6r u1ry +ur2za \n{ur6z"a} \n{ur5"a6m} \n{u5r"o} \n{u1r"u} \n{ur"uck3} u1sa +usa4gi u2s1ar u2s1au u8schec usch5wi u2s1ei use8kel u8sl u4st3a4b +us3tau u3s4ter u2s1uf u8surn ut1ac u1tal uta8m u1tan ut1ar u1tas ut1au +u1te u8teic u4tent u8terf u6terin u4t3hei ut5ho ut1hu u1ti utine5 +uti6q u1to uto5c u1tr ut1sa ut1s6p ut6stro u1tu utz5w u1u u1v uve5n +\n{uve3r4"a} u1w u1xe u5ya uy5e6 u1yi u2z1eh u8zerh \n{u5"o} u\3e6n +\c{u\9e6n} u\3en5e \c{u\9en5e} 8vanb 6vang 6varb var8d va6t5a va8tei +va2t1r 2v1b 6v5c 6vd 1ve 6ve5g6 ver1 ver5b verb8l ve2re2 verg8 ve2ru8 +ve1s ve2s3p ve3xe 2v1f 2v1g 6v5h vi6el vie6w5 vi1g4 vi8leh vil6le. +8vint vi1ru vi1tr 2v1k 2v1l 2v1m 4v5n 8vo8f voi6le vol8lend vol8li +v2or1 vo2re vo8rin vo2ro 2v1p 8vra v6re 2v1s 2v1t 2v1v 4v3w 2v1z +waffe8 wa6g5n 1wah wah8n wa5la wal8din wal6ta wan4dr 5ware wa8ru +war4za 1was w5c w1d 5wech we6fl 1weg we8geng weg5h weg3l we2g1r +weh6r5er 5weise weit3r wel2t welt3r we6rat 8werc 5werdu wer4fl 5werk. +wer4ka wer8ku wer4ta wer8term we2sp we8stend we6steu we8str +\n{we8st"o} wet8ta wich6s5t 1wid wi2dr wiede4 wieder5 wik6 wim6ma +win4d3r 5wirt wisch5l 1wj 6wk 2w1l 8w1n wo1c woche6 wol6f wor6t5r 6ws2 +w1sk 6w5t 5wunde. wun6gr wu1sc wu2t1 6w5w wy5a \n{w"arme5} \n{w"a1sc} +1xag x1ak x3a4men 8xamt x1an 8x1b x1c 1xe. x3e4g 1xen xe1ro x1erz +1xes 8xf x1g 8x1h 1xi 8xid xi8so 4xiste x1k 6x1l x1m 8xn 1xo 8x5o6d +8x3p2 x1r x1s6 8x1t x6tak x8terf x2t1h 1xu xu1e x5ul 6x3w x1z 5ya. +y5an. y5ank y1b y1c y6cha y4chia y1d yen6n y5ern y1g y5h y5in y1j +y1k2 y1lak yl1al yla8m y5lax y1le y1lo y5lu y8mn ym1p2 y3mu y1na yno2d +yn1t y1on. y1o4p y5ou ypo1 y1pr y8ps y1r yri3e yr1r2 y1s ys5iat ys8ty +y1t y3w y1z \n{y"a8m} z5a6b zab5l 8za6d 1zah za5is 4z3ak 6z1am 5zange. +8zanl 2z1ara 6z5as z5auf 3zaun 2z1b 6z1c 6z1d 1ze ze4dik 4z3eff 8zein +zei4ta zei8ters ze6la ze8lec zel8th 4zemp 6z5engel zen8zin \n{8zerg"a} +zer8i ze1ro zers8 zerta8 zer8tab zer8tag 8zerz ze8ste zeu6gr 2z1ex +2z1f8 z1g 4z1h 1zi zi1en zi5es. 4z3imp zi1na 6z5inf 6z5inni zin6s5er +8zinsuf zist5r zi5th zi1tr 6z1j 2z1k 2z1l 2z1m 6z1n 1zo zo6gl 4z3oh +zo1on zor6na8 4z1p z5q 6z1r 2z1s8 2z1t z4t3end z4t3hei z8thi 1zu zu3al +zu1b4 zu1f2 6z5uhr zun2a 8zunem zunf8 8zungl zu1o zup8fi zu1s8 zu1z +2z1v zw8 z1wal 5zweck zwei3s z1wel z1wer z6werg 8z5wes 1zwi zwi1s +6z1wo 1zy 2z1z zz8a zzi1s \n{1z"a} \n{1z"o} \n{6z"ol.} \n{z"o1le} +\n{1z"u} \n{2z1"u2b} \n{"a1a6} \n{"ab1l} \n{"a1che} \n{"a3chi} +\n{"ach8sc} \n{"ach8sp} \n{"a5chu} \n{"ack5a} \n{"ad1a} \n{"ad5era} +\n{"a6d5ia} \n{"a1e} \n{"a5fa} \n{"af1l} \n{"aft6s} \n{"ag1h} +\n{"ag3le} \n{"a6g5nan} \n{"ag5str} \n{"a1he} \n{"a1hi} \n{"ah1le} +\n{"ah5ne} \n{1"ahnl} \n{"ah1re} \n{"ah5ri} \n{"ah1ru} \n{"a1hu} +\n{"ah1w} \n{6"ai} \n{"a1isc} \n{"a6ische} \n{"a5ism} \n{"a5j} +\n{"a1k} \n{"al1c} \n{"a1le} \n{"a8lei} \n{"al6schl} \n{"ami1e} +\n{"am8n} \n{"am8s} \n{"a5na} \n{5"anderu} \n{"ane5i8} \n{"ang3l} +\n{"ank5l} \n{"a1no} \n{"an6s5c} \n{"a1pa} \n{"ap6s5c} \n{3"aq} +\n{"ar1c} \n{"a1re} \n{"are8m} \n{5"argern} \n{"ar6gl} \n{"a1ri} +\n{3"armel} \n{"a1ro} \n{"art6s5} \n{"a1ru} \n{3"arztl} \n{"a5r"o} +\n{"a6s5chen} \n{"asen8s} \n{"as1th} \n{"ata8b} \n{"a1te} \n{"ateri4} +\n{"ater5it} \n{"a6thy} \n{"a1ti} \n{3"atk} \n{"a1to} \n{"at8schl} +\n{"ats1p} \n{"a5tu} \n{"aub1l} \n{"au1e} \n{1"aug} \n{"au8ga} +\n{"au5i} \n{"a1um.} \n{"a1us.} \n{1"au\3} \n{\c{1"au\9}} \n{"a1z} +\n{"o1b} \n{"o1che} \n{"o5chi} \n{"och8stei} \n{"och8str} \n{"ocht6} +\n{5"o6dem} \n{5"offn} \n{"o1he} \n{"oh1l8} \n{"oh1re} \n{"o1hu} +\n{"o1is} \n{"o1ke} \n{1"o2ko} \n{1"ol.} \n{"ol6k5l} \n{"ol8pl} +\n{"o1mu} \n{"o5na} \n{"onig6s3} \n{"o1no} \n{"o5o6t} \n{"opf3l} +\n{"op6s5c} \n{"o1re} \n{"or8gli} \n{"o1ri} \n{"or8tr} \n{"o1ru} +\n{5"osterr} \n{"o1te} \n{"o5th} \n{"o1ti} \n{"o1tu} \n{"o1v} \n{"o1w} +\n{"owe8} \n{"o2z} \n{"ub6e2} \n{3"u4ber1} \n{"ub1l} \n{"ub1r} +\n{5"u2bu} \n{"u1che} \n{"u1chi} \n{"u8ch3l} \n{"uch6s5c} \n{"u8ck} +\n{"uck1a} \n{"uck5ers} \n{"ud1a2} \n{"u6deu} \n{"udi8t} \n{"u2d1o4} +\n{"ud5s6} \n{"uge4l5a} \n{"ug1l} \n{"uh5a} \n{"u1he} \n{"u8heh} +\n{"u6h5erk} \n{"uh1le} \n{"uh1re} \n{"uh1ru} \n{"u1hu} \n{"uh1w} +\n{"u3k} \n{"u1le} \n{"ul4l5a} \n{"ul8lo} \n{"ul4ps} \n{"ul6s5c} +\n{"u1lu} \n{"un8da} \n{"un8fei} \n{"unk5l} \n{"un8za} \n{"un6zw} +\n{"u5pi} \n{"u1re} \n{"u8rei} \n{"ur8fl} \n{"ur8fr} \n{"ur8geng} +\n{"u1ri} \n{"u1ro} \n{"ur8sta} \n{"ur8ster} \n{"u1ru} \n{"use8n} +\n{"u8sta} \n{"u8stes} \n{"u6s5tete} \n{"u3ta} \n{"u1te} \n{"u1ti} +\n{"ut8tr} \n{"u1tu} \n{"ut8zei} \n{"u1v} \31a8 \c{\91a8} 5\3a. +\c{5\9a.} \38as \c{\98as} \31b8 \c{\91b8} \31c \c{\91c} \31d \c{\91d} +1\3e \c{1\9e} \35ec \c{\95ec} 8\3e8g \c{8\9e8g} 8\3e8h \c{8\9e8h} +2\31ei \c{2\91ei} 8\3em \c{8\9em} \31f8 \c{\91f8} \31g \c{\91g} \31h +\c{\91h} 1\3i \c{1\9i} \31k \c{\91k} \31l \c{\91l} \31m \c{\91m} +\3mana8 \c{\9mana8} \31n \c{\91n} \31o \c{\91o} \31p8 \c{\91p8} \35q +\c{\95q} \31r \c{\91r} \31s2 \c{\91s2} \3st8 \c{\9st8} \31ta \c{\91ta} +\31te \c{\91te} \3t3hei \c{\9t3hei} \31ti \c{\91ti} \35to \c{\95to} +\31tr \c{\91tr} 1\3u8 \c{1\9u8} 6\35um \c{6\95um} \31v \c{\91v} \31w +\c{\91w} \31z \c{\91z} +}% +\endgroup +\relax\endinput +% +% ----------------------------------------------------------------- +% +% =============== Additional Documentation =============== +% +% +% Older Versions of German Hyphenation Patterns: +% ---------------------------------------------- +% +% All older versions of `ghyphen.tex' distributed as +% +% ghyphen.tex/germhyph.tex as of 1986/11/01 +% ghyphen.min/ghyphen.max as of 1988/10/10 +% ghyphen3.tex as of 1990/09/27 & 1991/02/13 +% ghyph31.tex as of 1994/02/13 +% +% are out of date and it is recommended to replace them +% with the new version `dehypht.tex' as of 1999/03/03. +% +% If you are using `ghyphen.min' (a minor version of `ghyphen') +% because of limited trie memory space, try this version and if +% the space is exceeded get a newer TeX implementation with +% larger or configurable trie memory sizes. +% +% +% +% Trie Memory Requirements/Space for Hyphenation Patterns: +% -------------------------------------------------------- +% +% To load this set of german hyphenation patterns the parameters +% of TeX has to have at least these values: +% +% TeX 3.x: +% IniTeX: trie_size >= 9733 trie_op_size >= 207 +% VirTeX: trie_size >= 8375 trie_op_size >= 207 +% +% TeX 2.x: +% IniTeX: trie_size >= 8675 trie_op_size >= 198 +% VirTeX: trie_size >= 7560 trie_op_size >= 198 +% +% If you want to load more than one set of hyphenation patterns +% (in TeX 3.x), the parameters have to be set to a value larger +% than or equal to the sum of all required values for each set. +% +% +% Setting Trie Memory Parameters: +% ------------------------------- +% +% Some implementations allow the user to change the default value +% of a set of the internal TeX parameters including the trie memory +% size parameter specifying the used memory for the hyphenation +% patterns. +% +% Web2c 7.x (Source), teTeX 0.9 (Unix, Amiga), fpTeX (Win32) +% and newer: +% The used memory size of the true is usually set high enough. +% If needed set the size of the trie using the keyword `trie_size' +% in the configuration file `texmf/web2c/texmf.cnf'. For details +% see the included documentation. +% +% emTeX (OS/2, MS-DOS, Windows 3.x/9x/NT): +% You can set the used memory size of the trie using the +% `-mt' option on the command line or in the +% TEXOPTIONS environment variable. +% +% PasTeX (Amiga): +% The values for the parameters can be set using the keywords +% `triesize', `itriesize' and `trieopsize' in the configuration +% file. +% +% others (binaries only): +% See the documentation of the implementation if it is possible +% and how to change these values without recompilation. +% +% others (with sources) +% If the trie memory is too small, you have to recompile TeX +% using larger values for `trie_size' and `trie_op_size'. +% Modify the change file `tex.ch' and recompile TeX. +% For details see the documentation included in the sources. +% +% +% +% Necessary Settings in TeX macro files: +% -------------------------------------- +% +% \lefthyphenmin, \righthyphenmin: +% You can set both parameters to 2. +% +% \lccode : +% To get correct hyphenation points within words containing +% umlauts or \ss, it's necessary to assign values > 0 to the +% appropriate \lccode positions. +% +% These changes are _not_ done when reading this file and have to +% be included in the language switching mechanism as is done in, +% for example, `german.sty' (\lccode change for ^^Y = \ss in OT1, +% \left-/\righthyphenmin settings). +% +% +%% \CharacterTable +%% {Upper-case \A\B\C\D\E\F\G\H\I\J\K\L\M\N\O\P\Q\R\S\T\U\V\W\X\Y\Z +%% Lower-case \a\b\c\d\e\f\g\h\i\j\k\l\m\n\o\p\q\r\s\t\u\v\w\x\y\z +%% Digits \0\1\2\3\4\5\6\7\8\9 +%% Exclamation \! Double quote \" Hash (number) \# +%% Dollar \$ Percent \% Ampersand \& +%% Acute accent \' Left paren \( Right paren \) +%% Asterisk \* Plus \+ Comma \, +%% Minus \- Point \. Solidus \/ +%% Colon \: Semicolon \; Less than \< +%% Equals \= Greater than \> Question mark \? +%% Commercial at \@ Left bracket \[ Backslash \\ +%% Right bracket \] Circumflex \^ Underscore \_ +%% Grave accent \` Left brace \{ Vertical bar \| +%% Right brace \} Tilde \~} +%% +\endinput +%% +%% End of file `dehypht.tex'. diff --git a/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/eshyph_vo.tex b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/eshyph_vo.tex new file mode 100644 index 0000000..e15bdc3 --- /dev/null +++ b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/eshyph_vo.tex @@ -0,0 +1,1104 @@ +.\'a2 +.\'aa2 +.\'ae2 +.\'ai2 +.\'ao2 +.\'au2 +.\'e2 +.\'ea2 +.\'ee2 +.\'ei2 +.\'eo2 +.\'eu2 +.\'i2 +.\'ia2 +.\'ie2 +.\'ii2 +.\'io2 +.\'iu2 +.\'o2 +.\'oa2 +.\'oe2 +.\'oi2 +.\'oo2 +.\'ou2 +.\'u2 +.\'ua2 +.\'ue2 +.\'ui2 +.\'uo2 +.\'uu2 +.a2 +.a\'a2 +.a\'e2 +.a\'i2 +.a\'o2 +.a\'u2 +.aa2 +.ae2 +.ai2 +.ao2 +.au2 +.e2 +.e\'a2 +.e\'e2 +.e\'i2 +.e\'o2 +.e\'u2 +.ea2 +.ee2 +.ei2 +.eo2 +.eu2 +.i2 +.i\'a2 +.i\'e2 +.i\'i2 +.i\'o2 +.i\'u2 +.ia2 +.ie2 +.ii2 +.io2 +.iu2 +.o2 +.o\'a2 +.o\'e2 +.o\'i2 +.o\'o2 +.o\'u2 +.oa2 +.oe2 +.oi2 +.oo2 +.ou2 +.u2 +.u\'a2 +.u\'e2 +.u\'i2 +.u\'o2 +.u\'u2 +.ua2 +.ue2 +.ui2 +.uo2 +.uu2 +2\'a. +2\'aa. +2\'ae. +2\'ai. +2\'ao. +2\'au. +2\'e. +2\'ea. +2\'ee. +2\'ei. +2\'eo. +2\'eu. +2\'i. +2\'ia. +2\'ie. +2\'ii. +2\'io. +2\'iu. +2\'o. +2\'oa. +2\'oe. +2\'oi. +2\'oo. +2\'ou. +2\'u. +2\'ua. +2\'ue. +2\'ui. +2\'uo. +2\'uu. +2\~n1\~n +2\~n1b +2\~n1c +2\~n1d +2\~n1f +2\~n1g +2\~n1h +2\~n1j +2\~n1k +2\~n1m +2\~n1n +2\~n1p +2\~n1q +2\~n1s +2\~n1t +2\~n1v +2\~n1w +2\~n1x +2\~n1y +2\~n1z +2a. +2a\'a. +2a\'e. +2a\'i. +2a\'o. +2a\'u. +2aa. +2ae. +2ai. +2ao. +2au. +2b1\~n +2b1b +2b1c +2b1d +2b1f +2b1g +2b1h +2b1j +2b1k +2b1m +2b1n +2b1p +2b1q +2b1s +2b1t +2b1v +2b1w +2b1x +2b1y +2b1z +2c1\~n +2c1b +2c1c +2c1d +2c1f +2c1g +2c1j +2c1k +2c1m +2c1n +2c1p +2c1q +2c1s +2c1t +2c1v +2c1w +2c1x +2c1y +2c1z +2d1\~n +2d1b +2d1c +2d1d +2d1f +2d1g +2d1h +2d1j +2d1k +2d1m +2d1n +2d1p +2d1q +2d1s +2d1t +2d1v +2d1w +2d1x +2d1y +2d1z +2e. +2e\'a. +2e\'e. +2e\'i. +2e\'o. +2e\'u. +2ea. +2ee. +2ei. +2eo. +2eu. +2f1\~n +2f1b +2f1c +2f1d +2f1f +2f1g +2f1h +2f1j +2f1k +2f1m +2f1n +2f1p +2f1q +2f1s +2f1t +2f1v +2f1w +2f1x +2f1y +2f1z +2g1\~n +2g1b +2g1c +2g1d +2g1f +2g1g +2g1h +2g1j +2g1k +2g1m +2g1n +2g1p +2g1q +2g1s +2g1t +2g1v +2g1w +2g1x +2g1y +2g1z +2h1\~n +2h1b +2h1c +2h1d +2h1f +2h1g +2h1h +2h1j +2h1k +2h1m +2h1n +2h1p +2h1q +2h1s +2h1t +2h1v +2h1w +2h1x +2h1y +2h1z +2i. +2i\'a. +2i\'e. +2i\'i. +2i\'o. +2i\'u. +2ia. +2ie. +2ii. +2io. +2iu. +2j1\~n +2j1b +2j1c +2j1d +2j1f +2j1g +2j1h +2j1j +2j1k +2j1m +2j1n +2j1p +2j1q +2j1s +2j1t +2j1v +2j1w +2j1x +2j1y +2j1z +2k1\~n +2k1b +2k1c +2k1d +2k1f +2k1g +2k1h +2k1j +2k1k +2k1m +2k1n +2k1p +2k1q +2k1s +2k1t +2k1v +2k1w +2k1x +2k1y +2k1z +2l1\~n +2l1b +2l1c +2l1d +2l1f +2l1g +2l1h +2l1j +2l1k +2l1m +2l1n +2l1p +2l1q +2l1s +2l1t +2l1v +2l1w +2l1x +2l1y +2l1z +2m1\~n +2m1b +2m1c +2m1d +2m1f +2m1g +2m1h +2m1j +2m1k +2m1l +2m1m +2m1n +2m1p +2m1q +2m1r +2m1s +2m1t +2m1v +2m1w +2m1x +2m1y +2m1z +2n1\~n +2n1b +2n1c +2n1d +2n1f +2n1g +2n1h +2n1j +2n1k +2n1l +2n1m +2n1n +2n1p +2n1q +2n1r +2n1s +2n1t +2n1v +2n1w +2n1x +2n1y +2n1z +2o. +2o\'a. +2o\'e. +2o\'i. +2o\'o. +2o\'u. +2oa. +2oe. +2oi. +2oo. +2ou. +2p1\~n +2p1b +2p1c +2p1d +2p1f +2p1g +2p1h +2p1j +2p1k +2p1m +2p1n +2p1p +2p1q +2p1s +2p1t +2p1v +2p1w +2p1x +2p1y +2p1z +2q1\~n +2q1b +2q1c +2q1d +2q1f +2q1g +2q1h +2q1j +2q1k +2q1m +2q1n +2q1p +2q1q +2q1s +2q1t +2q1v +2q1w +2q1x +2q1y +2q1z +2r1\~n +2r1b +2r1c +2r1d +2r1f +2r1g +2r1h +2r1j +2r1k +2r1m +2r1n +2r1p +2r1q +2r1s +2r1t +2r1v +2r1w +2r1x +2r1y +2r1z +2s1\~n +2s1b +2s1c +2s1d +2s1f +2s1g +2s1h +2s1j +2s1k +2s1m +2s1n +2s1p +2s1q +2s1s +2s1t +2s1v +2s1w +2s1x +2s1y +2s1z +2t1\~n +2t1b +2t1c +2t1d +2t1f +2t1g +2t1h +2t1j +2t1k +2t1m +2t1n +2t1p +2t1q +2t1s +2t1t +2t1v +2t1w +2t1x +2t1y +2t1z +2u. +2u\'a. +2u\'e. +2u\'i. +2u\'o. +2u\'u. +2ua. +2ue. +2ui. +2uo. +2uu. +2v1\~n +2v1b +2v1c +2v1d +2v1f +2v1g +2v1h +2v1j +2v1k +2v1m +2v1n +2v1p +2v1q +2v1s +2v1t +2v1v +2v1w +2v1x +2v1y +2v1z +2w1\~n +2w1b +2w1c +2w1d +2w1f +2w1g +2w1h +2w1j +2w1k +2w1m +2w1n +2w1p +2w1q +2w1s +2w1t +2w1v +2w1w +2w1x +2w1y +2w1z +2x1\~n +2x1b +2x1c +2x1d +2x1f +2x1g +2x1h +2x1j +2x1k +2x1m +2x1n +2x1p +2x1q +2x1s +2x1t +2x1v +2x1w +2x1x +2x1y +2x1z +2y1\~n +2y1b +2y1c +2y1d +2y1f +2y1g +2y1h +2y1j +2y1k +2y1m +2y1n +2y1p +2y1q +2y1s +2y1t +2y1v +2y1w +2y1x +2y1y +2y1z +2z1\~n +2z1b +2z1c +2z1d +2z1f +2z1g +2z1h +2z1j +2z1k +2z1m +2z1n +2z1p +2z1q +2z1s +2z1t +2z1v +2z1w +2z1x +2z1y +2z1z +\'a1\'i +\'a1\'u +\'a1\~n +\'a1a +\'a1b +\'a1c +\'a1d +\'a1e +\'a1f +\'a1g +\'a1h +\'a1j +\'a1k +\'a1l +\'a1m +\'a1n +\'a1o +\'a1p +\'a1q +\'a1r +\'a1s +\'a1t +\'a1v +\'a1w +\'a1x +\'a1y +\'a1z +\'a2\~n. +\'a2b. +\'a2c. +\'a2d. +\'a2f. +\'a2g. +\'a2h. +\'a2j. +\'a2k. +\'a2l. +\'a2m. +\'a2n. +\'a2p. +\'a2q. +\'a2r. +\'a2s. +\'a2t. +\'a2v. +\'a2w. +\'a2x. +\'a2y. +\'a2z. +\'e1\'i +\'e1\'u +\'e1\~n +\'e1a +\'e1b +\'e1c +\'e1d +\'e1e +\'e1f +\'e1g +\'e1h +\'e1j +\'e1k +\'e1l +\'e1m +\'e1n +\'e1o +\'e1p +\'e1q +\'e1r +\'e1s +\'e1t +\'e1v +\'e1w +\'e1x +\'e1y +\'e1z +\'e2\~n. +\'e2b. +\'e2c. +\'e2d. +\'e2f. +\'e2g. +\'e2h. +\'e2j. +\'e2k. +\'e2l. +\'e2m. +\'e2n. +\'e2p. +\'e2q. +\'e2r. +\'e2s. +\'e2t. +\'e2v. +\'e2w. +\'e2x. +\'e2y. +\'e2z. +\'i1\'a +\'i1\'e +\'i1\'o +\'i1\~n +\'i1a +\'i1b +\'i1c +\'i1d +\'i1e +\'i1f +\'i1g +\'i1h +\'i1j +\'i1k +\'i1l +\'i1m +\'i1n +\'i1o +\'i1p +\'i1q +\'i1r +\'i1s +\'i1t +\'i1v +\'i1w +\'i1x +\'i1y +\'i1z +\'i2\~n. +\'i2b. +\'i2c. +\'i2d. +\'i2f. +\'i2g. +\'i2h. +\'i2j. +\'i2k. +\'i2l. +\'i2m. +\'i2n. +\'i2p. +\'i2q. +\'i2r. +\'i2s. +\'i2t. +\'i2v. +\'i2w. +\'i2x. +\'i2y. +\'i2z. +\'o1\'i +\'o1\'u +\'o1\~n +\'o1a +\'o1b +\'o1c +\'o1d +\'o1e +\'o1f +\'o1g +\'o1h +\'o1j +\'o1k +\'o1l +\'o1m +\'o1n +\'o1o +\'o1p +\'o1q +\'o1r +\'o1s +\'o1t +\'o1v +\'o1w +\'o1x +\'o1y +\'o1z +\'o2\~n. +\'o2b. +\'o2c. +\'o2d. +\'o2f. +\'o2g. +\'o2h. +\'o2j. +\'o2k. +\'o2l. +\'o2m. +\'o2n. +\'o2p. +\'o2q. +\'o2r. +\'o2s. +\'o2t. +\'o2v. +\'o2w. +\'o2x. +\'o2y. +\'o2z. +\'u1\'a +\'u1\'e +\'u1\'o +\'u1\~n +\'u1a +\'u1b +\'u1c +\'u1d +\'u1e +\'u1f +\'u1g +\'u1h +\'u1j +\'u1k +\'u1l +\'u1m +\'u1n +\'u1o +\'u1p +\'u1q +\'u1r +\'u1s +\'u1t +\'u1v +\'u1w +\'u1x +\'u1y +\'u1z +\'u2\~n. +\'u2b. +\'u2c. +\'u2d. +\'u2f. +\'u2g. +\'u2h. +\'u2j. +\'u2k. +\'u2l. +\'u2m. +\'u2n. +\'u2p. +\'u2q. +\'u2r. +\'u2s. +\'u2t. +\'u2v. +\'u2w. +\'u2x. +\'u2y. +\'u2z. +a1\'a +a1\'e +a1\'i +a1\'o +a1\'u +a1\~n +a1a +a1b +a1c +a1d +a1e +a1f +a1g +a1h +a1j +a1k +a1l +a1m +a1n +a1o +a1p +a1q +a1r +a1s +a1t +a1v +a1w +a1x +a1y +a1z +a2\~n. +a2b. +a2c. +a2d. +a2f. +a2g. +a2h. +a2j. +a2k. +a2l. +a2m. +a2n. +a2p. +a2q. +a2r. +a2s. +a2t. +a2v. +a2w. +a2x. +a2y. +a2z. +e1\'a +e1\'e +e1\'i +e1\'o +e1\'u +e1\~n +e1a +e1b +e1c +e1d +e1e +e1f +e1g +e1h +e1j +e1k +e1l +e1m +e1n +e1o +e1p +e1q +e1r +e1s +e1t +e1v +e1w +e1x +e1y +e1z +e2\~n. +e2b. +e2c. +e2d. +e2f. +e2g. +e2h. +e2j. +e2k. +e2l. +e2m. +e2n. +e2p. +e2q. +e2r. +e2s. +e2t. +e2v. +e2w. +e2x. +e2y. +e2z. +i1\~n +i1b +i1c +i1d +i1f +i1g +i1h +i1j +i1k +i1l +i1m +i1n +i1p +i1q +i1r +i1s +i1t +i1v +i1w +i1x +i1y +i1z +i2\~n. +i2b. +i2c. +i2d. +i2f. +i2g. +i2h. +i2j. +i2k. +i2l. +i2m. +i2n. +i2p. +i2q. +i2r. +i2s. +i2t. +i2v. +i2w. +i2x. +i2y. +i2z. +o1\'a +o1\'e +o1\'i +o1\'o +o1\'u +o1\~n +o1a +o1b +o1c +o1d +o1e +o1f +o1g +o1h +o1j +o1k +o1l +o1m +o1n +o1o +o1p +o1q +o1r +o1s +o1t +o1v +o1w +o1x +o1y +o1z +o2\~n. +o2b. +o2c. +o2d. +o2f. +o2g. +o2h. +o2j. +o2k. +o2l. +o2m. +o2n. +o2p. +o2q. +o2r. +o2s. +o2t. +o2v. +o2w. +o2x. +o2y. +o2z. +u1\~n +u1b +u1c +u1d +u1f +u1g +u1h +u1j +u1k +u1l +u1m +u1n +u1p +u1q +u1r +u1s +u1t +u1v +u1w +u1x +u1y +u1z +u2\~n. +u2b. +u2c. +u2d. +u2f. +u2g. +u2h. +u2j. +u2k. +u2l. +u2m. +u2n. +u2p. +u2q. +u2r. +u2s. +u2t. +u2v. +u2w. +u2x. +u2y. +u2z. diff --git a/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/expander-1.3.1.tm b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/expander-1.3.1.tm new file mode 100644 index 0000000..9ce76d8 --- /dev/null +++ b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/expander-1.3.1.tm @@ -0,0 +1,1122 @@ +#--------------------------------------------------------------------- +# TITLE: +# expander.tcl +# +# AUTHOR: +# Will Duquette +# +# DESCRIPTION: +# +# An expander is an object that takes as input text with embedded +# Tcl code and returns text with the embedded code expanded. The +# text can be provided all at once or incrementally. +# +# See expander.[e]html for usage info. +# Also expander.n +# +# LICENSE: +# Copyright (C) 2001 by William H. Duquette. See expander_license.txt, +# distributed with this file, for license information. +# +# CHANGE LOG: +# +# 10/31/01: V0.9 code is complete. +# 11/23/01: Added "evalcmd"; V1.0 code is complete. + +# Provide the package. + +# Create the package's namespace. + +namespace eval ::textutil { + namespace eval expander { + # All indices are prefixed by "$exp-". + # + # lb The left bracket sequence + # rb The right bracket sequence + # errmode How to handle macro errors: + # nothing, macro, error, fail. + # evalcmd The evaluation command. + # textcmd The plain text processing command. + # level The context level + # output-$level The accumulated text at this context level. + # name-$level The tag name of this context level + # data-$level-$var A variable of this context level + + variable Info + + # In methods, the current object: + variable This "" + + # Export public commands + namespace export expander + } + + #namespace import expander::* + namespace export expander + + proc expander {name} {uplevel ::textutil::expander::expander [list $name]} +} + +#--------------------------------------------------------------------- +# FUNCTION: +# expander name +# +# INPUTS: +# name A proc name for the new object. If not +# fully-qualified, it is assumed to be relative +# to the caller's namespace. +# +# RETURNS: +# nothing +# +# DESCRIPTION: +# Creates a new expander object. + +proc ::textutil::expander::expander {name} { + variable Info + + # FIRST, qualify the name. + if {![string match "::*" $name]} { + # Get caller's namespace; append :: if not global namespace. + set ns [uplevel 1 namespace current] + if {"::" != $ns} { + append ns "::" + } + + set name "$ns$name" + } + + # NEXT, Check the name + if {"" != [info commands $name]} { + return -code error "command name \"$name\" already exists" + } + + # NEXT, Create the object. + proc $name {method args} [format { + if {[catch {::textutil::expander::Methods %s $method $args} result]} { + return -code error $result + } else { + return $result + } + } $name] + + # NEXT, Initialize the object + Op_reset $name + + return $name +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Methods name method argList +# +# INPUTS: +# name The object's fully qualified procedure name. +# This argument is provided by the object command +# itself. +# method The method to call. +# argList Arguments for the specific method. +# +# RETURNS: +# Depends on the method +# +# DESCRIPTION: +# Handles all method dispatch for a expander object. +# The expander's object command merely passes its arguments to +# this function, which dispatches the arguments to the +# appropriate method procedure. If the method raises an error, +# the method procedure's name in the error message is replaced +# by the object and method names. + +proc ::textutil::expander::Methods {name method argList} { + variable Info + variable This + + switch -exact -- $method { + expand - + lb - + rb - + setbrackets - + errmode - + evalcmd - + textcmd - + cpush - + ctopandclear - + cis - + cname - + cset - + cget - + cvar - + cpop - + cappend - + where - + reset { + # FIRST, execute the method, first setting This to the object + # name; then, after the method has been called, restore the + # old object name. + set oldThis $This + set This $name + + set retval [catch "Op_$method $name $argList" result] + + set This $oldThis + + # NEXT, handle the result based on the retval. + if {$retval} { + regsub -- "Op_$method" $result "$name $method" result + return -code error $result + } else { + return $result + } + } + default { + return -code error "\"$name $method\" is not defined" + } + } +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Get key +# +# INPUTS: +# key A key into the Info array, excluding the +# object name. E.g., "lb" +# +# RETURNS: +# The value from the array +# +# DESCRIPTION: +# Gets the value of an entry from Info for This. + +proc ::textutil::expander::Get {key} { + variable Info + variable This + + return $Info($This-$key) +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Set key value +# +# INPUTS: +# key A key into the Info array, excluding the +# object name. E.g., "lb" +# +# value A Tcl value +# +# RETURNS: +# The value +# +# DESCRIPTION: +# Sets the value of an entry in Info for This. + +proc ::textutil::expander::Set {key value} { + variable Info + variable This + + return [set Info($This-$key) $value] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Var key +# +# INPUTS: +# key A key into the Info array, excluding the +# object name. E.g., "lb" +# +# RETURNS: +# The full variable name, suitable for setting or lappending + +proc ::textutil::expander::Var {key} { + variable Info + variable This + + return ::textutil::expander::Info($This-$key) +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Contains list value +# +# INPUTS: +# list any list +# value any value +# +# RETURNS: +# TRUE if the list contains the value, and false otherwise. + +proc ::textutil::expander::Contains {list value} { + if {[lsearch -exact $list $value] == -1} { + return 0 + } else { + return 1 + } +} + + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_lb ?newbracket? +# +# INPUTS: +# newbracket If given, the new bracket token. +# +# RETURNS: +# The current left bracket +# +# DESCRIPTION: +# Returns the current left bracket token. + +proc ::textutil::expander::Op_lb {name {newbracket ""}} { + if {[string length $newbracket] != 0} { + Set lb $newbracket + } + return [Get lb] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_rb ?newbracket? +# +# INPUTS: +# newbracket If given, the new bracket token. +# +# RETURNS: +# The current left bracket +# +# DESCRIPTION: +# Returns the current left bracket token. + +proc ::textutil::expander::Op_rb {name {newbracket ""}} { + if {[string length $newbracket] != 0} { + Set rb $newbracket + } + return [Get rb] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_setbrackets lbrack rbrack +# +# INPUTS: +# lbrack The new left bracket +# rbrack The new right bracket +# +# RETURNS: +# nothing +# +# DESCRIPTION: +# Sets the brackets as a pair. + +proc ::textutil::expander::Op_setbrackets {name lbrack rbrack} { + Set lb $lbrack + Set rb $rbrack + return +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_errmode ?newErrmode? +# +# INPUTS: +# newErrmode If given, the new error mode. +# +# RETURNS: +# The current error mode +# +# DESCRIPTION: +# Returns the current error mode. + +proc ::textutil::expander::Op_errmode {name {newErrmode ""}} { + if {[string length $newErrmode] != 0} { + if {![Contains "macro nothing error fail" $newErrmode]} { + error "$name errmode: Invalid error mode: $newErrmode" + } + + Set errmode $newErrmode + } + return [Get errmode] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_evalcmd ?newEvalCmd? +# +# INPUTS: +# newEvalCmd If given, the new eval command. +# +# RETURNS: +# The current eval command +# +# DESCRIPTION: +# Returns the current eval command. This is the command used to +# evaluate macros; it defaults to "uplevel #0". + +proc ::textutil::expander::Op_evalcmd {name {newEvalCmd ""}} { + if {[string length $newEvalCmd] != 0} { + Set evalcmd $newEvalCmd + } + return [Get evalcmd] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_textcmd ?newTextCmd? +# +# INPUTS: +# newTextCmd If given, the new text command. +# +# RETURNS: +# The current text command +# +# DESCRIPTION: +# Returns the current text command. This is the command used to +# process plain text. It defaults to {}, meaning identity. + +proc ::textutil::expander::Op_textcmd {name args} { + switch -exact [llength $args] { + 0 {} + 1 {Set textcmd [lindex $args 0]} + default { + return -code error "wrong#args for textcmd: name ?newTextcmd?" + } + } + return [Get textcmd] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_reset +# +# INPUTS: +# none +# +# RETURNS: +# nothing +# +# DESCRIPTION: +# Resets all object values, as though it were brand new. + +proc ::textutil::expander::Op_reset {name} { + variable Info + + if {[info exists Info($name-lb)]} { + foreach elt [array names Info "$name-*"] { + unset Info($elt) + } + } + + set Info($name-lb) "\[" + set Info($name-rb) "\]" + set Info($name-errmode) "fail" + set Info($name-evalcmd) "uplevel #0" + set Info($name-textcmd) "" + set Info($name-level) 0 + set Info($name-output-0) "" + set Info($name-name-0) ":0" + + return +} + +#------------------------------------------------------------------------- +# Context: Every expansion takes place in its own context; however, +# a macro can push a new context, causing the text it returns and all +# subsequent text to be saved separately. Later, a matching macro can +# pop the context, acquiring all text saved since the first command, +# and use that in its own output. + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_cpush cname +# +# INPUTS: +# cname The context name +# +# RETURNS: +# nothing +# +# DESCRIPTION: +# Pushes an empty macro context onto the stack. All expanded text +# will be added to this context until it is popped. + +proc ::textutil::expander::Op_cpush {name cname} { + # FRINK: nocheck + incr [Var level] + # FRINK: nocheck + set [Var output-[Get level]] {} + # FRINK: nocheck + set [Var name-[Get level]] $cname + + # The first level is init'd elsewhere (Op_expand) + if {[set [Var level]] < 2} return + + # Initialize the location information, inherit from the outer + # context. + + LocInit $cname + catch {LocSet $cname [LocGet $name]} + return +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_cis cname +# +# INPUTS: +# cname A context name +# +# RETURNS: +# true or false +# +# DESCRIPTION: +# Returns true if the current context has the specified name, and +# false otherwise. + +proc ::textutil::expander::Op_cis {name cname} { + return [expr {[string compare $cname [Op_cname $name]] == 0}] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_cname +# +# INPUTS: +# none +# +# RETURNS: +# The context name +# +# DESCRIPTION: +# Returns the name of the current context. + +proc ::textutil::expander::Op_cname {name} { + return [Get name-[Get level]] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_cset varname value +# +# INPUTS: +# varname The name of a context variable +# value The new value for the context variable +# +# RETURNS: +# The value +# +# DESCRIPTION: +# Sets a variable in the current context. + +proc ::textutil::expander::Op_cset {name varname value} { + Set data-[Get level]-$varname $value +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_cget varname +# +# INPUTS: +# varname The name of a context variable +# +# RETURNS: +# The value +# +# DESCRIPTION: +# Returns the value of a context variable. It's an error if +# the variable doesn't exist. + +proc ::textutil::expander::Op_cget {name varname} { + if {![info exists [Var data-[Get level]-$varname]]} { + error "$name cget: $varname doesn't exist in this context ([Get level])" + } + return [Get data-[Get level]-$varname] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_cvar varname +# +# INPUTS: +# varname The name of a context variable +# +# RETURNS: +# The index to the variable +# +# DESCRIPTION: +# Returns the index to a context variable, for use with set, +# lappend, etc. + +proc ::textutil::expander::Op_cvar {name varname} { + if {![info exists [Var data-[Get level]-$varname]]} { + error "$name cvar: $varname doesn't exist in this context" + } + + return [Var data-[Get level]-$varname] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_cpop cname +# +# INPUTS: +# cname The expected context name. +# +# RETURNS: +# The accumulated output in this context +# +# DESCRIPTION: +# Returns the accumulated output for the current context, first +# popping the context from the stack. The expected context name +# must match the real name, or an error occurs. + +proc ::textutil::expander::Op_cpop {name cname} { + variable Info + + if {[Get level] == 0} { + error "$name cpop underflow on '$cname'" + } + + if {[string compare [Op_cname $name] $cname] != 0} { + error "$name cpop context mismatch: expected [Op_cname $name], got $cname" + } + + set result [Get output-[Get level]] + # FRINK: nocheck + set [Var output-[Get level]] "" + # FRINK: nocheck + set [Var name-[Get level]] "" + + foreach elt [array names "Info data-[Get level]-*"] { + unset Info($elt) + } + + # FRINK: nocheck + incr [Var level] -1 + return $result +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_ctopandclear +# +# INPUTS: +# None. +# +# RETURNS: +# The accumulated output in the topmost context, clears the context, +# but does not pop it. +# +# DESCRIPTION: +# Returns the accumulated output for the current context, first +# popping the context from the stack. The expected context name +# must match the real name, or an error occurs. + +proc ::textutil::expander::Op_ctopandclear {name} { + variable Info + + if {[Get level] == 0} { + error "$name cpop underflow on '[Op_cname $name]'" + } + + set result [Get output-[Get level]] + Set output-[Get level] "" + return $result +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_cappend text +# +# INPUTS: +# text Text to add to the output +# +# RETURNS: +# The accumulated output +# +# DESCRIPTION: +# Appends the text to the accumulated output in the current context. + +proc ::textutil::expander::Op_cappend {name text} { + # FRINK: nocheck + append [Var output-[Get level]] $text +} + +#------------------------------------------------------------------------- +# Macro-expansion: The following code is the heart of the module. +# Given a text string, and the current variable settings, this code +# returns an expanded string, with all macros replaced. + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_expand inputString ?brackets? +# +# INPUTS: +# inputString The text to expand. +# brackets A list of two bracket tokens. +# +# RETURNS: +# The expanded text. +# +# DESCRIPTION: +# Finds all embedded macros in the input string, and expands them. +# If ?brackets? is given, it must be list of length 2, containing +# replacement left and right macro brackets; otherwise the default +# brackets are used. + +proc ::textutil::expander::Op_expand {name inputString {brackets ""}} { + # FIRST, push a new context onto the stack, and save the current + # brackets. + + Op_cpush $name expand + Op_cset $name lb [Get lb] + Op_cset $name rb [Get rb] + + # Keep position information in context variables as well. + # Line we are in, counting from 1; column we are at, + # counting from 0, and index of character we are at, + # counting from 0. Tabs counts as '1' when computing + # the column. + + LocInit $name + + # SF Tcllib Bug #530056. + set start_level [Get level] ; # remember this for check at end + + # NEXT, use the user's brackets, if given. + if {[llength $brackets] == 2} { + Set lb [lindex $brackets 0] + Set rb [lindex $brackets 1] + } + + # NEXT, loop over the string, finding and expanding macros. + while {[string length $inputString] > 0} { + set plainText [ExtractToToken inputString [Get lb] exclude] + + # FIRST, If there was plain text, append it to the output, and + # continue. + if {$plainText != ""} { + set input $plainText + set tc [Get textcmd] + if {[string length $tc] > 0} { + lappend tc $plainText + + if {![catch "[Get evalcmd] [list $tc]" result]} { + set plainText $result + } else { + HandleError $name {plain text} $tc $result + } + } + Op_cappend $name $plainText + LocUpdate $name $input + + if {[string length $inputString] == 0} { + break + } + } + + # NEXT, A macro is the next thing; process it. + if {[catch {GetMacro inputString} macro]} { + # SF tcllib bug 781973 ... Do not throw a regular + # error. Use HandleError to give the user control of the + # situation, via the defined error mode. The continue + # intercepts if the user allows the expansion to run on, + # yet we must not try to run the non-existing macro. + + HandleError $name {reading macro} $inputString $macro + continue + } + + # Expand the macro, and output the result, or + # handle an error. + if {![catch "[Get evalcmd] [list $macro]" result]} { + Op_cappend $name $result + + # We have to advance the location by the length of the + # macro, plus the two brackets. They were stripped by + # GetMacro, so we have to add them here again to make + # computation correct. + + LocUpdate $name [Get lb]${macro}[Get rb] + continue + } + + HandleError $name macro $macro $result + } + + # SF Tcllib Bug #530056. + if {[Get level] > $start_level} { + # The user macros pushed additional contexts, but forgot to + # pop them all. The main work here is to place all the still + # open contexts into the error message, and to produce + # syntactically correct english. + + set c [list] + set n [expr {[Get level] - $start_level}] + if {$n == 1} { + set ctx context + set verb was + } else { + set ctx contexts + set verb were + } + for {incr n -1} {$n >= 0} {incr n -1} { + lappend c [Get name-[expr {[Get level]-$n}]] + } + return -code error \ + "The following $ctx pushed by the macros $verb not popped: [join $c ,]." + } elseif {[Get level] < $start_level} { + set n [expr {$start_level - [Get level]}] + if {$n == 1} { + set ctx context + } else { + set ctx contexts + } + return -code error \ + "The macros popped $n more $ctx than they had pushed." + } + + Op_lb $name [Op_cget $name lb] + Op_rb $name [Op_cget $name rb] + + return [Op_cpop $name expand] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# Op_where +# +# INPUTS: +# None. +# +# RETURNS: +# The current location in the input. +# +# DESCRIPTION: +# Retrieves the current location the expander +# is at during processing. + +proc ::textutil::expander::Op_where {name} { + return [LocGet $name] +} + +#--------------------------------------------------------------------- +# FUNCTION +# HandleError name title command errmsg +# +# INPUTS: +# name The name of the expander object in question. +# title A title text +# command The command which caused the error. +# errmsg The error message to report +# +# RETURNS: +# Nothing +# +# DESCRIPTIONS +# Is executed when an error in a macro or the plain text handler +# occurs. Generates an error message according to the current +# error mode. + +proc ::textutil::expander::HandleError {name title command errmsg} { + switch [Get errmode] { + nothing { } + macro { + # The location is irrelevant here. + Op_cappend $name "[Get lb]$command[Get rb]" + } + error { + foreach {ch line col} [LocGet $name] break + set display [DisplayOf $command] + + Op_cappend $name "\n=================================\n" + Op_cappend $name "*** Error in $title at line $line, column $col:\n" + Op_cappend $name "*** [Get lb]$display[Get rb]\n--> $errmsg\n" + Op_cappend $name "=================================\n" + } + fail { + foreach {ch line col} [LocGet $name] break + set display [DisplayOf $command] + + return -code error "Error in $title at line $line,\ + column $col:\n[Get lb]$display[Get rb]\n-->\ + $errmsg" + } + default { + return -code error "Unknown error mode: [Get errmode]" + } + } +} + +#--------------------------------------------------------------------- +# FUNCTION: +# ExtractToToken string token mode +# +# INPUTS: +# string The text to process. +# token The token to look for +# mode include or exclude +# +# RETURNS: +# The extracted text +# +# DESCRIPTION: +# Extract text from a string, up to or including a particular +# token. Remove the extracted text from the string. +# mode determines whether the found token is removed; +# it should be "include" or "exclude". The string is +# modified in place, and the extracted text is returned. + +proc ::textutil::expander::ExtractToToken {string token mode} { + upvar $string theString + + # First, determine the offset + switch $mode { + include { set offset [expr {[string length $token] - 1}] } + exclude { set offset -1 } + default { error "::expander::ExtractToToken: unknown mode $mode" } + } + + # Next, find the first occurrence of the token. + set tokenPos [string first $token $theString] + + # Next, return the entire string if it wasn't found, or just + # the part upto or including the character. + if {$tokenPos == -1} { + set theText $theString + set theString "" + } else { + set newEnd [expr {$tokenPos + $offset}] + set newBegin [expr {$newEnd + 1}] + set theText [string range $theString 0 $newEnd] + set theString [string range $theString $newBegin end] + } + + return $theText +} + +#--------------------------------------------------------------------- +# FUNCTION: +# GetMacro string +# +# INPUTS: +# string The text to process. +# +# RETURNS: +# The macro, stripped of its brackets. +# +# DESCRIPTION: + +proc ::textutil::expander::GetMacro {string} { + upvar $string theString + + # FIRST, it's an error if the string doesn't begin with a + # bracket. + if {[string first [Get lb] $theString] != 0} { + error "::expander::GetMacro: assertion failure, next text isn't a command! '$theString'" + } + + # NEXT, extract a full macro + set macro [ExtractToToken theString [Get lb] include] + while {[string length $theString] > 0} { + append macro [ExtractToToken theString [Get rb] include] + + # Verify that the command really ends with the [rb] characters, + # whatever they are. If not, break because of unexpected + # end of file. + if {![IsBracketed $macro]} { + break; + } + + set strippedMacro [StripBrackets $macro] + + if {[info complete "puts \[$strippedMacro\]"]} { + return $strippedMacro + } + } + + if {[string length $macro] > 40} { + set macro "[string range $macro 0 39]...\n" + } + error "Unexpected EOF in macro:\n$macro" +} + +# Strip left and right bracket tokens from the ends of a macro, +# provided that it's properly bracketed. +proc ::textutil::expander::StripBrackets {macro} { + set llen [string length [Get lb]] + set rlen [string length [Get rb]] + set tlen [string length $macro] + + return [string range $macro $llen [expr {$tlen - $rlen - 1}]] +} + +# Return 1 if the macro is properly bracketed, and 0 otherwise. +proc ::textutil::expander::IsBracketed {macro} { + set llen [string length [Get lb]] + set rlen [string length [Get rb]] + set tlen [string length $macro] + + set leftEnd [string range $macro 0 [expr {$llen - 1}]] + set rightEnd [string range $macro [expr {$tlen - $rlen}] end] + + if {$leftEnd != [Get lb]} { + return 0 + } elseif {$rightEnd != [Get rb]} { + return 0 + } else { + return 1 + } +} + +#--------------------------------------------------------------------- +# FUNCTION: +# LocInit name +# +# INPUTS: +# name The expander object to use. +# +# RETURNS: +# No result. +# +# DESCRIPTION: +# A convenience wrapper around LocSet. Initializes the location +# to the start of the input (char 0, line 1, column 0). + +proc ::textutil::expander::LocInit {name} { + LocSet $name {0 1 0} + return +} + +#--------------------------------------------------------------------- +# FUNCTION: +# LocSet name loc +# +# INPUTS: +# name The expander object to use. +# loc Location, list containing character position, +# line number and column, in this order. +# +# RETURNS: +# No result. +# +# DESCRIPTION: +# Sets the current location in the expander to 'loc'. + +proc ::textutil::expander::LocSet {name loc} { + foreach {ch line col} $loc break + Op_cset $name char $ch + Op_cset $name line $line + Op_cset $name col $col + return +} + +#--------------------------------------------------------------------- +# FUNCTION: +# LocGet name +# +# INPUTS: +# name The expander object to use. +# +# RETURNS: +# A list containing the current character position, line number +# and column, in this order. +# +# DESCRIPTION: +# Returns the current location as stored in the expander. + +proc ::textutil::expander::LocGet {name} { + list [Op_cget $name char] [Op_cget $name line] [Op_cget $name col] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# LocUpdate name text +# +# INPUTS: +# name The expander object to use. +# text The text to process. +# +# RETURNS: +# No result. +# +# DESCRIPTION: +# Takes the current location as stored in the expander, computes +# a new location based on the string (its length and contents +# (number of lines)), and makes that new location the current +# location. + +proc ::textutil::expander::LocUpdate {name text} { + foreach {ch line col} [LocGet $name] break + set numchars [string length $text] + #8.4+ set numlines [regexp -all "\n" $text] + set numlines [expr {[llength [split $text \n]]-1}] + + incr ch $numchars + incr line $numlines + if {$numlines} { + set col [expr {$numchars - [string last \n $text] - 1}] + } else { + incr col $numchars + } + + LocSet $name [list $ch $line $col] + return +} + +#--------------------------------------------------------------------- +# FUNCTION: +# LocRange name text +# +# INPUTS: +# name The expander object to use. +# text The text to process. +# +# RETURNS: +# A text range description, compatible with the 'location' data +# used in the tcl debugger/checker. +# +# DESCRIPTION: +# Takes the current location as stored in the expander object +# and the length of the text to generate a character range. + +proc ::textutil::expander::LocRange {name text} { + # Note that the structure is compatible with + # the ranges uses by tcl debugger and checker. + # {line {charpos length}} + + foreach {ch line col} [LocGet $name] break + return [list $line [list $ch [string length $text]]] +} + +#--------------------------------------------------------------------- +# FUNCTION: +# DisplayOf text +# +# INPUTS: +# text The text to process. +# +# RETURNS: +# The text, cut down to at most 30 bytes. +# +# DESCRIPTION: +# Cuts the incoming text down to contain no more than 30 +# characters of the input. Adds an ellipsis (...) if characters +# were actually removed from the input. + +proc ::textutil::expander::DisplayOf {text} { + set ellip "" + while {[string bytelength $text] > 30} { + set ellip ... + set text [string range $text 0 end-1] + } + set display $text$ellip +} + +#--------------------------------------------------------------------- +# Provide the package only if the code above was read and executed +# without error. + +package provide textutil::expander 1.3.1 diff --git a/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/ithyph.tex b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/ithyph.tex new file mode 100644 index 0000000..755e108 --- /dev/null +++ b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/ithyph.tex @@ -0,0 +1,223 @@ + +%%%%%%%%%%%%%%%%%%%% file ithyph.tex + +%%%%%%%%%%%%%%%%%%%%%%%%%%% file ithyph.tex %%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% +% Prepared by Claudio Beccari e-mail beccari@polito.it +% +% Dipartimento di Elettronica +% Politecnico di Torino +% Corso Duca degli Abruzzi, 24 +% 10129 TORINO +% +% Copyright 1998, 2001 Claudio Beccari +% +% This program can be redistributed and/or modified under the terms +% of the LaTeX Project Public License Distributed from CTAN +% archives in directory macros/latex/base/lppl.txt; either +% version 1 of the License, or any later version. +% +% \versionnumber{4.8d} \versiondate{2001/11/21} +% +% These hyphenation patterns for the Italian language are supposed to comply +% with the Reccomendation UNI 6461 on hyphenation issued by the Italian +% Standards Institution (Ente Nazionale di Unificazione UNI). No guarantee +% or declaration of fitness to any particular purpose is given and any +% liability is disclaimed. +% +% See comments and loading instructions at the end of the file after the +% \endinput line +% +{\lccode`\'=`\' % Apostrophe has its own lccode so that it is treated + % as a letter + %>> 1998/04/14 inserted grouping + % +%\lccode23=23 % Compound word mark is a letter in encoding T1 +%\def\W{^^W} % ^^W =\char23 = \char"17 =\char'27 +% +\patterns{ +.a3p2n % After the Garzanti dictionary: a-pnea, a-pnoi-co,... +.anti1 .anti3m2n +.bio1 +.ca4p3s +.circu2m1 +.di2s3cine +%.e2x +.fran2k3 +.free3 +.narco1 +.opto1 +.orto3p2 +.para1 +.poli3p2 +.pre1 +.p2s +%.ri1a2 .ri1e2 .re1i2 .ri1o2 .ri1u2 +.sha2re3 +.tran2s3c .tran2s3d .tran2s3f .tran2s3l .tran2s3n .tran2s3p .tran2s3r .tran2s3t +.su2b3lu .su2b3r +.wa2g3n +.wel2t1 +a1ia a1ie a1io a1iu a1uo a1ya 2at. +e1iu e2w +o1ia o1ie o1io o1iu +%u1u +% +%1\W0a2 1\W0e2 1\W0i2 1\W0o2 1\W0u2 +'2 +1b 2bb 2bc 2bd 2bf 2bm 2bn 2bp 2bs 2bt 2bv + b2l b2r 2b. 2b'. 2b'' +1c 2cb 2cc 2cd 2cf 2ck 2cm 2cn 2cq 2cs 2ct 2cz + 2chh c2h 2chb ch2r 2chn c2l c2r 2c. 2c'. 2c'' .c2 +1d 2db 2dd 2dg 2dl 2dm 2dn 2dp d2r 2ds 2dt 2dv 2dw + 2d. 2d'. 2d'' .d2 +1f 2fb 2fg 2ff 2fn f2l f2r 2fs 2ft 2f. 2f'. 2f'' +1g 2gb 2gd 2gf 2gg g2h g2l 2gm g2n 2gp g2r 2gs 2gt + 2gv 2gw 2gz 2gh2t 2g. 2g'. 2g'' +1h 2hb 2hd 2hh hi3p2n h2l 2hm 2hn 2hr 2hv 2h. 2h'. 2h'' +1j 2j. 2j'. 2j'' +1k 2kg 2kf k2h 2kk k2l 2km k2r 2ks 2kt 2k. 2k'. 2k'' +1l 2lb 2lc 2ld 2l3f2 2lg l2h 2lk 2ll 2lm 2ln 2lp + 2lq 2lr 2ls 2lt 2lv 2lw 2lz 2l. 2l'. 2l'' +1m 2mb 2mc 2mf 2ml 2mm 2mn 2mp 2mq 2mr 2ms 2mt 2mv 2mw + 2m. 2m'. 2m'' +1n 2nb 2nc 2nd 2nf 2ng 2nk 2nl 2nm 2nn 2np 2nq 2nr + 2ns 2nt 2nv 2nz n2g3n 2nheit. 2n. 2n' 2n'' +1p 2pd p2h p2l 2pn 3p2ne 2pp p2r 2ps 3p2sic 2pt 2pz 2p. 2p'. 2p'' +1q 2qq 2q. 2q'. 2q'' +1r 2rb 2rc 2rd 2rf r2h 2rg 2rk 2rl 2rm 2rn 2rp + 2rq 2rr 2rs 2rt rt2s3 2rv 2rx 2rw 2rz 2r. 2r'. 2r'' +1s2 2shm 2s3s s4s3m 2s3p2n 2stb 2stc 2std 2stf 2stg 2stm 2stn + 2stp 2sts 2stt 2stv 2sz 4s. 4s'. 4s'' +1t 2tb 2tc 2td 2tf 2tg t2h t2l 2tm 2tn 2tp t2r 2ts + 3t2sch 2tt 2tv 2tw t2z 2tzk 2tzs 2t. 2t'. 2t'' +1v 2vc v2l v2r 2vv 2v. 2v'. 2v'' +1w w2h wa2r 2w1y 2w. 2w'. 2w'' +1x 2xt 2xw 2x. 2x'. 2x'' +y1ou y1i +1z 2zb 2zd 2zl 2zn 2zp 2zt 2zs 2zv 2zz 2z. 2z'. 2z'' .z2 +}} % Pattern end + +\endinput + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Information %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + LOADING THESE PATTERNS + +These patterns, as well as those for any other language, do not become +effective until they are loaded in a special form into a format file; this +task is performed by the TeX initializer; any TeX system has its own +initializer with its special way of being activated. Before loading these +patterns, then, it is necessary to read very carefully the instructions that +come with your TeX system. + +Here I describe how to load the patterns with the freeware TeX system named +MiKTeX version 2.x for Windows 9x, NT, 2000, XP; with minor changes the +whole procedure is applicable with other TeX systems, but the details must +be deduced from your TeX system documentation at the section/chapter "How to +build or to rebuild a format file". + +With MikTeX: + +a) copy this file and replace the existing file ithyph.tex in the directory + \texmf\tex\generic\hyphen if the existing one has an older version date + and number. +b) select Start|Programs|MiKTeX|MiKTeX options. +c) in the Language tab add a check mark to the line concerning the Italian + language. +d) in the Geneal tab click "Update format files". +e) That's all! + +For the activation of these patterns with the specific Italian typesetting +features, use the babel package as this: + +\documentclass{article} % Or whatever other class +\usepackage[italian]{babel} +... +\begin{document} +... +\end{document} + + + ON ITALIAN HYPHENATION + +I have been working on patterns for the Italian language since 1987; in 1992 +I published + +C. Beccari, "Computer aided hyphenation for Italian and Modern + Latin", TUG vol. 13, n. 1, pp. 23-33 (1992) + +which contained a set of patterns that allowed hyphenation for both Italian +and Latin; a slightly modified version of the patterns published in the +above paper is contained in LAHYPH.TEX available on the CTAN archives. + +From the above patterns I extracted the minimum set necessary for +hyphenating Italian that was made available on the CTAN archives with the +name ITHYPH.tex the version number 3.5 on the 16th of August 1994. + +The original pattern set required 37 ops; being interested in a local +version of TeX/LaTeX capable of dealing with half a dozen languages, I +wanted to reduce memory occupation and therefore the number of ops. + +Th new version (4.0 released in 1996) of ITHYPH.TEX is much simpler than +version 3.5 and requires just 29 ops while it retains all the power of +version 3.5; it contains many more new patterns that allow to hyphenate +unusual words that generally have a root borrowed from a foreign language. +Updated versions 4.x contain minor additions and the number of ops is +increased to 30 (version 4.7 of 1998/06/01). + +This new pattern set has been tested with the same set of difficult Italian +words that was used to test version 3.5 and it yields the same results (a +part a minor change that was deliberately introduced so as to reduce the +typographical hyphenation with hyathi, since hyphenated hyathi are not +appreciated by Italian readers). A new enlarged word set for testing +purposes gets correct hyphen points that were missed or wrongly placed with +version 3.5, although no error had been reported, because such words are of +very specialized nature and are seldom used. + +As the previous version, this new set of patterns does not contain any +accented character so that the hyphenation algorithm behaves properly in +both cases, that is with cm and with dc/ec fonts. With LaTeXe terminology +the difference is between OT1 and T1 encodings; with the former encoding +fonts do not contain accented characters, while with the latter accented +characters are present and sequences such as \`a map directly to slot "E0 +that contains "agrave". + +Of course if you use dc/ec fonts (or any other real or virtual font with T1 +encoding) you get the full power of the hyphenation algorithm, while if you +use cm fonts (or any other real or virtual font with OT1 encoding) you miss +some possible break points; this is not a big inconvenience in Italian +because: + +1) The Regulation UNI 6015 on accents specifies that compulsory accents + appear only on the ending vowel of oxitone words; this means that it is + almost indifferent to have or to miss the dc/ec fonts because the only + difference consists in how TeX evaluates the end of the word; in practice + if you have these special facilities you get "qua-li-t\`a", while if you + miss them, you get "qua-lit\`a" (assuming that \righthyphenmin > 1). + +2) Optional accents are so rare in Italian, that if you absolutely want to + use them in those rare instances, and you miss the T1 encoding + facilities, you should also provide explicit discretionary hyphens as in + "s\'e\-gui\-to". + +There is no explicit hyphenation exception list because these patterns +proved to hyphenate correctly a very large set of words suitably chosen in +order to test them in the most heavy circumstances; these patterns were used +in the preparation of a number of books and no errors were discovered. + +Nevertheless if you frequently use technical terms that you want hyphenated +differently from what is normally done (for example if you prefer +etymological hyphenation of prefixed and/or suffixed words) you should +insert a specific hyphenation list in the preamble of your document, for +example: + +\hyphenation{su-per-in-dut-to-re su-per-in-dut-to-ri} + +Should you find any word that gets hyphenated in a wrong way, please, AFTER +CHECKING ON A RELIABLE MODERN DICTIONARY, report to the author, preferably +by e-mail. + + + Happy multilingual typesetting ! diff --git a/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/patch-0.1.tm b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/patch-0.1.tm new file mode 100644 index 0000000..cf68959 --- /dev/null +++ b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/patch-0.1.tm @@ -0,0 +1,180 @@ +# patch.tcl -- +# +# Application of a diff -ruN patch to a directory tree. +# +# Copyright (c) 2019 Christian Gollwitzer +# with tweaks by Andreas Kupries +# - Factored patch parsing into a helper +# - Replaced `puts` with report callback. + +package require Tcl 8.5 +package provide textutil::patch 0.1 + +# # ## ### ##### ######## ############# ##################### + +namespace eval ::textutil::patch { + namespace export apply + namespace ensemble create +} + +# # ## ### ##### ######## ############# ##################### + +proc ::textutil::patch::apply {dir striplevel patch reportcmd} { + set patchdict [Parse $dir $striplevel $patch] + + # Apply, now that we have parsed the patch. + dict for {fn hunks} $patchdict { + Report apply $fn + if {[catch {open $fn} fd]} { + set orig {} + } else { + set orig [split [read $fd] \n] + } + close $fd + + set patched $orig + + set fail false + set already_applied false + set hunknr 1 + foreach hunk $hunks { + dict with hunk { + set oldend [expr {$oldstart+[llength $oldcode]-1}] + set newend [expr {$newstart+[llength $newcode]-1}] + # check if the hunk matches + set origcode [lrange $orig $oldstart $oldend] + if {$origcode ne $oldcode} { + set fail true + # check if the patch is already applied + set origcode_applied [lrange $orig $newstart $newend] + if {$origcode_applied eq $newcode} { + set already_applied true + Report fail-already $fn $hunknr + } else { + Report fail $fn $hunknr $oldcode $origcode + } + break + } + # apply patch + set patched [list \ + {*}[lrange $patched 0 $newstart-1] \ + {*}$newcode \ + {*}[lrange $orig $oldend+1 end]] + } + incr hunknr + } + + if {!$fail} { + # success - write the result back + set fd [open $fn w] + puts -nonewline $fd [join $patched \n] + close $fd + } + } + + return +} + +# # ## ### ##### ######## ############# ##################### + +proc ::textutil::patch::Report args { + upvar 1 reportcmd reportcmd + uplevel #0 [list {*}$reportcmd {*}$args] + ## + # apply $fname + # fail-already $fname $hunkno + # fail $fname $hunkno $expected $seen + ## +} + +proc ::textutil::patch::Parse {dir striplevel patch} { + set patchlines [split $patch \n] + set inhunk false + set oldcode {} + set newcode {} + set n [llength $patchlines] + + set patchdict {} + for {set lineidx 0} {$lineidx < $n} {incr lineidx} { + set line [lindex $patchlines $lineidx] + if {[string match ---* $line]} { + # a diff block starts. Current line should be + # --- oldfile date time TZ + # Next line should be + # +++ newfile date time TZ + set in $line + incr lineidx + set out [lindex $patchlines $lineidx] + + if {![string match ---* $in] || ![string match +++* $out]} { + #puts $in + #puts $out + return -code error "Patch not in unified diff format, line $lineidx $in $out" + } + + # the quoting is compatible with list + lassign $in -> oldfile + lassign $out -> newfile + + set fntopatch [file join $dir {*}[lrange [file split $oldfile] $striplevel end]] + set inhunk false + #puts "Found diffline for $fntopatch" + continue + } + + # state machine for parsing the hunks + set typechar [string index $line 0] + set codeline [string range $line 1 end] + switch $typechar { + @ { + if {![regexp {@@\s+\-(\d+),(\d+)\s+\+(\d+),(\d+)\s+@@} $line \ + -> oldstart oldlen newstart newlen]} { + return code -error "Erroneous hunk in line $lindeidx, $line" + } + # adjust line numbers for 0-based indexing + incr oldstart -1 + incr newstart -1 + #puts "New hunk" + set newcode {} + set oldcode {} + set inhunk true + } + - { # line only in old code + if {$inhunk} { + lappend oldcode $codeline + } + } + + { # line only in new code + if {$inhunk} { + lappend newcode $codeline + } + } + " " { # common line + if {$inhunk} { + lappend oldcode $codeline + lappend newcode $codeline + } + } + default { + # puts "Junk: $codeline"; + continue + } + } + # test if the hunk is complete + if {[llength $oldcode]==$oldlen && [llength $newcode]==$newlen} { + set hunk [dict create \ + oldcode $oldcode \ + newcode $newcode \ + oldstart $oldstart \ + newstart $newstart] + #puts "hunk complete: $hunk" + set inhunk false + dict lappend patchdict $fntopatch $hunk + } + } + + return $patchdict +} + +# # ## ### ##### ######## ############# ##################### +return diff --git a/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/repeat-0.7.tm b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/repeat-0.7.tm new file mode 100644 index 0000000..24f8693 --- /dev/null +++ b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/repeat-0.7.tm @@ -0,0 +1,91 @@ +# repeat.tcl -- +# +# Emulation of string repeat for older +# revisions of Tcl. +# +# Copyright (c) 2000 by Ajuba Solutions. +# Copyright (c) 2001-2006 by Andreas Kupries +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: repeat.tcl,v 1.1 2006/04/21 04:42:28 andreas_kupries Exp $ + +# ### ### ### ######### ######### ######### +## Requirements + +package require Tcl 8.2 + +namespace eval ::textutil::repeat {} + +# ### ### ### ######### ######### ######### + +namespace eval ::textutil::repeat { + variable HaveBuiltin [expr {![catch {string repeat a 1}]}] +} + +if {0} { + # Problems with the deactivated code: + # - Linear in 'num'. + # - Tests for 'string repeat' in every call! + # (Ok, just the variable, still a test every call) + # - Fails for 'num == 0' because of undefined 'str'. + + proc textutil::repeat::StrRepeat { char num } { + variable HaveBuiltin + if { $HaveBuiltin == 0 } then { + for { set i 0 } { $i < $num } { incr i } { + append str $char + } + } else { + set str [ string repeat $char $num ] + } + return $str + } +} + +if {$::textutil::repeat::HaveBuiltin} { + proc ::textutil::repeat::strRepeat {char num} { + return [string repeat $char $num] + } + + proc ::textutil::repeat::blank {n} { + return [string repeat " " $n] + } +} else { + proc ::textutil::repeat::strRepeat {char num} { + if {$num <= 0} { + # No replication required + return "" + } elseif {$num == 1} { + # Quick exit for recursion + return $char + } elseif {$num == 2} { + # Another quick exit for recursion + return $char$char + } elseif {0 == ($num % 2)} { + # Halving the problem results in O (log n) complexity. + set result [strRepeat $char [expr {$num / 2}]] + return "$result$result" + } else { + # Uneven length, reduce problem by one + return "$char[strRepeat $char [incr num -1]]" + } + } + + proc ::textutil::repeat::blank {n} { + return [strRepeat " " $n] + } +} + +# ### ### ### ######### ######### ######### +## Data structures + +namespace eval ::textutil::repeat { + namespace export strRepeat blank +} + +# ### ### ### ######### ######### ######### +## Ready + +package provide textutil::repeat 0.7 diff --git a/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/split-0.8.tm b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/split-0.8.tm new file mode 100644 index 0000000..18ee13b --- /dev/null +++ b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/split-0.8.tm @@ -0,0 +1,176 @@ +# split.tcl -- +# +# Various ways of splitting a string. +# +# Copyright (c) 2000 by Ajuba Solutions. +# Copyright (c) 2000 by Eric Melski +# Copyright (c) 2001 by Reinhard Max +# Copyright (c) 2003 by Pat Thoyts +# Copyright (c) 2001-2006 by Andreas Kupries +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: split.tcl,v 1.7 2006/04/21 04:42:28 andreas_kupries Exp $ + +# ### ### ### ######### ######### ######### +## Requirements + +package require Tcl 8.2 + +namespace eval ::textutil::split {} + +######################################################################## +# This one was written by Bob Techentin (RWT in Tcl'ers Wiki): +# http://www.techentin.net +# mailto:techentin.robert@mayo.edu +# +# Later, he send me an email stated that I can use it anywhere, because +# no copyright was added, so the code is defacto in the public domain. +# +# You can found it in the Tcl'ers Wiki here: +# http://mini.net/cgi-bin/wikit/460.html +# +# Bob wrote: +# If you need to split string into list using some more complicated rule +# than builtin split command allows, use following function. It mimics +# Perl split operator which allows regexp as element separator, but, +# like builtin split, it expects string to split as first arg and regexp +# as second (optional) By default, it splits by any amount of whitespace. +# Note that if you add parenthesis into regexp, parenthesed part of separator +# would be added into list as additional element. Just like in Perl. -- cary +# +# Speed improvement by Reinhard Max: +# Instead of repeatedly copying around the not yet matched part of the +# string, I use [regexp]'s -start option to restrict the match to that +# part. This reduces the complexity from something like O(n^1.5) to +# O(n). My test case for that was: +# +# foreach i {1 10 100 1000 10000} { +# set s [string repeat x $i] +# puts [time {splitx $s .}] +# } +# + +if {[package vsatisfies [package provide Tcl] 8.3]} { + + proc ::textutil::split::splitx {str {regexp {[\t \r\n]+}}} { + # Bugfix 476988 + if {[string length $str] == 0} { + return {} + } + if {[string length $regexp] == 0} { + return [::split $str ""] + } + if {[regexp $regexp {}]} { + return -code error \ + "splitting on regexp \"$regexp\" would cause infinite loop" + } + + set list {} + set start 0 + while {[regexp -start $start -indices -- $regexp $str match submatch]} { + foreach {subStart subEnd} $submatch break + foreach {matchStart matchEnd} $match break + incr matchStart -1 + incr matchEnd + lappend list [string range $str $start $matchStart] + if {$subStart >= $start} { + lappend list [string range $str $subStart $subEnd] + } + set start $matchEnd + } + lappend list [string range $str $start end] + return $list + } + +} else { + # For tcl <= 8.2 we do not have regexp -start... + proc ::textutil::split::splitx [list str [list regexp "\[\t \r\n\]+"]] { + + if {[string length $str] == 0} { + return {} + } + if {[string length $regexp] == 0} { + return [::split $str {}] + } + if {[regexp $regexp {}]} { + return -code error \ + "splitting on regexp \"$regexp\" would cause infinite loop" + } + + set list {} + while {[regexp -indices -- $regexp $str match submatch]} { + lappend list [string range $str 0 [expr {[lindex $match 0] -1}]] + if {[lindex $submatch 0] >= 0} { + lappend list [string range $str [lindex $submatch 0] \ + [lindex $submatch 1]] + } + set str [string range $str [expr {[lindex $match 1]+1}] end] + } + lappend list $str + return $list + } + +} + +# +# splitn -- +# +# splitn splits the string $str into chunks of length $len. These +# chunks are returned as a list. +# +# If $str really contains a ByteArray object (as retrieved from binary +# encoded channels) splitn must honor this by splitting the string +# into chunks of $len bytes. +# +# It is an error to call splitn with a nonpositive $len. +# +# If splitn is called with an empty string, it returns the empty list. +# +# If the length of $str is not an entire multiple of the chunk length, +# the last chunk in the generated list will be shorter than $len. +# +# The implementation presented here was given by Bryan Oakley, as +# part of a ``contest'' I staged on c.l.t in July 2004. I selected +# this version, as it does not rely on runtime generated code, is +# very fast for chunk size one, not too bad in all the other cases, +# and uses [split] or [string range] which have been around for quite +# some time. +# +# -- Robert Suetterlin (robert@mpe.mpg.de) +# +proc ::textutil::split::splitn {str {len 1}} { + + if {$len <= 0} { + return -code error "len must be > 0" + } + + if {$len == 1} { + return [split $str {}] + } + + set result [list] + set max [string length $str] + set i 0 + set j [expr {$len -1}] + while {$i < $max} { + lappend result [string range $str $i $j] + incr i $len + incr j $len + } + + return $result +} + +# ### ### ### ######### ######### ######### +## Data structures + +namespace eval ::textutil::split { + namespace export splitx splitn +} + +# ### ### ### ######### ######### ######### +## Ready + +package provide textutil::split 0.8 diff --git a/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/string-0.8.tm b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/string-0.8.tm new file mode 100644 index 0000000..f1ad5a4 --- /dev/null +++ b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/string-0.8.tm @@ -0,0 +1,144 @@ +# string.tcl -- +# +# Utilities for manipulating strings, words, single lines, +# paragraphs, ... +# +# Copyright (c) 2000 by Ajuba Solutions. +# Copyright (c) 2000 by Eric Melski +# Copyright (c) 2002 by Joe English +# Copyright (c) 2001-2014 by Andreas Kupries +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: string.tcl,v 1.2 2008/03/22 16:03:11 mic42 Exp $ + +# ### ### ### ######### ######### ######### +## Requirements + +package require Tcl 8.2 + +namespace eval ::textutil::string {} + +# ### ### ### ######### ######### ######### +## API implementation + +# @c Removes the last character from the given . +# +# @a string: The string to manipulate. +# +# @r The without its last character. +# +# @i chopping + +proc ::textutil::string::chop {string} { + return [string range $string 0 [expr {[string length $string]-2}]] +} + +# @c Removes the first character from the given . +# @c Convenience procedure. +# +# @a string: string to manipulate. +# +# @r The without its first character. +# +# @i tail + +proc ::textutil::string::tail {string} { + return [string range $string 1 end] +} + +# @c Capitalizes first character of the given . +# @c Complementary procedure to

. +# +# @a string: string to manipulate. +# +# @r The with its first character capitalized. +# +# @i capitalize + +proc ::textutil::string::cap {string} { + return [string toupper [string index $string 0]][string range $string 1 end] +} + +# @c unCapitalizes first character of the given . +# @c Complementary procedure to

. +# +# @a string: string to manipulate. +# +# @r The with its first character uncapitalized. +# +# @i uncapitalize + +proc ::textutil::string::uncap {string} { + return [string tolower [string index $string 0]][string range $string 1 end] +} + +# @c Capitalizes first character of each word of the given . +# +# @a sentence: string to manipulate. +# +# @r The with the first character of each word capitalized. +# +# @i capitalize + +proc ::textutil::string::capEachWord {sentence} { + regsub -all {\S+} [string map {\\ \\\\ \$ \\$} $sentence] {[string toupper [string index & 0]][string range & 1 end]} cmd + return [subst -nobackslashes -novariables $cmd] +} + +# Compute the longest string which is common to all strings given to +# the command, and at the beginning of said strings, i.e. a prefix. If +# only one argument is specified it is treated as a list of the +# strings to look at. If more than one argument is specified these +# arguments are the strings to be looked at. If only one string is +# given, in either form, the string is returned, as it is its own +# longest common prefix. + +proc ::textutil::string::longestCommonPrefix {args} { + return [longestCommonPrefixList $args] +} + +proc ::textutil::string::longestCommonPrefixList {list} { + if {[llength $list] <= 1} { + return [lindex $list 0] + } + + set list [lsort $list] + set min [lindex $list 0] + set max [lindex $list end] + + # Min and max are the two strings which are most different. If + # they have a common prefix, it will also be the common prefix for + # all of them. + + # Fast bailouts for common cases. + + set n [string length $min] + if {$n == 0} {return ""} + if {0 == [string compare $min $max]} {return $min} + + set prefix "" + set i 0 + while {[string index $min $i] == [string index $max $i]} { + append prefix [string index $min $i] + if {[incr i] > $n} {break} + } + set prefix +} + +# ### ### ### ######### ######### ######### +## Data structures + +namespace eval ::textutil::string { + # Export the imported commands + + namespace export chop tail cap uncap capEachWord + namespace export longestCommonPrefix + namespace export longestCommonPrefixList +} + +# ### ### ### ######### ######### ######### +## Ready + +package provide textutil::string 0.8 diff --git a/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/tabify-0.7.tm b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/tabify-0.7.tm new file mode 100644 index 0000000..543b96c --- /dev/null +++ b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/tabify-0.7.tm @@ -0,0 +1,289 @@ +# +# As the author of the procs 'tabify2' and 'untabify2' I suggest that the +# comments explaining their behaviour be kept in this file. +# 1) Beginners in any programming language (I am new to Tcl so I know what I +# am talking about) can profit enormously from studying 'correct' code. +# Of course comments will help a lot in this regard. +# 2) Many problems newbies face can be solved by directing them towards +# available libraries - after all, libraries have been written to solve +# recurring problems. Then they can just use them, or have a closer look +# to see and to discover how things are done the 'Tcl way'. +# 3) And if ever a proc from a library should be less than perfect, having +# comments explaining the behaviour of the code will surely help. +# +# This said, I will welcome any error reports or suggestions for improvements +# (especially on the 'doing things the Tcl way' aspect). +# +# Use of these sources is licensed under the same conditions as is Tcl. +# +# June 2001, Helmut Giese (hgiese@ratiosoft.com) +# +# ---------------------------------------------------------------------------- +# +# The original procs 'tabify' and 'untabify' each work with complete blocks +# of $num spaces ('num' holding the tab size). While this is certainly useful +# in some circumstances, it does not reflect the way an editor works: +# Counting columns from 1, assuming a tab size of 8 and entering '12345' +# followed by a tab, you expect to advance to column 9. Your editor might +# put a tab into the file or 3 spaces, depending on its configuration. +# Now, on 'tabifying' you will expect to see those 3 spaces converted to a +# tab (and on the other hand expect the tab *at this position* to be +# converted to 3 spaces). +# +# This behaviour is mimicked by the new procs 'tabify2' and 'untabify2'. +# Both have one feature in common: They accept multi-line strings (a whole +# file if you want to) but in order to make life simpler for the programmer, +# they split the incoming string into individual lines and hand each line to +# a proc that does the real work. +# +# One design decision worth mentioning here: +# A single space is never converted to a tab even if its position would +# allow to do so. +# Single spaces occur very often, say in arithmetic expressions like +# [expr (($a + $b) * $c) < $d]. If we didn't follow the above rule we might +# need to replace one or more of them to tabs. However if the tab size gets +# changed, this expression would be formatted quite differently - which is +# probably not a good idea. +# +# 'untabifying' on the other hand might need to replace a tab with a single +# space: If the current position requires it, what else to do? +# As a consequence those two procs are unsymmetric in this aspect, but I +# couldn't think of a better solution. Could you? +# +# ---------------------------------------------------------------------------- +# + +# ### ### ### ######### ######### ######### +## Requirements + +package require Tcl 8.2 +package require textutil::repeat + +namespace eval ::textutil::tabify {} + +# ### ### ### ######### ######### ######### +## API implementation + +namespace eval ::textutil::tabify { + namespace import -force ::textutil::repeat::strRepeat +} + +proc ::textutil::tabify::tabify { string { num 8 } } { + return [string map [list [MakeTabStr $num] \t] $string] +} + +proc ::textutil::tabify::untabify { string { num 8 } } { + return [string map [list \t [MakeTabStr $num]] $string] +} + +proc ::textutil::tabify::MakeTabStr { num } { + variable TabStr + variable TabLen + + if { $TabLen != $num } then { + set TabLen $num + set TabStr [strRepeat " " $num] + } + + return $TabStr +} + +# ---------------------------------------------------------------------------- +# +# tabifyLine: Works on a single line of text, replacing 'spaces at correct +# positions' with tabs. $num is the requested tab size. +# Returns the (possibly modified) line. +# +# 'spaces at correct positions': Only spaces which 'fill the space' between +# an arbitrary position and the next tab stop can be replaced. +# Example: With tab size 8, spaces at positions 11 - 13 will *not* be replaced, +# because an expansion of a tab at position 11 will jump up to 16. +# See also the comment at the beginning of this file why single spaces are +# *never* replaced by a tab. +# +# The proc works backwards, from the end of the string up to the beginning: +# - Set the position to start the search from ('lastPos') to 'end'. +# - Find the last occurrence of ' ' in 'line' with respect to 'lastPos' +# ('currPos' below). This is a candidate for replacement. +# - Find to 'currPos' the following tab stop using the expression +# set nextTab [expr ($currPos + $num) - ($currPos % $num)] +# and get the previous tab stop as well (this will be the starting +# point for the next iteration). +# - The ' ' at 'currPos' is only a candidate for replacement if +# 1) it is just one position before a tab stop *and* +# 2) there is at least one space at its left (see comment above on not +# touching an isolated space). +# Continue, if any of these conditions is not met. +# - Determine where to put the tab (that is: how many spaces to replace?) +# by stepping up to the beginning until +# -- you hit a non-space or +# -- you are at the previous tab position +# - Do the replacement and continue. +# +# This algorithm only works, if $line does not contain tabs. Otherwise our +# interpretation of any position beyond the tab will be wrong. (Imagine you +# find a ' ' at position 4 in $line. If you got 3 leading tabs, your *real* +# position might be 25 (tab size of 8). Since in real life some strings might +# already contain tabs, we test for it (and eventually call untabifyLine). +# + +proc ::textutil::tabify::tabifyLine { line num } { + if { [string first \t $line] != -1 } { + # assure array 'Spaces' is set up 'comme il faut' + checkArr $num + # remove existing tabs + set line [untabifyLine $line $num] + } + + set lastPos end + + while { $lastPos > 0 } { + set currPos [string last " " $line $lastPos] + if { $currPos == -1 } { + # no more spaces + break; + } + + set nextTab [expr {($currPos + $num) - ($currPos % $num)}] + set prevTab [expr {$nextTab - $num}] + + # prepare for next round: continue at 'previous tab stop - 1' + set lastPos [expr {$prevTab - 1}] + + if { ($currPos + 1) != $nextTab } { + continue ;# crit. (1) + } + + if { [string index $line [expr {$currPos - 1}]] != " " } { + continue ;# crit. (2) + } + + # now step backwards while there are spaces + for {set pos [expr {$currPos - 2}]} {$pos >= $prevTab} {incr pos -1} { + if { [string index $line $pos] != " " } { + break; + } + } + + # ... and replace them + set line [string replace $line [expr {$pos + 1}] $currPos \t] + } + return $line +} + +# +# Helper proc for 'untabifyLine': Checks if all needed elements of array +# 'Spaces' exist and creates the missing ones if needed. +# + +proc ::textutil::tabify::checkArr { num } { + variable TabLen2 + variable Spaces + + if { $num > $TabLen2 } { + for { set i [expr {$TabLen2 + 1}] } { $i <= $num } { incr i } { + set Spaces($i) [strRepeat " " $i] + } + set TabLen2 $num + } +} + + +# untabifyLine: Works on a single line of text, replacing tabs with enough +# spaces to get to the next tab position. +# Returns the (possibly modified) line. +# +# The procedure is straight forward: +# - Find the next tab. +# - Calculate the next tab position following it. +# - Delete the tab and insert as many spaces as needed to get there. +# + +proc ::textutil::tabify::untabifyLine { line num } { + variable Spaces + + set currPos 0 + while { 1 } { + set currPos [string first \t $line $currPos] + if { $currPos == -1 } { + # no more tabs + break + } + + # how far is the next tab position ? + set dist [expr {$num - ($currPos % $num)}] + # replace '\t' at $currPos with $dist spaces + set line [string replace $line $currPos $currPos $Spaces($dist)] + + # set up for next round (not absolutely necessary but maybe a trifle + # more efficient) + incr currPos $dist + } + return $line +} + +# tabify2: Replace all 'appropriate' spaces as discussed above with tabs. +# 'string' might hold any number of lines, 'num' is the requested tab size. +# Returns (possibly modified) 'string'. +# +proc ::textutil::tabify::tabify2 { string { num 8 } } { + + # split string into individual lines + set inLst [split $string \n] + + # now work on each line + set outLst [list] + foreach line $inLst { + lappend outLst [tabifyLine $line $num] + } + + # return all as one string + return [join $outLst \n] +} + + +# untabify2: Replace all tabs with the appropriate number of spaces. +# 'string' might hold any number of lines, 'num' is the requested tab size. +# Returns (possibly modified) 'string'. +# +proc ::textutil::tabify::untabify2 { string { num 8 } } { + + # assure array 'Spaces' is set up 'comme il faut' + checkArr $num + + set inLst [split $string \n] + + set outLst [list] + foreach line $inLst { + lappend outLst [untabifyLine $line $num] + } + + return [join $outLst \n] +} + + + +# ### ### ### ######### ######### ######### +## Data structures + +namespace eval ::textutil::tabify { + variable TabLen 8 + variable TabStr [strRepeat " " $TabLen] + + namespace export tabify untabify tabify2 untabify2 + + # The proc 'untabify2' uses the following variables for efficiency. + # Since a tab can be replaced by one up to 'tab size' spaces, it is handy + # to have the appropriate 'space strings' available. This is the use of + # the array 'Spaces', where 'Spaces(n)' contains just 'n' spaces. + # The variable 'TabLen2' remembers the biggest tab size used. + + variable TabLen2 0 + variable Spaces + array set Spaces {0 ""} +} + +# ### ### ### ######### ######### ######### +## Ready + +package provide textutil::tabify 0.7 diff --git a/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/trim-0.7.tm b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/trim-0.7.tm new file mode 100644 index 0000000..4aab076 --- /dev/null +++ b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/trim-0.7.tm @@ -0,0 +1,112 @@ +# trim.tcl -- +# +# Various ways of trimming a string. +# +# Copyright (c) 2000 by Ajuba Solutions. +# Copyright (c) 2000 by Eric Melski +# Copyright (c) 2001-2006 by Andreas Kupries +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: trim.tcl,v 1.5 2006/04/21 04:42:28 andreas_kupries Exp $ + +# ### ### ### ######### ######### ######### +## Requirements + +package require Tcl 8.2 + +namespace eval ::textutil::trim {} + +# ### ### ### ######### ######### ######### +## API implementation + +proc ::textutil::trim::trimleft {text {trim "[ \t]+"}} { + regsub -line -all -- [MakeStr $trim left] $text {} text + return $text +} + +proc ::textutil::trim::trimright {text {trim "[ \t]+"}} { + regsub -line -all -- [MakeStr $trim right] $text {} text + return $text +} + +proc ::textutil::trim::trim {text {trim "[ \t]+"}} { + regsub -line -all -- [MakeStr $trim left] $text {} text + regsub -line -all -- [MakeStr $trim right] $text {} text + return $text +} + + + +# @c Strips from , if found at its start. +# +# @a text: The string to check for . +# @a prefix: The string to remove from . +# +# @r The , but without . +# +# @i remove, prefix + +proc ::textutil::trim::trimPrefix {text prefix} { + if {[string first $prefix $text] == 0} { + return [string range $text [string length $prefix] end] + } else { + return $text + } +} + + +# @c Removes the Heading Empty Lines of . +# +# @a text: The text block to manipulate. +# +# @r The , but without heading empty lines. +# +# @i remove, empty lines + +proc ::textutil::trim::trimEmptyHeading {text} { + regsub -- "^(\[ \t\]*\n)*" $text {} text + return $text +} + +# ### ### ### ######### ######### ######### +## Helper commands. Internal + +proc ::textutil::trim::MakeStr { string pos } { + variable StrU + variable StrR + variable StrL + + if { "$string" != "$StrU" } { + set StrU $string + set StrR "(${StrU})\$" + set StrL "^(${StrU})" + } + if { "$pos" == "left" } { + return $StrL + } + if { "$pos" == "right" } { + return $StrR + } + + return -code error "Panic, illegal position key \"$pos\"" +} + +# ### ### ### ######### ######### ######### +## Data structures + +namespace eval ::textutil::trim { + variable StrU "\[ \t\]+" + variable StrR "(${StrU})\$" + variable StrL "^(${StrU})" + + namespace export \ + trim trimright trimleft \ + trimPrefix trimEmptyHeading +} + +# ### ### ### ######### ######### ######### +## Ready + +package provide textutil::trim 0.7 diff --git a/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/wcswidth-35.1.tm b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/wcswidth-35.1.tm new file mode 100644 index 0000000..080a881 --- /dev/null +++ b/src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/textutil/wcswidth-35.1.tm @@ -0,0 +1,772 @@ +### +# This file is automatically generated by the build/build.tcl file +# based on information in the following database: +# http://www.unicode.org/Public/UCD/latest/ucd/EastAsianWidth.txt +# +# (This is the 35th edition, thus version 35 for our package) +# +# Author: Sean Woods +### +package provide textutil::wcswidth 35.1 +proc ::textutil::wcswidth_type char { + if {$char == 161} { return A } + if {$char == 164} { return A } + if {$char == 167} { return A } + if {$char == 168} { return A } + if {$char == 170} { return A } + if {$char == 173} { return A } + if {$char == 174} { return A } + if {$char == 176} { return A } + if {$char == 177} { return A } + if {$char >= 178 && $char <= 179 } { return A } + if {$char == 180} { return A } + if {$char >= 182 && $char <= 183 } { return A } + if {$char == 184} { return A } + if {$char == 185} { return A } + if {$char == 186} { return A } + if {$char >= 188 && $char <= 190 } { return A } + if {$char == 191} { return A } + if {$char == 198} { return A } + if {$char == 208} { return A } + if {$char == 215} { return A } + if {$char == 216} { return A } + if {$char >= 222 && $char <= 225 } { return A } + if {$char == 230} { return A } + if {$char >= 232 && $char <= 234 } { return A } + if {$char >= 236 && $char <= 237 } { return A } + if {$char == 240} { return A } + if {$char >= 242 && $char <= 243 } { return A } + if {$char == 247} { return A } + if {$char >= 248 && $char <= 250 } { return A } + if {$char == 252} { return A } + if {$char == 254} { return A } + if {$char == 257} { return A } + if {$char == 273} { return A } + if {$char == 275} { return A } + if {$char == 283} { return A } + if {$char >= 294 && $char <= 295 } { return A } + if {$char == 299} { return A } + if {$char >= 305 && $char <= 307 } { return A } + if {$char == 312} { return A } + if {$char >= 319 && $char <= 322 } { return A } + if {$char == 324} { return A } + if {$char >= 328 && $char <= 331 } { return A } + if {$char == 333} { return A } + if {$char >= 338 && $char <= 339 } { return A } + if {$char >= 358 && $char <= 359 } { return A } + if {$char == 363} { return A } + if {$char == 462} { return A } + if {$char == 464} { return A } + if {$char == 466} { return A } + if {$char == 468} { return A } + if {$char == 470} { return A } + if {$char == 472} { return A } + if {$char == 474} { return A } + if {$char == 476} { return A } + if {$char == 593} { return A } + if {$char == 609} { return A } + if {$char == 708} { return A } + if {$char == 711} { return A } + if {$char >= 713 && $char <= 715 } { return A } + if {$char == 717} { return A } + if {$char == 720} { return A } + if {$char >= 728 && $char <= 731 } { return A } + if {$char == 733} { return A } + if {$char == 735} { return A } + if {$char >= 768 && $char <= 879 } { return A } + if {$char >= 913 && $char <= 929 } { return A } + if {$char >= 931 && $char <= 937 } { return A } + if {$char >= 945 && $char <= 961 } { return A } + if {$char >= 963 && $char <= 969 } { return A } + if {$char == 1025} { return A } + if {$char >= 1040 && $char <= 1103 } { return A } + if {$char == 1105} { return A } + if {$char >= 4352 && $char <= 4447 } { return W } + if {$char == 8208} { return A } + if {$char >= 8211 && $char <= 8213 } { return A } + if {$char == 8214} { return A } + if {$char == 8216} { return A } + if {$char == 8217} { return A } + if {$char == 8220} { return A } + if {$char == 8221} { return A } + if {$char >= 8224 && $char <= 8226 } { return A } + if {$char >= 8228 && $char <= 8231 } { return A } + if {$char == 8240} { return A } + if {$char >= 8242 && $char <= 8243 } { return A } + if {$char == 8245} { return A } + if {$char == 8251} { return A } + if {$char == 8254} { return A } + if {$char == 8308} { return A } + if {$char == 8319} { return A } + if {$char >= 8321 && $char <= 8324 } { return A } + if {$char == 8361} { return H } + if {$char == 8364} { return A } + if {$char == 8451} { return A } + if {$char == 8453} { return A } + if {$char == 8457} { return A } + if {$char == 8467} { return A } + if {$char == 8470} { return A } + if {$char >= 8481 && $char <= 8482 } { return A } + if {$char == 8486} { return A } + if {$char == 8491} { return A } + if {$char >= 8531 && $char <= 8532 } { return A } + if {$char >= 8539 && $char <= 8542 } { return A } + if {$char >= 8544 && $char <= 8555 } { return A } + if {$char >= 8560 && $char <= 8569 } { return A } + if {$char == 8585} { return A } + if {$char >= 8592 && $char <= 8596 } { return A } + if {$char >= 8597 && $char <= 8601 } { return A } + if {$char >= 8632 && $char <= 8633 } { return A } + if {$char == 8658} { return A } + if {$char == 8660} { return A } + if {$char == 8679} { return A } + if {$char == 8704} { return A } + if {$char >= 8706 && $char <= 8707 } { return A } + if {$char >= 8711 && $char <= 8712 } { return A } + if {$char == 8715} { return A } + if {$char == 8719} { return A } + if {$char == 8721} { return A } + if {$char == 8725} { return A } + if {$char == 8730} { return A } + if {$char >= 8733 && $char <= 8736 } { return A } + if {$char == 8739} { return A } + if {$char == 8741} { return A } + if {$char >= 8743 && $char <= 8748 } { return A } + if {$char == 8750} { return A } + if {$char >= 8756 && $char <= 8759 } { return A } + if {$char >= 8764 && $char <= 8765 } { return A } + if {$char == 8776} { return A } + if {$char == 8780} { return A } + if {$char == 8786} { return A } + if {$char >= 8800 && $char <= 8801 } { return A } + if {$char >= 8804 && $char <= 8807 } { return A } + if {$char >= 8810 && $char <= 8811 } { return A } + if {$char >= 8814 && $char <= 8815 } { return A } + if {$char >= 8834 && $char <= 8835 } { return A } + if {$char >= 8838 && $char <= 8839 } { return A } + if {$char == 8853} { return A } + if {$char == 8857} { return A } + if {$char == 8869} { return A } + if {$char == 8895} { return A } + if {$char == 8978} { return A } + if {$char >= 8986 && $char <= 8987 } { return W } + if {$char == 9001} { return W } + if {$char == 9002} { return W } + if {$char >= 9193 && $char <= 9196 } { return W } + if {$char == 9200} { return W } + if {$char == 9203} { return W } + if {$char >= 9312 && $char <= 9371 } { return A } + if {$char >= 9372 && $char <= 9449 } { return A } + if {$char >= 9451 && $char <= 9471 } { return A } + if {$char >= 9472 && $char <= 9547 } { return A } + if {$char >= 9552 && $char <= 9587 } { return A } + if {$char >= 9600 && $char <= 9615 } { return A } + if {$char >= 9618 && $char <= 9621 } { return A } + if {$char >= 9632 && $char <= 9633 } { return A } + if {$char >= 9635 && $char <= 9641 } { return A } + if {$char >= 9650 && $char <= 9651 } { return A } + if {$char == 9654} { return A } + if {$char == 9655} { return A } + if {$char >= 9660 && $char <= 9661 } { return A } + if {$char == 9664} { return A } + if {$char == 9665} { return A } + if {$char >= 9670 && $char <= 9672 } { return A } + if {$char == 9675} { return A } + if {$char >= 9678 && $char <= 9681 } { return A } + if {$char >= 9698 && $char <= 9701 } { return A } + if {$char == 9711} { return A } + if {$char >= 9725 && $char <= 9726 } { return W } + if {$char >= 9733 && $char <= 9734 } { return A } + if {$char == 9737} { return A } + if {$char >= 9742 && $char <= 9743 } { return A } + if {$char >= 9748 && $char <= 9749 } { return W } + if {$char == 9756} { return A } + if {$char == 9758} { return A } + if {$char == 9792} { return A } + if {$char == 9794} { return A } + if {$char >= 9800 && $char <= 9811 } { return W } + if {$char >= 9824 && $char <= 9825 } { return A } + if {$char >= 9827 && $char <= 9829 } { return A } + if {$char >= 9831 && $char <= 9834 } { return A } + if {$char >= 9836 && $char <= 9837 } { return A } + if {$char == 9839} { return A } + if {$char == 9855} { return W } + if {$char == 9875} { return W } + if {$char >= 9886 && $char <= 9887 } { return A } + if {$char == 9889} { return W } + if {$char >= 9898 && $char <= 9899 } { return W } + if {$char >= 9917 && $char <= 9918 } { return W } + if {$char == 9919} { return A } + if {$char >= 9924 && $char <= 9925 } { return W } + if {$char >= 9926 && $char <= 9933 } { return A } + if {$char == 9934} { return W } + if {$char >= 9935 && $char <= 9939 } { return A } + if {$char == 9940} { return W } + if {$char >= 9941 && $char <= 9953 } { return A } + if {$char == 9955} { return A } + if {$char >= 9960 && $char <= 9961 } { return A } + if {$char == 9962} { return W } + if {$char >= 9963 && $char <= 9969 } { return A } + if {$char >= 9970 && $char <= 9971 } { return W } + if {$char == 9972} { return A } + if {$char == 9973} { return W } + if {$char >= 9974 && $char <= 9977 } { return A } + if {$char == 9978} { return W } + if {$char >= 9979 && $char <= 9980 } { return A } + if {$char == 9981} { return W } + if {$char >= 9982 && $char <= 9983 } { return A } + if {$char == 9989} { return W } + if {$char >= 9994 && $char <= 9995 } { return W } + if {$char == 10024} { return W } + if {$char == 10045} { return A } + if {$char == 10060} { return W } + if {$char == 10062} { return W } + if {$char >= 10067 && $char <= 10069 } { return W } + if {$char == 10071} { return W } + if {$char >= 10102 && $char <= 10111 } { return A } + if {$char >= 10133 && $char <= 10135 } { return W } + if {$char == 10160} { return W } + if {$char == 10175} { return W } + if {$char >= 11035 && $char <= 11036 } { return W } + if {$char == 11088} { return W } + if {$char == 11093} { return W } + if {$char >= 11094 && $char <= 11097 } { return A } + if {$char >= 11904 && $char <= 11929 } { return W } + if {$char >= 11931 && $char <= 12019 } { return W } + if {$char >= 12032 && $char <= 12245 } { return W } + if {$char >= 12272 && $char <= 12283 } { return W } + if {$char == 12288} { return F } + if {$char >= 12289 && $char <= 12291 } { return W } + if {$char == 12292} { return W } + if {$char == 12293} { return W } + if {$char == 12294} { return W } + if {$char == 12295} { return W } + if {$char == 12296} { return W } + if {$char == 12297} { return W } + if {$char == 12298} { return W } + if {$char == 12299} { return W } + if {$char == 12300} { return W } + if {$char == 12301} { return W } + if {$char == 12302} { return W } + if {$char == 12303} { return W } + if {$char == 12304} { return W } + if {$char == 12305} { return W } + if {$char >= 12306 && $char <= 12307 } { return W } + if {$char == 12308} { return W } + if {$char == 12309} { return W } + if {$char == 12310} { return W } + if {$char == 12311} { return W } + if {$char == 12312} { return W } + if {$char == 12313} { return W } + if {$char == 12314} { return W } + if {$char == 12315} { return W } + if {$char == 12316} { return W } + if {$char == 12317} { return W } + if {$char >= 12318 && $char <= 12319 } { return W } + if {$char == 12320} { return W } + if {$char >= 12321 && $char <= 12329 } { return W } + if {$char >= 12330 && $char <= 12333 } { return W } + if {$char >= 12334 && $char <= 12335 } { return W } + if {$char == 12336} { return W } + if {$char >= 12337 && $char <= 12341 } { return W } + if {$char >= 12342 && $char <= 12343 } { return W } + if {$char >= 12344 && $char <= 12346 } { return W } + if {$char == 12347} { return W } + if {$char == 12348} { return W } + if {$char == 12349} { return W } + if {$char == 12350} { return W } + if {$char >= 12353 && $char <= 12438 } { return W } + if {$char >= 12441 && $char <= 12442 } { return W } + if {$char >= 12443 && $char <= 12444 } { return W } + if {$char >= 12445 && $char <= 12446 } { return W } + if {$char == 12447} { return W } + if {$char == 12448} { return W } + if {$char >= 12449 && $char <= 12538 } { return W } + if {$char == 12539} { return W } + if {$char >= 12540 && $char <= 12542 } { return W } + if {$char == 12543} { return W } + if {$char >= 12549 && $char <= 12591 } { return W } + if {$char >= 12593 && $char <= 12686 } { return W } + if {$char >= 12688 && $char <= 12689 } { return W } + if {$char >= 12690 && $char <= 12693 } { return W } + if {$char >= 12694 && $char <= 12703 } { return W } + if {$char >= 12704 && $char <= 12730 } { return W } + if {$char >= 12736 && $char <= 12771 } { return W } + if {$char >= 12784 && $char <= 12799 } { return W } + if {$char >= 12800 && $char <= 12830 } { return W } + if {$char >= 12832 && $char <= 12841 } { return W } + if {$char >= 12842 && $char <= 12871 } { return W } + if {$char >= 12872 && $char <= 12879 } { return A } + if {$char == 12880} { return W } + if {$char >= 12881 && $char <= 12895 } { return W } + if {$char >= 12896 && $char <= 12927 } { return W } + if {$char >= 12928 && $char <= 12937 } { return W } + if {$char >= 12938 && $char <= 12976 } { return W } + if {$char >= 12977 && $char <= 12991 } { return W } + if {$char >= 12992 && $char <= 13054 } { return W } + if {$char >= 13056 && $char <= 13311 } { return W } + if {$char >= 13312 && $char <= 19893 } { return W } + if {$char >= 19894 && $char <= 19903 } { return W } + if {$char >= 19968 && $char <= 40943 } { return W } + if {$char >= 40944 && $char <= 40959 } { return W } + if {$char >= 40960 && $char <= 40980 } { return W } + if {$char == 40981} { return W } + if {$char >= 40982 && $char <= 42124 } { return W } + if {$char >= 42128 && $char <= 42182 } { return W } + if {$char >= 43360 && $char <= 43388 } { return W } + if {$char >= 44032 && $char <= 55203 } { return W } + if {$char >= 57344 && $char <= 63743 } { return A } + if {$char >= 63744 && $char <= 64109 } { return W } + if {$char >= 64110 && $char <= 64111 } { return W } + if {$char >= 64112 && $char <= 64217 } { return W } + if {$char >= 64218 && $char <= 64255 } { return W } + if {$char >= 65024 && $char <= 65039 } { return A } + if {$char >= 65040 && $char <= 65046 } { return W } + if {$char == 65047} { return W } + if {$char == 65048} { return W } + if {$char == 65049} { return W } + if {$char == 65072} { return W } + if {$char >= 65073 && $char <= 65074 } { return W } + if {$char >= 65075 && $char <= 65076 } { return W } + if {$char == 65077} { return W } + if {$char == 65078} { return W } + if {$char == 65079} { return W } + if {$char == 65080} { return W } + if {$char == 65081} { return W } + if {$char == 65082} { return W } + if {$char == 65083} { return W } + if {$char == 65084} { return W } + if {$char == 65085} { return W } + if {$char == 65086} { return W } + if {$char == 65087} { return W } + if {$char == 65088} { return W } + if {$char == 65089} { return W } + if {$char == 65090} { return W } + if {$char == 65091} { return W } + if {$char == 65092} { return W } + if {$char >= 65093 && $char <= 65094 } { return W } + if {$char == 65095} { return W } + if {$char == 65096} { return W } + if {$char >= 65097 && $char <= 65100 } { return W } + if {$char >= 65101 && $char <= 65103 } { return W } + if {$char >= 65104 && $char <= 65106 } { return W } + if {$char >= 65108 && $char <= 65111 } { return W } + if {$char == 65112} { return W } + if {$char == 65113} { return W } + if {$char == 65114} { return W } + if {$char == 65115} { return W } + if {$char == 65116} { return W } + if {$char == 65117} { return W } + if {$char == 65118} { return W } + if {$char >= 65119 && $char <= 65121 } { return W } + if {$char == 65122} { return W } + if {$char == 65123} { return W } + if {$char >= 65124 && $char <= 65126 } { return W } + if {$char == 65128} { return W } + if {$char == 65129} { return W } + if {$char >= 65130 && $char <= 65131 } { return W } + if {$char >= 65281 && $char <= 65283 } { return F } + if {$char == 65284} { return F } + if {$char >= 65285 && $char <= 65287 } { return F } + if {$char == 65288} { return F } + if {$char == 65289} { return F } + if {$char == 65290} { return F } + if {$char == 65291} { return F } + if {$char == 65292} { return F } + if {$char == 65293} { return F } + if {$char >= 65294 && $char <= 65295 } { return F } + if {$char >= 65296 && $char <= 65305 } { return F } + if {$char >= 65306 && $char <= 65307 } { return F } + if {$char >= 65308 && $char <= 65310 } { return F } + if {$char >= 65311 && $char <= 65312 } { return F } + if {$char >= 65313 && $char <= 65338 } { return F } + if {$char == 65339} { return F } + if {$char == 65340} { return F } + if {$char == 65341} { return F } + if {$char == 65342} { return F } + if {$char == 65343} { return F } + if {$char == 65344} { return F } + if {$char >= 65345 && $char <= 65370 } { return F } + if {$char == 65371} { return F } + if {$char == 65372} { return F } + if {$char == 65373} { return F } + if {$char == 65374} { return F } + if {$char == 65375} { return F } + if {$char == 65376} { return F } + if {$char == 65377} { return H } + if {$char == 65378} { return H } + if {$char == 65379} { return H } + if {$char >= 65380 && $char <= 65381 } { return H } + if {$char >= 65382 && $char <= 65391 } { return H } + if {$char == 65392} { return H } + if {$char >= 65393 && $char <= 65437 } { return H } + if {$char >= 65438 && $char <= 65439 } { return H } + if {$char >= 65440 && $char <= 65470 } { return H } + if {$char >= 65474 && $char <= 65479 } { return H } + if {$char >= 65482 && $char <= 65487 } { return H } + if {$char >= 65490 && $char <= 65495 } { return H } + if {$char >= 65498 && $char <= 65500 } { return H } + if {$char >= 65504 && $char <= 65505 } { return F } + if {$char == 65506} { return F } + if {$char == 65507} { return F } + if {$char == 65508} { return F } + if {$char >= 65509 && $char <= 65510 } { return F } + if {$char == 65512} { return H } + if {$char >= 65513 && $char <= 65516 } { return H } + if {$char >= 65517 && $char <= 65518 } { return H } + if {$char == 65533} { return A } + if {$char >= 94176 && $char <= 94177 } { return W } + if {$char >= 94208 && $char <= 100337 } { return W } + if {$char >= 100352 && $char <= 101106 } { return W } + if {$char >= 110592 && $char <= 110847 } { return W } + if {$char >= 110848 && $char <= 110878 } { return W } + if {$char >= 110960 && $char <= 111355 } { return W } + if {$char == 126980} { return W } + if {$char == 127183} { return W } + if {$char >= 127232 && $char <= 127242 } { return A } + if {$char >= 127248 && $char <= 127277 } { return A } + if {$char >= 127280 && $char <= 127337 } { return A } + if {$char >= 127344 && $char <= 127373 } { return A } + if {$char == 127374} { return W } + if {$char >= 127375 && $char <= 127376 } { return A } + if {$char >= 127377 && $char <= 127386 } { return W } + if {$char >= 127387 && $char <= 127404 } { return A } + if {$char >= 127488 && $char <= 127490 } { return W } + if {$char >= 127504 && $char <= 127547 } { return W } + if {$char >= 127552 && $char <= 127560 } { return W } + if {$char >= 127568 && $char <= 127569 } { return W } + if {$char >= 127584 && $char <= 127589 } { return W } + if {$char >= 127744 && $char <= 127776 } { return W } + if {$char >= 127789 && $char <= 127797 } { return W } + if {$char >= 127799 && $char <= 127868 } { return W } + if {$char >= 127870 && $char <= 127891 } { return W } + if {$char >= 127904 && $char <= 127946 } { return W } + if {$char >= 127951 && $char <= 127955 } { return W } + if {$char >= 127968 && $char <= 127984 } { return W } + if {$char == 127988} { return W } + if {$char >= 127992 && $char <= 127994 } { return W } + if {$char >= 127995 && $char <= 127999 } { return W } + if {$char >= 128000 && $char <= 128062 } { return W } + if {$char == 128064} { return W } + if {$char >= 128066 && $char <= 128252 } { return W } + if {$char >= 128255 && $char <= 128317 } { return W } + if {$char >= 128331 && $char <= 128334 } { return W } + if {$char >= 128336 && $char <= 128359 } { return W } + if {$char == 128378} { return W } + if {$char >= 128405 && $char <= 128406 } { return W } + if {$char == 128420} { return W } + if {$char >= 128507 && $char <= 128511 } { return W } + if {$char >= 128512 && $char <= 128591 } { return W } + if {$char >= 128640 && $char <= 128709 } { return W } + if {$char == 128716} { return W } + if {$char >= 128720 && $char <= 128722 } { return W } + if {$char >= 128747 && $char <= 128748 } { return W } + if {$char >= 128756 && $char <= 128761 } { return W } + if {$char >= 129296 && $char <= 129342 } { return W } + if {$char >= 129344 && $char <= 129392 } { return W } + if {$char >= 129395 && $char <= 129398 } { return W } + if {$char == 129402} { return W } + if {$char >= 129404 && $char <= 129442 } { return W } + if {$char >= 129456 && $char <= 129465 } { return W } + if {$char >= 129472 && $char <= 129474 } { return W } + if {$char >= 129488 && $char <= 129535 } { return W } + if {$char >= 131072 && $char <= 173782 } { return W } + if {$char >= 173783 && $char <= 173823 } { return W } + if {$char >= 173824 && $char <= 177972 } { return W } + if {$char >= 177973 && $char <= 177983 } { return W } + if {$char >= 177984 && $char <= 178205 } { return W } + if {$char >= 178206 && $char <= 178207 } { return W } + if {$char >= 178208 && $char <= 183969 } { return W } + if {$char >= 183970 && $char <= 183983 } { return W } + if {$char >= 183984 && $char <= 191456 } { return W } + if {$char >= 191457 && $char <= 194559 } { return W } + if {$char >= 194560 && $char <= 195101 } { return W } + if {$char >= 195102 && $char <= 195103 } { return W } + if {$char >= 195104 && $char <= 196605 } { return W } + if {$char >= 196608 && $char <= 262141 } { return W } + if {$char >= 917760 && $char <= 917999 } { return A } + if {$char >= 983040 && $char <= 1048573 } { return A } + if {$char >= 1048576 && $char <= 1114109 } { return A } + return N +} +proc ::textutil::wcswidth_char char { + if {$char >= 4352 && $char <= 4447 } { return 2 } + if {$char >= 8986 && $char <= 8987 } { return 2 } + if {$char == 9001} { return 2 } + if {$char == 9002} { return 2 } + if {$char >= 9193 && $char <= 9196 } { return 2 } + if {$char == 9200} { return 2 } + if {$char == 9203} { return 2 } + if {$char >= 9725 && $char <= 9726 } { return 2 } + if {$char >= 9748 && $char <= 9749 } { return 2 } + if {$char >= 9800 && $char <= 9811 } { return 2 } + if {$char == 9855} { return 2 } + if {$char == 9875} { return 2 } + if {$char == 9889} { return 2 } + if {$char >= 9898 && $char <= 9899 } { return 2 } + if {$char >= 9917 && $char <= 9918 } { return 2 } + if {$char >= 9924 && $char <= 9925 } { return 2 } + if {$char == 9934} { return 2 } + if {$char == 9940} { return 2 } + if {$char == 9962} { return 2 } + if {$char >= 9970 && $char <= 9971 } { return 2 } + if {$char == 9973} { return 2 } + if {$char == 9978} { return 2 } + if {$char == 9981} { return 2 } + if {$char == 9989} { return 2 } + if {$char >= 9994 && $char <= 9995 } { return 2 } + if {$char == 10024} { return 2 } + if {$char == 10060} { return 2 } + if {$char == 10062} { return 2 } + if {$char >= 10067 && $char <= 10069 } { return 2 } + if {$char == 10071} { return 2 } + if {$char >= 10133 && $char <= 10135 } { return 2 } + if {$char == 10160} { return 2 } + if {$char == 10175} { return 2 } + if {$char >= 11035 && $char <= 11036 } { return 2 } + if {$char == 11088} { return 2 } + if {$char == 11093} { return 2 } + if {$char >= 11904 && $char <= 11929 } { return 2 } + if {$char >= 11931 && $char <= 12019 } { return 2 } + if {$char >= 12032 && $char <= 12245 } { return 2 } + if {$char >= 12272 && $char <= 12283 } { return 2 } + if {$char == 12288} { return 2 } + if {$char >= 12289 && $char <= 12291 } { return 2 } + if {$char == 12292} { return 2 } + if {$char == 12293} { return 2 } + if {$char == 12294} { return 2 } + if {$char == 12295} { return 2 } + if {$char == 12296} { return 2 } + if {$char == 12297} { return 2 } + if {$char == 12298} { return 2 } + if {$char == 12299} { return 2 } + if {$char == 12300} { return 2 } + if {$char == 12301} { return 2 } + if {$char == 12302} { return 2 } + if {$char == 12303} { return 2 } + if {$char == 12304} { return 2 } + if {$char == 12305} { return 2 } + if {$char >= 12306 && $char <= 12307 } { return 2 } + if {$char == 12308} { return 2 } + if {$char == 12309} { return 2 } + if {$char == 12310} { return 2 } + if {$char == 12311} { return 2 } + if {$char == 12312} { return 2 } + if {$char == 12313} { return 2 } + if {$char == 12314} { return 2 } + if {$char == 12315} { return 2 } + if {$char == 12316} { return 2 } + if {$char == 12317} { return 2 } + if {$char >= 12318 && $char <= 12319 } { return 2 } + if {$char == 12320} { return 2 } + if {$char >= 12321 && $char <= 12329 } { return 2 } + if {$char >= 12330 && $char <= 12333 } { return 2 } + if {$char >= 12334 && $char <= 12335 } { return 2 } + if {$char == 12336} { return 2 } + if {$char >= 12337 && $char <= 12341 } { return 2 } + if {$char >= 12342 && $char <= 12343 } { return 2 } + if {$char >= 12344 && $char <= 12346 } { return 2 } + if {$char == 12347} { return 2 } + if {$char == 12348} { return 2 } + if {$char == 12349} { return 2 } + if {$char == 12350} { return 2 } + if {$char >= 12353 && $char <= 12438 } { return 2 } + if {$char >= 12441 && $char <= 12442 } { return 2 } + if {$char >= 12443 && $char <= 12444 } { return 2 } + if {$char >= 12445 && $char <= 12446 } { return 2 } + if {$char == 12447} { return 2 } + if {$char == 12448} { return 2 } + if {$char >= 12449 && $char <= 12538 } { return 2 } + if {$char == 12539} { return 2 } + if {$char >= 12540 && $char <= 12542 } { return 2 } + if {$char == 12543} { return 2 } + if {$char >= 12549 && $char <= 12591 } { return 2 } + if {$char >= 12593 && $char <= 12686 } { return 2 } + if {$char >= 12688 && $char <= 12689 } { return 2 } + if {$char >= 12690 && $char <= 12693 } { return 2 } + if {$char >= 12694 && $char <= 12703 } { return 2 } + if {$char >= 12704 && $char <= 12730 } { return 2 } + if {$char >= 12736 && $char <= 12771 } { return 2 } + if {$char >= 12784 && $char <= 12799 } { return 2 } + if {$char >= 12800 && $char <= 12830 } { return 2 } + if {$char >= 12832 && $char <= 12841 } { return 2 } + if {$char >= 12842 && $char <= 12871 } { return 2 } + if {$char == 12880} { return 2 } + if {$char >= 12881 && $char <= 12895 } { return 2 } + if {$char >= 12896 && $char <= 12927 } { return 2 } + if {$char >= 12928 && $char <= 12937 } { return 2 } + if {$char >= 12938 && $char <= 12976 } { return 2 } + if {$char >= 12977 && $char <= 12991 } { return 2 } + if {$char >= 12992 && $char <= 13054 } { return 2 } + if {$char >= 13056 && $char <= 13311 } { return 2 } + if {$char >= 13312 && $char <= 19893 } { return 2 } + if {$char >= 19894 && $char <= 19903 } { return 2 } + if {$char >= 19968 && $char <= 40943 } { return 2 } + if {$char >= 40944 && $char <= 40959 } { return 2 } + if {$char >= 40960 && $char <= 40980 } { return 2 } + if {$char == 40981} { return 2 } + if {$char >= 40982 && $char <= 42124 } { return 2 } + if {$char >= 42128 && $char <= 42182 } { return 2 } + if {$char >= 43360 && $char <= 43388 } { return 2 } + if {$char >= 44032 && $char <= 55203 } { return 2 } + if {$char >= 63744 && $char <= 64109 } { return 2 } + if {$char >= 64110 && $char <= 64111 } { return 2 } + if {$char >= 64112 && $char <= 64217 } { return 2 } + if {$char >= 64218 && $char <= 64255 } { return 2 } + if {$char >= 65040 && $char <= 65046 } { return 2 } + if {$char == 65047} { return 2 } + if {$char == 65048} { return 2 } + if {$char == 65049} { return 2 } + if {$char == 65072} { return 2 } + if {$char >= 65073 && $char <= 65074 } { return 2 } + if {$char >= 65075 && $char <= 65076 } { return 2 } + if {$char == 65077} { return 2 } + if {$char == 65078} { return 2 } + if {$char == 65079} { return 2 } + if {$char == 65080} { return 2 } + if {$char == 65081} { return 2 } + if {$char == 65082} { return 2 } + if {$char == 65083} { return 2 } + if {$char == 65084} { return 2 } + if {$char == 65085} { return 2 } + if {$char == 65086} { return 2 } + if {$char == 65087} { return 2 } + if {$char == 65088} { return 2 } + if {$char == 65089} { return 2 } + if {$char == 65090} { return 2 } + if {$char == 65091} { return 2 } + if {$char == 65092} { return 2 } + if {$char >= 65093 && $char <= 65094 } { return 2 } + if {$char == 65095} { return 2 } + if {$char == 65096} { return 2 } + if {$char >= 65097 && $char <= 65100 } { return 2 } + if {$char >= 65101 && $char <= 65103 } { return 2 } + if {$char >= 65104 && $char <= 65106 } { return 2 } + if {$char >= 65108 && $char <= 65111 } { return 2 } + if {$char == 65112} { return 2 } + if {$char == 65113} { return 2 } + if {$char == 65114} { return 2 } + if {$char == 65115} { return 2 } + if {$char == 65116} { return 2 } + if {$char == 65117} { return 2 } + if {$char == 65118} { return 2 } + if {$char >= 65119 && $char <= 65121 } { return 2 } + if {$char == 65122} { return 2 } + if {$char == 65123} { return 2 } + if {$char >= 65124 && $char <= 65126 } { return 2 } + if {$char == 65128} { return 2 } + if {$char == 65129} { return 2 } + if {$char >= 65130 && $char <= 65131 } { return 2 } + if {$char >= 65281 && $char <= 65283 } { return 2 } + if {$char == 65284} { return 2 } + if {$char >= 65285 && $char <= 65287 } { return 2 } + if {$char == 65288} { return 2 } + if {$char == 65289} { return 2 } + if {$char == 65290} { return 2 } + if {$char == 65291} { return 2 } + if {$char == 65292} { return 2 } + if {$char == 65293} { return 2 } + if {$char >= 65294 && $char <= 65295 } { return 2 } + if {$char >= 65296 && $char <= 65305 } { return 2 } + if {$char >= 65306 && $char <= 65307 } { return 2 } + if {$char >= 65308 && $char <= 65310 } { return 2 } + if {$char >= 65311 && $char <= 65312 } { return 2 } + if {$char >= 65313 && $char <= 65338 } { return 2 } + if {$char == 65339} { return 2 } + if {$char == 65340} { return 2 } + if {$char == 65341} { return 2 } + if {$char == 65342} { return 2 } + if {$char == 65343} { return 2 } + if {$char == 65344} { return 2 } + if {$char >= 65345 && $char <= 65370 } { return 2 } + if {$char == 65371} { return 2 } + if {$char == 65372} { return 2 } + if {$char == 65373} { return 2 } + if {$char == 65374} { return 2 } + if {$char == 65375} { return 2 } + if {$char == 65376} { return 2 } + if {$char >= 65504 && $char <= 65505 } { return 2 } + if {$char == 65506} { return 2 } + if {$char == 65507} { return 2 } + if {$char == 65508} { return 2 } + if {$char >= 65509 && $char <= 65510 } { return 2 } + if {$char >= 94176 && $char <= 94177 } { return 2 } + if {$char >= 94208 && $char <= 100337 } { return 2 } + if {$char >= 100352 && $char <= 101106 } { return 2 } + if {$char >= 110592 && $char <= 110847 } { return 2 } + if {$char >= 110848 && $char <= 110878 } { return 2 } + if {$char >= 110960 && $char <= 111355 } { return 2 } + if {$char == 126980} { return 2 } + if {$char == 127183} { return 2 } + if {$char == 127374} { return 2 } + if {$char >= 127377 && $char <= 127386 } { return 2 } + if {$char >= 127488 && $char <= 127490 } { return 2 } + if {$char >= 127504 && $char <= 127547 } { return 2 } + if {$char >= 127552 && $char <= 127560 } { return 2 } + if {$char >= 127568 && $char <= 127569 } { return 2 } + if {$char >= 127584 && $char <= 127589 } { return 2 } + if {$char >= 127744 && $char <= 127776 } { return 2 } + if {$char >= 127789 && $char <= 127797 } { return 2 } + if {$char >= 127799 && $char <= 127868 } { return 2 } + if {$char >= 127870 && $char <= 127891 } { return 2 } + if {$char >= 127904 && $char <= 127946 } { return 2 } + if {$char >= 127951 && $char <= 127955 } { return 2 } + if {$char >= 127968 && $char <= 127984 } { return 2 } + if {$char == 127988} { return 2 } + if {$char >= 127992 && $char <= 127994 } { return 2 } + if {$char >= 127995 && $char <= 127999 } { return 2 } + if {$char >= 128000 && $char <= 128062 } { return 2 } + if {$char == 128064} { return 2 } + if {$char >= 128066 && $char <= 128252 } { return 2 } + if {$char >= 128255 && $char <= 128317 } { return 2 } + if {$char >= 128331 && $char <= 128334 } { return 2 } + if {$char >= 128336 && $char <= 128359 } { return 2 } + if {$char == 128378} { return 2 } + if {$char >= 128405 && $char <= 128406 } { return 2 } + if {$char == 128420} { return 2 } + if {$char >= 128507 && $char <= 128511 } { return 2 } + if {$char >= 128512 && $char <= 128591 } { return 2 } + if {$char >= 128640 && $char <= 128709 } { return 2 } + if {$char == 128716} { return 2 } + if {$char >= 128720 && $char <= 128722 } { return 2 } + if {$char >= 128747 && $char <= 128748 } { return 2 } + if {$char >= 128756 && $char <= 128761 } { return 2 } + if {$char >= 129296 && $char <= 129342 } { return 2 } + if {$char >= 129344 && $char <= 129392 } { return 2 } + if {$char >= 129395 && $char <= 129398 } { return 2 } + if {$char == 129402} { return 2 } + if {$char >= 129404 && $char <= 129442 } { return 2 } + if {$char >= 129456 && $char <= 129465 } { return 2 } + if {$char >= 129472 && $char <= 129474 } { return 2 } + if {$char >= 129488 && $char <= 129535 } { return 2 } + if {$char >= 131072 && $char <= 173782 } { return 2 } + if {$char >= 173783 && $char <= 173823 } { return 2 } + if {$char >= 173824 && $char <= 177972 } { return 2 } + if {$char >= 177973 && $char <= 177983 } { return 2 } + if {$char >= 177984 && $char <= 178205 } { return 2 } + if {$char >= 178206 && $char <= 178207 } { return 2 } + if {$char >= 178208 && $char <= 183969 } { return 2 } + if {$char >= 183970 && $char <= 183983 } { return 2 } + if {$char >= 183984 && $char <= 191456 } { return 2 } + if {$char >= 191457 && $char <= 194559 } { return 2 } + if {$char >= 194560 && $char <= 195101 } { return 2 } + if {$char >= 195102 && $char <= 195103 } { return 2 } + if {$char >= 195104 && $char <= 196605 } { return 2 } + if {$char >= 196608 && $char <= 262141 } { return 2 } + return 1 +} + +proc ::textutil::wcswidth {string} { + set width 0 + set len [string length $string] + foreach c [split $string {}] { + scan $c %c char + set n [::textutil::wcswidth_char $char] + if {$n < 0} { + return -1 + } + incr width $n + } + return $width +} + diff --git a/src/modules/punk/mix/templates/layouts/project/src/make.tcl b/src/modules/punk/mix/templates/layouts/project/src/make.tcl index 547b880..c01c977 100644 --- a/src/modules/punk/mix/templates/layouts/project/src/make.tcl +++ b/src/modules/punk/mix/templates/layouts/project/src/make.tcl @@ -378,7 +378,7 @@ if {$::punkmake::command eq "bootsupport"} { set project_layouts [glob -nocomplain -dir $project_layout_base -type d -tail *] foreach layoutname $project_layouts { if {[file exists [file join $project_layout_base $layoutname/src/bootsupport]]} { - set unpublish [list\ + set antipaths [list\ README.md\ ] set sourcemodules $projectroot/src/bootsupport/modules @@ -386,7 +386,7 @@ if {$::punkmake::command eq "bootsupport"} { file mkdir $targetroot puts stdout "BOOTSUPPORT layouts/$layoutname: copying from $sourcemodules to $targetroot (if source file changed)" - set resultdict [punkcheck::install $sourcemodules $targetroot -overwrite installedsourcechanged-targets -unpublish_paths $unpublish] + set resultdict [punkcheck::install $sourcemodules $targetroot -overwrite installedsourcechanged-targets -antiglob_paths $antipaths] puts stdout [punkcheck::summarize_install_resultdict $resultdict] flush stdout } @@ -420,17 +420,17 @@ file mkdir $target_modules_base #external libs and modules first - and any supporting files - no 'building' required if {[file exists $sourcefolder/vendorlib]} { - #unpublish README.md from source folder - but only the root one - #-unpublish_paths takes relative patterns e.g + #exclude README.md from source folder - but only the root one + #-antiglob_paths takes relative patterns e.g # */test.txt will only match test.txt exactly one level deep. # */*/*.foo will match any path ending in .foo that is exactly 2 levels deep. # **/test.txt will match at any level below the root (but not in the root) - set unpublish [list\ + set antipaths [list\ README.md\ ] puts stdout "VENDORLIB: copying from $sourcefolder/vendorlib to $projectroot/lib (if source file changed)" - set resultdict [punkcheck::install $sourcefolder/vendorlib $projectroot/lib -overwrite installedsourcechanged-targets -unpublish_paths $unpublish] + set resultdict [punkcheck::install $sourcefolder/vendorlib $projectroot/lib -overwrite installedsourcechanged-targets -antiglob_paths $antipaths] puts stdout [punkcheck::summarize_install_resultdict $resultdict] } else { @@ -440,7 +440,7 @@ if {[file exists $sourcefolder/vendorlib]} { if {[file exists $sourcefolder/vendormodules]} { #install .tm *and other files* puts stdout "VENDORMODULES: copying from $sourcefolder/vendormodules to $target_modules_base (if source file changed)" - set resultdict [punkcheck::install $sourcefolder/vendormodules $target_modules_base -installer make.tcl -overwrite installedsourcechanged-targets -unpublish_paths {README.md}] + set resultdict [punkcheck::install $sourcefolder/vendormodules $target_modules_base -installer make.tcl -overwrite installedsourcechanged-targets -antiglob_paths {README.md}] puts stdout [punkcheck::summarize_install_resultdict $resultdict] } else { puts stderr "VENDORMODULES: No src/vendormodules folder found." @@ -526,7 +526,7 @@ foreach src_module_dir $source_module_folderlist { set overwrite "installedsourcechanged-targets" #set overwrite "ALL-TARGETS" puts stdout "MODULEFOLDER non_tm_files $src_module_dir - copying to $target_modules_base (if source file changed)" - set resultdict [punkcheck::install_non_tm_files $src_module_dir $target_modules_base -installer make.tcl -overwrite $overwrite -unpublish_paths {README.md}] + set resultdict [punkcheck::install_non_tm_files $src_module_dir $target_modules_base -installer make.tcl -overwrite $overwrite -antiglob_paths {README.md}] puts stdout [punkcheck::summarize_install_resultdict $resultdict] } diff --git a/src/modules/punk/mix/templates/modules/template_module-0.0.1.tm b/src/modules/punk/mix/templates/modules/template_module-0.0.1.tm index 65547b4..f40434f 100644 --- a/src/modules/punk/mix/templates/modules/template_module-0.0.1.tm +++ b/src/modules/punk/mix/templates/modules/template_module-0.0.1.tm @@ -13,35 +13,141 @@ # @@ Meta End +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# doctools header +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[manpage_begin %pkg% 0 999999.0a1.0] +#[copyright "%year%"] +#[titledesc {Module API}] +#[moddesc {-}] +#[require %pkg%] +#[description] +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + +#*** !doctools +#[section Overview] +#[para] overview of %pkg% +#[subsection Concepts] +#[para] - + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Requirements -##e.g package require frobz +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[subsection dependencies] +#[para] packages used by %pkg% +#[list_begin itemized] +package require Tcl 8.6 +#*** !doctools +#[item] [package Tcl 8.6] +##package require frobz +##*** !doctools +##[item] [package frobz] +#*** !doctools +#[list_end] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section API] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# oo::class namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval %pkg%::class { + #*** !doctools + #[subsection {Namespace %pkg%::class}] + #[para] class definitions + if {[info commands [namespace current]::interface_sample1] eq ""} { + #*** !doctools + #[list_begin enumerated] + + oo::class create interface_sample1 { + #*** !doctools + #[enum] [emph {CLASS interface_sample1}] + #[list_begin definitions] + + method test {arg1} { + #*** !doctools + #[call class::[class interface_sample1] [method test] [arg arg1]] + #[para] test method + puts "test: $arg1" + } + + #*** !doctools + #[list_end] [comment {-- end definitions interface_sample1}] + } + + #*** !doctools + #[list_end] [comment {--- end class enumeration ---}] + } +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Base namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ namespace eval %pkg% { + namespace export * + #variable xyz + + #*** !doctools + #[subsection {Namespace %pkg%}] + #[para] Core API functions for %pkg% + #[list_begin definitions] + -} + #[list_end] [comment {--- end definitions namespace %pkg% ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Secondary API namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval %pkg%::lib { + namespace export * + namespace path [namespace parent] + #*** !doctools + #[subsection {Namespace %pkg%::lib}] + #[para] Secondary functions that are part of the API + #[list_begin definitions] + #*** !doctools + #[list_end] [comment {--- end definitions namespace %pkg%::lib ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[section Internal] +namespace eval %pkg%::system { + #*** !doctools + #[subsection {Namespace %pkg%::system}] + #[para] Internal functions that are not part of the API +} # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide %pkg% [namespace eval %pkg% { @@ -49,4 +155,8 @@ package provide %pkg% [namespace eval %pkg% { variable version set version 999999.0a1.0 }] -return \ No newline at end of file +return + +#*** !doctools +#[manpage_end] + diff --git a/src/modules/punkcheck-0.1.0.tm b/src/modules/punkcheck-0.1.0.tm index 41d8759..0dc9523 100644 --- a/src/modules/punkcheck-0.1.0.tm +++ b/src/modules/punkcheck-0.1.0.tm @@ -1078,7 +1078,7 @@ namespace eval punkcheck { } proc install_non_tm_files {srcdir basedir args} { #set keys [dict keys $args] - #adjust the default anti_glob_dir_core entries so that .fossil-custom, .fossil-settings are copied + #adjust the default antiglob_dir_core entries so that .fossil-custom, .fossil-settings are copied set antiglob_dir_core [punkcheck::default_antiglob_dir_core] set posn [lsearch $antiglob_dir_core ".fossil*"] if {$posn >=0} { @@ -1168,7 +1168,7 @@ namespace eval punkcheck { -antiglob_file "" \ -antiglob_dir_core "\uFFFF"\ -antiglob_dir {}\ - -unpublish_paths {}\ + -antiglob_paths {}\ -overwrite no-targets\ -source_checksum comparestore\ -punkcheck_folder target\ @@ -1225,8 +1225,8 @@ namespace eval punkcheck { # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_antiglob_dir [dict get $opts -antiglob_dir] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- - set opt_unpublish_paths [dict get $opts -unpublish_paths] ;#todo - combine with config file in source tree .punkcheckpublish (?) - set unpublish_paths_matched [list] + set opt_antiglob_paths [dict get $opts -antiglob_paths] ;#todo - combine with config file in source tree .punkcheckpublish (?) + set antiglob_paths_matched [list] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set known_whats [list no-targets newer-targets older-targets all-targets installedsourcechanged-targets synced-targets] set overwrite_what [string tolower [dict get $opts -overwrite]]; #accept any case for value to allow emphasis by caller e.g -overwrite NEWER-TARGETS @@ -1347,11 +1347,11 @@ namespace eval punkcheck { if {$target_relative_to_punkcheck_dir eq "."} { set target_relative_to_punkcheck_dir "" } - foreach unpub $opt_unpublish_paths { + foreach unpub $opt_antiglob_paths { #puts "testing folder - globmatchpath $unpub $relative_source_dir" if {[globmatchpath $unpub $relative_source_dir]} { - lappend unpublish_paths_matched $current_source_dir - return [list files_copied {} files_skipped {} sources_unchanged {} punkcheck_records $punkcheck_records unpublish_paths_matched $unpublish_paths_matched srcdir $srcdir tgtdir $tgtdir punkcheck_folder $punkcheck_folder] + lappend antiglob_paths_matched $current_source_dir + return [list files_copied {} files_skipped {} sources_unchanged {} punkcheck_records $punkcheck_records antiglob_paths_matched $antiglob_paths_matched srcdir $srcdir tgtdir $tgtdir punkcheck_folder $punkcheck_folder] } } @@ -1418,16 +1418,16 @@ namespace eval punkcheck { set relative_target_path [file join $relative_target_dir $m] set relative_source_path [file join $relative_source_dir $m] set punkcheck_target_relpath [file join $target_relative_to_punkcheck_dir $m] - set is_unpublished 0 - foreach unpub $opt_unpublish_paths { - #puts "testing file - globmatchpath $unpub vs $relative_source_path" - if {[globmatchpath $unpub $relative_source_path]} { - lappend unpublish_paths_matched $current_source_dir - set is_unpublished 1 + set is_antipath 0 + foreach antipath $opt_antiglob_paths { + #puts "testing file - globmatchpath $antipath vs $relative_source_path" + if {[globmatchpath $antipath $relative_source_path]} { + lappend antiglob_paths_matched $current_source_dir + set is_antipath 1 break } } - if {$is_unpublished} { + if {$is_antipath} { continue } #puts stdout " checking file : $current_source_dir/$m" @@ -1642,7 +1642,7 @@ namespace eval punkcheck { lappend files_copied {*}[dict get $sub_result files_copied] lappend files_skipped {*}[dict get $sub_result files_skipped] lappend sources_unchanged {*}[dict get $sub_result sources_unchanged] - lappend unpublish_paths_matched {*}[dict get $sub_result unpublish_paths_matched] + lappend antiglob_paths_matched {*}[dict get $sub_result antiglob_paths_matched] set punkcheck_records [dict get $sub_result punkcheck_records] } @@ -1664,7 +1664,7 @@ namespace eval punkcheck { } } - return [list files_copied $files_copied files_skipped $files_skipped sources_unchanged $sources_unchanged unpublish_paths_matched $unpublish_paths_matched punkcheck_records $punkcheck_records punkcheck_folder $punkcheck_folder srcdir $srcdir tgtdir $tgtdir] + return [list files_copied $files_copied files_skipped $files_skipped sources_unchanged $sources_unchanged antiglob_paths_matched $antiglob_paths_matched punkcheck_records $punkcheck_records punkcheck_folder $punkcheck_folder srcdir $srcdir tgtdir $tgtdir] } proc summarize_install_resultdict {resultdict} { set msg ""