exec tclsh "$0" "$@"
proc parseHTML text {
puts stderr "\nparseHTML: Original Text\n$text"
regsub -all {[][{}\\]} $text {\\&} text
set whiteSpace "\[ \n\t\r\]"
set whiteSpaces "${whiteSpace}*"
set whiteSpaces1 "${whiteSpace}+"
set name {[a-zA-Z][-_:a-zA-Z0-9]*}
set tagName "/?$name"
set attrName $name
set value1 '\[^'\]*'
set value2 \"\[^\"\]*\"
set value3 "\[^ \n\r\t>\]*"
set value "($value1|$value2|$value3)"
set attrValue "${whiteSpaces1}${attrName}=${value}"
set attrList "($attrValue)*"
set htmlTag "<($tagName)($attrList)${whiteSpaces}>"
puts stderr "\nparseHTML: der regulaere Ausdruck fuer tags\n$htmlTag"
set subst "\}\ntransHTMLtag {\\1} {\\2} \{"
puts stderr "\nparseHTML: der Ersetzungstext fuer die tags\n$subst"
regsub -all $htmlTag $text $subst text
puts stderr "\nparseHTML: der editierte text\n$text"
set text "transHTMLtag {} {} \{$text\}"
puts stderr "\nparseHTML: das Resultat\n$text"
return $text
}
proc transHTMLtag {tag attr text} {
global result
set tag [string tolower $tag]
set attr [subst -novariables -nocommands $attr]
set text [subst -novariables -nocommands $text]
set prcname transTag_$tag
if {"[info procs $prcname]" == "$prcname"} {
append result [$prcname $attr]
} else {
append result "<${tag}${attr}>"
}
append result $text
}
proc transHTMLtext text {
global result
set result ""
eval [parseHTML $text]
return $result
}
proc transTag_body attr {
return {<body style="background-color: black; color:
}
proc transTag_red attr {
return {<div style="color:
}
proc transTag_/red attr {
return {</div>}
}
proc transTag_ attr {
return {}
}
proc testTransHTML {} {
set text {
<html>
<head>
<title>ein Test</title>
</head>
<body>
<h1>ein Test</h1>
<red>eine ganz wichtige Seite</red>
<hr>
<address>
<a href="mailto:theo@muehle.welt.all">[theo]</a>
</address>
</body>
</html>
}
transHTMLtext $text
}
puts "Content-Type: text/html
[testTransHTML]"
