#!/bin/sh
# here is a sample html viewer to demonstrate the library usage
# Copyright (c) 1995 by Sun Microsystems
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# This REQUIRES Tk4.0 -- make sure "wish" on the next line is a 4.0 version
# The next line is a TK comment, but a shell command \
  exec wish -f "$0" "$@" & exit 0

if {$tk_version < 4.0} {
	puts stderr "This library requires TK4.0, this is only $tk_version"
	exit 1
}
puts stderr "Starting sample HTML viewer..."
source html_library.tcl

# construct a simple user interface

proc setup {} {
	frame .frame
	menubutton .menu -relief raised -bd 2 -text options... -menu .menu.m
	button .quit  -command exit  -text quit
	entry .entry  -textvariable Url -width 35
	label .file  -text file:
	label .status -textvariable Running -width 6 -relief ridge \
			-bd 2 -padx 9 -pady 3
	label .msg -textvariable message
	scrollbar .scrollbar  -command ".text yview"  -orient v
	option add *Text.height 40 startup
	option add *Text.width 80 startup
	text .text  -yscrollcommand ".scrollbar set" -padx 3 -pady 3

	pack .frame .msg -side top
	pack .scrollbar -side left -expand 0 -fill y
	pack .text -side left -fill both -expand 1
	pack .file .entry .status .menu .quit -in .frame -side left

	# set up some bindings
	bind .entry <Return> {render $Url}
	bind all <End> {.text yview end}
	bind all <Home> {.text yview 0.0}
	bind all <Next> {.text yview scroll 1 page}
	bind all <Prior> {.text yview scroll -1 page}

	# I'm constantly being criticized for never using menus.
	# so here's a menu.  So there.
	menu .menu.m
	.menu.m add command -label "option menu"
	.menu.m add separator
	.menu.m add command -label "font size" -foreground red
	.menu.m add radiobutton -label small -value 0   -variable Size \
		-command {HMset_state .text -size $Size; render $Url}
	.menu.m add radiobutton -label medium -value 4  -variable Size \
		-command {HMset_state .text -size $Size; render $Url}
	.menu.m add radiobutton -label large -value 12  -variable Size \
		-command {HMset_state .text -size $Size; render $Url}
	.menu.m add separator
	.menu.m add command -label "indent level" -foreground red
	.menu.m add radiobutton -label small -value 0.6 -variable Indent \
		-command {HMset_indent .text $Indent}
	.menu.m add radiobutton -label medium -value 1.2 -variable Indent \
		-command {HMset_indent .text $Indent}
	.menu.m add radiobutton -label large -value 2.4 -variable Indent \
		-command {HMset_indent .text $Indent}
}

# go render a page.  We have to make sure we don't render one page while
# still rendering the previous one.

proc render {file} {
	global HM.text
	global Running message
	HMreset_win .text
	set Running busy
	set message "Displaying $file"
	update idletasks
	HMparse_html [get_html $file] {HMrender .text}
	set Running ready
	HMset_state .text -stop 1		;# stop rendering previous page if busy
	set message ""
}

# given a file name, return its html

proc get_html {file} {
	global Home
	if {[catch {set fd [open $file]} msg]} {
		return "
			<title>Bad file $file</title>
			<h1>Error reading $file</h1><p>
			$msg<hr>
			<a href=$Home>Go home</a>
		"
	}
	set result [read $fd]
	close $fd
	return $result
}

# Override the library link-callback routine for the sample app.
# It only handles the simple cases

proc HMlink_callback {win href} {
	global Url
	if {[string match /* $href]} {
		set Url $href
	} else {
		set Url [file dirname $Url]/$href
	}
	update
	render $Url
}

# supply an image callback function
# Read in an image if we don't already have one
# callback to library for display

proc HMset_image {handle src} {
	global Url message
	if {[string match /* $src]} {
		set image $src
	} else {
		set image [file dirname $Url]/$src
	}
	set message "fetching image $image"
	update
	if {[string first " $image " " [image names] "] >= 0} {
		HMgot_image $handle $image
	} else {
		catch {image create photo $image -file $image} image
		HMgot_image $handle $image
	}
}

# Lets invent a new HTML tag, just for fun.
# Change the color of the text. Use html tags of the form:
# <color value=blue> ... </color>
# We can invent a new tag for the display stack.  If it starts with "T"
# it will automatically get mapped directly to a text widget tag.

proc HMtag_color {win param text} {
	upvar #0 HM$win var
	set value bad_color
	HMextract_param $param value
	$win tag configure $value -foreground $value
	HMstack $win "" "Tcolor $value"
}

proc HMtag_/color {win param text} {
	upvar #0 HM$win var
	set value bad_color
	HMstack $win / "Tcolor {}"
}

# set initial values
set Size 4					;# font size adjustment
set Indent 1.2				;# tab spacing (cm)
set Home [pwd]/html/help.html		;# home document
set Url $Home				;# current file
set Running busy			;# page status
set message ""				;# message line

# make the interface and render the home page
setup
HMinit_win .text
HMset_state .text -size $Size
HMset_indent .text $Indent
render $Home
