|
|
# ----------------------------------------------------------------------------
|
|
|
# "THE BEER-WARE LICENSE" (Revision 42) (by Poul-Henning Kamp):
|
|
|
# Joerg Wunsch <j.gnu@uriah.heep.sax.de> wrote this file. As long as you
|
|
|
# retain this notice you can do whatever you want with this stuff. If we meet
|
|
|
# some day, and you think this stuff is worth it, you can buy me a beer
|
|
|
# in return.
|
|
|
# ----------------------------------------------------------------------------
|
|
|
#
|
|
|
# $Id: htmlview.tcl,v 2.0 2006/03/21 21:22:15 joerg_wunsch Exp $
|
|
|
#
|
|
|
# This implements a simple HTML viewer that is just suitable to browse through
|
|
|
# a document generated by latex2html
|
|
|
#
|
|
|
|
|
|
proc htmlview {file} {
|
|
|
global htmlposx htmlposy
|
|
|
global tcl_platform
|
|
|
global helpicon
|
|
|
global tcl_platform
|
|
|
global bgcolor
|
|
|
|
|
|
if {$file == ""} {
|
|
|
return
|
|
|
}
|
|
|
|
|
|
set subtag ""
|
|
|
# determine requested subtag (if any)
|
|
|
if {[regexp "^(\[^\#\]*)\#(.*)" $file dummy match subtag]} {
|
|
|
set file $match
|
|
|
}
|
|
|
|
|
|
set f ""
|
|
|
catch {set f [open $file]}
|
|
|
if {$f == ""} {
|
|
|
return
|
|
|
}
|
|
|
|
|
|
set dirname [file dirname $file]
|
|
|
|
|
|
set ok 0
|
|
|
while {!$ok} {
|
|
|
set w ".htmlview[expr {int(rand()*30000)}]"
|
|
|
if {![winfo exists $w]} {
|
|
|
set ok 1
|
|
|
}
|
|
|
}
|
|
|
toplevel $w
|
|
|
if {[info exists htmlposx]} {
|
|
|
set htmlposx [expr $htmlposx + 10]
|
|
|
set htmlposy [expr $htmlposy + 10]
|
|
|
} else {
|
|
|
set htmlposx [expr [winfo x .] + 80]
|
|
|
set htmlposy [expr [winfo y .] + 50]
|
|
|
}
|
|
|
wm geometry $w "+$htmlposx+$htmlposy"
|
|
|
wm positionfrom $w user
|
|
|
|
|
|
frame $w.f0
|
|
|
text $w.f0.t1 -wrap word -yscrollcommand "$w.f0.sb1 set" \
|
|
|
-font {Helvetica -12} -cursor {top_left_arrow}
|
|
|
scrollbar $w.f0.sb1 -command "$w.f0.t1 yview"
|
|
|
frame $w.f1
|
|
|
button $w.f1.bok -text {Close} -command "destroy $w"
|
|
|
#button $w.f1.closeall -text {Hilfe beenden} -command {destroyhtmlwins}
|
|
|
pack $w.f0.t1 -side left -expand 1 -fill both
|
|
|
pack $w.f0.sb1 -side right -expand 0 -fill y
|
|
|
pack $w.f0 -side top -expand 1 -fill both
|
|
|
pack $w.f1.bok -side left
|
|
|
#pack $w.f1.closeall -side right
|
|
|
pack $w.f1 -side top
|
|
|
|
|
|
update
|
|
|
set x [winfo width $w]
|
|
|
set y [winfo height $w]
|
|
|
wm minsize $w $x $y
|
|
|
|
|
|
bind $w <Key-Prior> "$w.f0.t1 yview scroll -10 units"
|
|
|
bind $w <Key-Next> "$w.f0.t1 yview scroll 10 units"
|
|
|
bind $w <Key-space> "$w.f0.t1 yview scroll 10 units"
|
|
|
focus $w
|
|
|
|
|
|
set bgcolor [$w.f0.t1 cget -background]
|
|
|
|
|
|
if {$tcl_platform(platform) == "unix" && [file exists $helpicon]} {
|
|
|
wm iconbitmap $w @$helpicon
|
|
|
}
|
|
|
|
|
|
set buf ""; set head ""; set tail ""
|
|
|
set title ""
|
|
|
set list ""; set lcount {1}; set ullevel 0
|
|
|
set bold 0; set italic 0; set titlemode 0
|
|
|
set tagno 0; set attribs {}; set attrib ""; set justify "left"
|
|
|
set paraopen 0
|
|
|
set lmargin 0; set rmargin 0
|
|
|
set hrno 0; set bulletno 0; set imgno 0
|
|
|
set newlineput 0; set anchorhasmodifiedfont 0; set inheadline 0
|
|
|
|
|
|
while {1} {
|
|
|
# if $buf starts with a "<", it means we've got an unfinished yet
|
|
|
# tag in there, so we need to read more until the tag is finished
|
|
|
# and can be handled in full
|
|
|
if {$buf == "" || [string index $buf 0] == "<"} {
|
|
|
if {[gets $f lbuf] == -1} {
|
|
|
break
|
|
|
}
|
|
|
if {$lbuf == "" && !$inheadline} {
|
|
|
# single newline only, marks a paragraph break
|
|
|
set lbuf "<p>"
|
|
|
}
|
|
|
regsub -all {[\t ]+} $lbuf { } lbuf
|
|
|
if {[string index $lbuf end] != " "} {
|
|
|
set lbuf "$lbuf "
|
|
|
}
|
|
|
set buf "$buf$lbuf"
|
|
|
}
|
|
|
if {[set idx [string first "<" $buf]] != -1} {
|
|
|
set head [string range $buf 0 [expr $idx - 1]]
|
|
|
set tail [string range $buf $idx end]
|
|
|
} else {
|
|
|
set head $buf
|
|
|
set tail ""
|
|
|
}
|
|
|
if {[string length $head]} {
|
|
|
set head [untangletext $head]
|
|
|
if {$titlemode} {
|
|
|
set title "$title$head"
|
|
|
} else {
|
|
|
if {$attrib != ""} {
|
|
|
$w.f0.t1 insert end $head $attrib
|
|
|
} else {
|
|
|
$w.f0.t1 insert end $head
|
|
|
}
|
|
|
}
|
|
|
set head ""
|
|
|
}
|
|
|
if {[string length $tail]} {
|
|
|
if {[set idx [string first ">" $tail]] != -1} {
|
|
|
set tag [string range $tail 0 $idx]
|
|
|
set buf [string range $tail [expr $idx + 1] end]
|
|
|
set tag [string range $tag 1 end-1]
|
|
|
set tagname $tag
|
|
|
set remainder ""
|
|
|
regexp {^(/?[A-Za-z0-9]+) *(.*)} $tag dummy tagname remainder
|
|
|
set tagname [string tolower $tagname]
|
|
|
switch $tagname {
|
|
|
"br" {
|
|
|
$w.f0.t1 insert end "\n"
|
|
|
}
|
|
|
"p" {
|
|
|
if {$paraopen && $attrib != ""} {
|
|
|
set attrib [lindex $attribs end]
|
|
|
set attribs [lrange $attribs 0 end-1]
|
|
|
$w.f0.t1 tag add $attrib end
|
|
|
}
|
|
|
set align ""
|
|
|
while {1} {
|
|
|
set x [parsetag $remainder]
|
|
|
set name [string tolower [lindex $x 0]]
|
|
|
set val [lindex $x 1]
|
|
|
set remainder [lindex $x 2]
|
|
|
|
|
|
if {$name == ""} {
|
|
|
break
|
|
|
}
|
|
|
if {$name == "align"} {
|
|
|
set align [string tolower $val]
|
|
|
}
|
|
|
}
|
|
|
if {$align != ""} {
|
|
|
set justify "left"
|
|
|
switch $align {
|
|
|
"center" { set justify "center" }
|
|
|
"right" { set justify "right" }
|
|
|
}
|
|
|
incr tagno
|
|
|
lappend attribs $attrib
|
|
|
set attrib "attrib$tagno"
|
|
|
$w.f0.t1 tag add $attrib end
|
|
|
$w.f0.t1 tag configure $attrib -font {Helvetica -12 bold}
|
|
|
$w.f0.t1 tag configure $attrib -lmargin1 $lmargin -lmargin2 $lmargin \
|
|
|
-rmargin $rmargin -justify $justify
|
|
|
}
|
|
|
$w.f0.t1 insert end "\n"
|
|
|
set paraopen 1
|
|
|
}
|
|
|
"/p" {
|
|
|
set paraopen 0
|
|
|
if {$attrib != ""} {
|
|
|
set attrib [lindex $attribs end]
|
|
|
set attribs [lrange $attribs 0 end-1]
|
|
|
$w.f0.t1 tag add $attrib end
|
|
|
}
|
|
|
}
|
|
|
"title" {
|
|
|
set titlemode 1
|
|
|
set title ""
|
|
|
}
|
|
|
"/title" {
|
|
|
set titlemode 0
|
|
|
wm title $w $title
|
|
|
}
|
|
|
"b" {
|
|
|
incr tagno
|
|
|
lappend attribs $attrib
|
|
|
set attrib "attrib$tagno"
|
|
|
$w.f0.t1 tag add $attrib end
|
|
|
$w.f0.t1 tag configure $attrib -font {Helvetica -12 bold}
|
|
|
$w.f0.t1 tag configure $attrib -lmargin1 $lmargin -lmargin2 $lmargin \
|
|
|
-rmargin $rmargin -justify $justify
|
|
|
}
|
|
|
"/b" {
|
|
|
set attrib [lindex $attribs end]
|
|
|
set attribs [lrange $attribs 0 end-1]
|
|
|
$w.f0.t1 tag add $attrib end
|
|
|
}
|
|
|
"strong" {
|
|
|
incr tagno
|
|
|
lappend attribs $attrib
|
|
|
set attrib "attrib$tagno"
|
|
|
$w.f0.t1 tag add $attrib end
|
|
|
$w.f0.t1 tag configure $attrib -font {Helvetica -12 bold}
|
|
|
$w.f0.t1 tag configure $attrib -lmargin1 $lmargin -lmargin2 $lmargin \
|
|
|
-rmargin $rmargin -justify $justify
|
|
|
}
|
|
|
"/strong" {
|
|
|
set attrib [lindex $attribs end]
|
|
|
set attribs [lrange $attribs 0 end-1]
|
|
|
$w.f0.t1 tag add $attrib end
|
|
|
}
|
|
|
"i" {
|
|
|
incr tagno
|
|
|
lappend attribs $attrib
|
|
|
set attrib "attrib$tagno"
|
|
|
$w.f0.t1 tag add $attrib end
|
|
|
$w.f0.t1 tag configure $attrib -font {Helvetica -12 italic}
|
|
|
$w.f0.t1 tag configure $attrib -lmargin1 $lmargin -lmargin2 $lmargin \
|
|
|
-rmargin $rmargin -justify $justify
|
|
|
}
|
|
|
"/i" {
|
|
|
set attrib [lindex $attribs end]
|
|
|
set attribs [lrange $attribs 0 end-1]
|
|
|
$w.f0.t1 tag add $attrib end
|
|
|
}
|
|
|
"em" {
|
|
|
incr tagno
|
|
|
lappend attribs $attrib
|
|
|
set attrib "attrib$tagno"
|
|
|
$w.f0.t1 tag add $attrib end
|
|
|
$w.f0.t1 tag configure $attrib -font {Helvetica -12 italic}
|
|
|
$w.f0.t1 tag configure $attrib -lmargin1 $lmargin -lmargin2 $lmargin \
|
|
|
-rmargin $rmargin -justify $justify
|
|
|
}
|
|
|
"/em" {
|
|
|
set attrib [lindex $attribs end]
|
|
|
set attribs [lrange $attribs 0 end-1]
|
|
|
$w.f0.t1 tag add $attrib end
|
|
|
}
|
|
|
"tt" {
|
|
|
incr tagno
|
|
|
lappend attribs $attrib
|
|
|
set attrib "attrib$tagno"
|
|
|
$w.f0.t1 tag add $attrib end
|
|
|
$w.f0.t1 tag configure $attrib -font {Courier -12}
|
|
|
$w.f0.t1 tag configure $attrib -lmargin1 $lmargin -lmargin2 $lmargin \
|
|
|
-rmargin $rmargin -justify $justify
|
|
|
}
|
|
|
"/tt" {
|
|
|
set attrib [lindex $attribs end]
|
|
|
set attribs [lrange $attribs 0 end-1]
|
|
|
$w.f0.t1 tag add $attrib end
|
|
|
}
|
|
|
"h1" {
|
|
|
incr inheadline
|
|
|
incr tagno
|
|
|
lappend attribs $attrib
|
|
|
set attrib "attrib$tagno"
|
|
|
$w.f0.t1 tag add $attrib end
|
|
|
$w.f0.t1 tag configure $attrib -font {Times -18 bold}
|
|
|
$w.f0.t1 tag configure $attrib -lmargin1 $lmargin -lmargin2 $lmargin \
|
|
|
-rmargin $rmargin -justify $justify
|
|
|
}
|
|
|
"/h1" {
|
|
|
set inheadline [expr $inheadline - 1]
|
|
|
set attrib [lindex $attribs end]
|
|
|
set attribs [lrange $attribs 0 end-1]
|
|
|
$w.f0.t1 tag add $attrib end
|
|
|
$w.f0.t1 insert end "\n\n"
|
|
|
}
|
|
|
"h2" {
|
|
|
incr inheadline
|
|
|
incr tagno
|
|
|
lappend attribs $attrib
|
|
|
set attrib "attrib$tagno"
|
|
|
$w.f0.t1 tag add $attrib end
|
|
|
$w.f0.t1 tag configure $attrib -font {Times -16 bold}
|
|
|
$w.f0.t1 tag configure $attrib -lmargin1 $lmargin -lmargin2 $lmargin \
|
|
|
-rmargin $rmargin -justify $justify
|
|
|
}
|
|
|
"/h2" {
|
|
|
set inheadline [expr $inheadline - 1]
|
|
|
set attrib [lindex $attribs end]
|
|
|
set attribs [lrange $attribs 0 end-1]
|
|
|
$w.f0.t1 tag add $attrib end
|
|
|
$w.f0.t1 insert end "\n\n"
|
|
|
}
|
|
|
"h3" {
|
|
|
incr inheadline
|
|
|
incr tagno
|
|
|
lappend attribs $attrib
|
|
|
set attrib "attrib$tagno"
|
|
|
$w.f0.t1 tag add $attrib end
|
|
|
$w.f0.t1 tag configure $attrib -font {Times -14 bold}
|
|
|
$w.f0.t1 tag configure $attrib -lmargin1 $lmargin -lmargin2 $lmargin \
|
|
|
-rmargin $rmargin -justify $justify
|
|
|
}
|
|
|
"/h3" {
|
|
|
set inheadline [expr $inheadline - 1]
|
|
|
set attrib [lindex $attribs end]
|
|
|
set attribs [lrange $attribs 0 end-1]
|
|
|
$w.f0.t1 tag add $attrib end
|
|
|
$w.f0.t1 insert end "\n\n"
|
|
|
}
|
|
|
"h4" {
|
|
|
incr inheadline
|
|
|
incr tagno
|
|
|
lappend attribs $attrib
|
|
|
set attrib "attrib$tagno"
|
|
|
$w.f0.t1 tag add $attrib end
|
|
|
$w.f0.t1 tag configure $attrib -font {Times -12 bold}
|
|
|
$w.f0.t1 tag configure $attrib -lmargin1 $lmargin -lmargin2 $lmargin \
|
|
|
-rmargin $rmargin -justify $justify
|
|
|
}
|
|
|
"/h4" {
|
|
|
set inheadline [expr $inheadline - 1]
|
|
|
set attrib [lindex $attribs end]
|
|
|
set attribs [lrange $attribs 0 end-1]
|
|
|
$w.f0.t1 tag add $attrib end
|
|
|
$w.f0.t1 insert end "\n\n"
|
|
|
}
|
|
|
"a" {
|
|
|
set target ""
|
|
|
while {1} {
|
|
|
set x [parsetag $remainder]
|
|
|
set name [string tolower [lindex $x 0]]
|
|
|
set val [lindex $x 1]
|
|
|
set remainder [lindex $x 2]
|
|
|
|
|
|
if {$name == ""} {
|
|
|
break
|
|
|
}
|
|
|
if {$name == "href"} {
|
|
|
set target $val
|
|
|
}
|
|
|
if {$name == "name" && $subtag == $val} {
|
|
|
# subtag was requested, notice it
|
|
|
set see [$w.f0.t1 index end]
|
|
|
}
|
|
|
}
|
|
|
if {$target != "" && ![regexp {^(http:|ftp:)} $target]} {
|
|
|
switch $tcl_platform(platform) {
|
|
|
"windows" {
|
|
|
if {![regexp {^([A-Za-z]:)?[\\/]} $target]} {
|
|
|
# relative pathname
|
|
|
set target "$dirname/$target"
|
|
|
}
|
|
|
}
|
|
|
"unix" {
|
|
|
if {![regexp {^/} $val]} {
|
|
|
# relative unix pathname
|
|
|
set target "$dirname/$target"
|
|
|
}
|
|
|
}
|
|
|
}
|
|
|
set anchorhasmodifiedfont 1
|
|
|
incr tagno
|
|
|
lappend attribs $attrib
|
|
|
set attrib "attrib$tagno"
|
|
|
$w.f0.t1 tag add $attrib end
|
|
|
$w.f0.t1 tag configure $attrib -foreground {blue}
|
|
|
$w.f0.t1 tag configure $attrib -font {Helvetica -12 bold}
|
|
|
$w.f0.t1 tag configure $attrib -lmargin1 $lmargin -lmargin2 $lmargin \
|
|
|
-rmargin $rmargin -justify $justify
|
|
|
$w.f0.t1 tag bind $attrib <ButtonPress> "htmlview $target"
|
|
|
}
|
|
|
}
|
|
|
"/a" {
|
|
|
if {$anchorhasmodifiedfont} {
|
|
|
set anchorhasmodifiedfont 0
|
|
|
set attrib [lindex $attribs end]
|
|
|
set attribs [lrange $attribs 0 end-1]
|
|
|
$w.f0.t1 tag add $attrib end
|
|
|
}
|
|
|
}
|
|
|
"ul" {
|
|
|
set list "ul"
|
|
|
incr ullevel
|
|
|
incr tagno
|
|
|
lappend attribs $attrib
|
|
|
set attrib "attrib$tagno"
|
|
|
set lmargin [expr 40 * $ullevel - 10]
|
|
|
set rmargin [expr 40 * $ullevel]
|
|
|
$w.f0.t1 tag add $attrib end
|
|
|
$w.f0.t1 tag configure $attrib -font {Helvetica -12}
|
|
|
$w.f0.t1 tag configure $attrib -lmargin1 $lmargin -lmargin2 $lmargin \
|
|
|
-rmargin $rmargin -justify $justify
|
|
|
}
|
|
|
"/ul" {
|
|
|
set ullevel [expr $ullevel - 1]
|
|
|
if {$ullevel == 0} {
|
|
|
set list ""
|
|
|
set lmargin 0
|
|
|
set rmargin 0
|
|
|
} else {
|
|
|
set lmargin [expr 40 * $ullevel - 10]
|
|
|
set rmargin [expr 40 * $ullevel]
|
|
|
}
|
|
|
set attrib [lindex $attribs end]
|
|
|
set attribs [lrange $attribs 0 end-1]
|
|
|
$w.f0.t1 tag add $attrib end
|
|
|
$w.f0.t1 tag configure $attrib -font {Helvetica -12}
|
|
|
$w.f0.t1 tag configure $attrib -lmargin1 $lmargin -lmargin2 $lmargin \
|
|
|
-rmargin $rmargin -justify $justify
|
|
|
$w.f0.t1 insert end "\n"
|
|
|
}
|
|
|
"li" {
|
|
|
switch $list {
|
|
|
"ul" {
|
|
|
incr bulletno
|
|
|
canvas $w.bullet$bulletno \
|
|
|
-width [expr 40 * $ullevel - 15] -height 6 \
|
|
|
-background $bgcolor -highlightthickness 0 \
|
|
|
-border 0
|
|
|
if {$ullevel == 1} {
|
|
|
$w.bullet$bulletno create oval 11 1 14 4
|
|
|
} else {
|
|
|
$w.bullet$bulletno create rectangle \
|
|
|
[expr 40 * $ullevel - 29] 1 [expr 40 * $ullevel - 26] 4
|
|
|
}
|
|
|
$w.f0.t1 insert end "\n" $attrib
|
|
|
$w.f0.t1 window create end -align baseline \
|
|
|
-window $w.bullet$bulletno
|
|
|
}
|
|
|
}
|
|
|
}
|
|
|
"address" {
|
|
|
set attrib ""
|
|
|
set attribs {}
|
|
|
$w.f0.t1 insert end "\n"
|
|
|
}
|
|
|
"hr" {
|
|
|
update
|
|
|
incr hrno
|
|
|
makehr $w.hr$hrno [expr [winfo width $w.f0.t1] - 10]
|
|
|
$w.f0.t1 insert end "\n" $attrib
|
|
|
$w.f0.t1 window create end -window $w.hr$hrno
|
|
|
}
|
|
|
"img" {
|
|
|
set iwidth 0
|
|
|
set iheight 0
|
|
|
set ialign "bottom"
|
|
|
set isrc ""
|
|
|
while {1} {
|
|
|
set x [parsetag $remainder]
|
|
|
set name [string tolower [lindex $x 0]]
|
|
|
set val [lindex $x 1]
|
|
|
set remainder [lindex $x 2]
|
|
|
|
|
|
if {$name == ""} {
|
|
|
break
|
|
|
}
|
|
|
switch $name {
|
|
|
"width" { set iwidth $val }
|
|
|
"height" { set iheight $val }
|
|
|
"src" {
|
|
|
switch $tcl_platform(platform) {
|
|
|
"windows" {
|
|
|
if {[regexp {^([A-Za-z]:)?[\\/]} $val]} {
|
|
|
# absolute pathname
|
|
|
set isrc $val
|
|
|
} else {
|
|
|
set isrc "$dirname/$val"
|
|
|
}
|
|
|
}
|
|
|
"unix" {
|
|
|
if {[regexp {^/} $val]} {
|
|
|
# absolute unix pathname
|
|
|
set isrc $val
|
|
|
} else {
|
|
|
set isrc "$dirname/$val"
|
|
|
}
|
|
|
}
|
|
|
}
|
|
|
}
|
|
|
"align" { set ialign [string tolower $val] }
|
|
|
}
|
|
|
}
|
|
|
if {$isrc != "" && [file exists $isrc]} {
|
|
|
incr imgno
|
|
|
image create photo htmlview$imgno \
|
|
|
-width $iwidth -height $iheight \
|
|
|
-file $isrc
|
|
|
set imgidx [$w.f0.t1 image create end -image htmlview$imgno]
|
|
|
$w.f0.t1 tag add $attrib $imgidx
|
|
|
$w.f0.t1 tag add $attrib end
|
|
|
}
|
|
|
}
|
|
|
}
|
|
|
} else {
|
|
|
# unfinished tag, return to $buf
|
|
|
set buf $tail
|
|
|
}
|
|
|
} else {
|
|
|
set buf ""
|
|
|
}
|
|
|
}
|
|
|
close $f
|
|
|
# prevent users from editing the text widget's contents
|
|
|
$w.f0.t1 configure -state disabled
|
|
|
if {[info exists see]} {
|
|
|
# we have a subtag to display
|
|
|
$w.f0.t1 see $see
|
|
|
}
|
|
|
}
|
|
|
|
|
|
# parse $str, obtain first name=value pair, return remainder as well
|
|
|
proc parsetag {str} {
|
|
|
# first check for quoted value
|
|
|
if {[regexp {^([A-Za-z0-9_]+) *= *"([^\"]+)" *(.*)} $str dummy name val rem]} {
|
|
|
return [list $name $val $rem]
|
|
|
}
|
|
|
# else check for argument that must not contain a space
|
|
|
if {[regexp {^([A-Za-z0-9_]+) *= *([^ ]+) *(.*)} $str dummy name val rem]} {
|
|
|
return [list $name $val $rem]
|
|
|
}
|
|
|
# else we fail
|
|
|
return [list "" "" ""]
|
|
|
}
|
|
|
|
|
|
# proc destroyhtmlwins {} {
|
|
|
# global htmlposx htmlposy
|
|
|
|
|
|
# foreach win [winfo children .] {
|
|
|
# if {[string match {.htmlview[0-9]*} $win]} {
|
|
|
# destroy $win
|
|
|
# }
|
|
|
# }
|
|
|
|
|
|
# foreach img [image names] {
|
|
|
# if {[string match {htmlview[0-9]+} $img]} {
|
|
|
# image delete $img
|
|
|
# }
|
|
|
# }
|
|
|
|
|
|
# set htmlposx [expr [winfo x .] + 80]
|
|
|
# set htmlposy [expr [winfo y .] + 50]
|
|
|
# }
|
|
|
|
|
|
proc makehr {c w} {
|
|
|
global bgcolor
|
|
|
|
|
|
canvas $c -width $w -height 6 -background $bgcolor \
|
|
|
-highlightthickness 0
|
|
|
$c create line 2 2 [expr $w - 2] 2 -width 1 -fill "\#202020"
|
|
|
$c create line 2 2 2 4 -width 1 -fill "\#202020"
|
|
|
$c create line 3 4 [expr $w - 1] 4 -width 1 -fill "\#ffffff"
|
|
|
$c create line [expr $w - 2] 4 [expr $w - 2] 2 -width 1 -fill "\#ffffff"
|
|
|
}
|
|
|
|
|
|
proc untangletext {t} {
|
|
|
|
|
|
set result ""
|
|
|
set ok 1
|
|
|
|
|
|
while {$ok} {
|
|
|
if {[regexp {^([^&]*)&([^;]+);(.*)} $t dummy left marked right]} {
|
|
|
set result "$result$left"
|
|
|
set t $right
|
|
|
switch -glob $marked {
|
|
|
"Auml" { set result "${result}<EFBFBD>" }
|
|
|
"Ouml" { set result "${result}<EFBFBD>" }
|
|
|
"Uuml" { set result "${result}<EFBFBD>" }
|
|
|
"auml" { set result "${result}<EFBFBD>" }
|
|
|
"ouml" { set result "${result}<EFBFBD>" }
|
|
|
"uuml" { set result "${result}<EFBFBD>" }
|
|
|
"szlig" { set result "${result}<EFBFBD>" }
|
|
|
"nbsp" { set result "${result} " }
|
|
|
"amp" { set result "${result}&" }
|
|
|
"lt" { set result "${result}<" }
|
|
|
"gt" { set result "${result}>" }
|
|
|
"\#[0-9]*" {
|
|
|
regexp {^.(.*)} $marked dummy c
|
|
|
set c [subst "\\[format {%o} $c]"]
|
|
|
set result ${result}$c
|
|
|
}
|
|
|
"*" {
|
|
|
# puts stderr "Warning: unknown html mark $marked"
|
|
|
}
|
|
|
}
|
|
|
} else {
|
|
|
set result "$result$t"
|
|
|
set ok 0
|
|
|
}
|
|
|
}
|
|
|
|
|
|
return $result
|
|
|
}
|