summaryrefslogtreecommitdiffstats
path: root/temp/mfile/htmlview.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'temp/mfile/htmlview.tcl')
-rw-r--r--temp/mfile/htmlview.tcl606
1 files changed, 606 insertions, 0 deletions
diff --git a/temp/mfile/htmlview.tcl b/temp/mfile/htmlview.tcl
new file mode 100644
index 0000000..f0b3418
--- /dev/null
+++ b/temp/mfile/htmlview.tcl
@@ -0,0 +1,606 @@
+# ----------------------------------------------------------------------------
+# "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 1.7 2004/07/15 20:50:48 j 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}Ä" }
+ "Ouml" { set result "${result}Ö" }
+ "Uuml" { set result "${result}Ü" }
+ "auml" { set result "${result}ä" }
+ "ouml" { set result "${result}ö" }
+ "uuml" { set result "${result}ü" }
+ "szlig" { set result "${result}ß" }
+ "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
+}
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-04 04:26:57 +0200