path: root/temp/mfile/htmlview.tcl

# ----------------------------------------------------------------------------
# "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
}