#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

#Hacked by BK 2004, for Puppy Linux. based on hv.tcl shipped with tkhtml 2.0.
#phv is used as the internal html viewer, Puppy 0.9.8. www.puppylinux.org.
#
# This script implements the "hv" application.  Type "hv FILE" to
# view FILE as HTML.
#
# This application is used for testing the HTML widget.  It can
# also server as an example of how to use the HTML widget.
# 
# @(#) $Id: hv.tcl,v 1.31 2003/01/28 09:43:23 hkoba Exp $
#
wm title . {Puppy HTML File Viewer}
wm iconname . {PHV}

# Make sure the html widget is loaded into
# our interpreter
#
package require Tkhtml
#set f /usr/lib/tkhtml.so
#catch {load $f Tkhtml}

#BK want to load other than just gifs...
package require Img
#BK want a combobox also...
package require BWidget

#BK this will be a list, history of files for back button...
set PrevFiles ""
#list of offsets (fractions) to record scroll of each page...
set PrevFractions ""
#value pulled off PrevFractions list when pressed Back button...
set vFraction 0
#need to store fractions for Forward button...
set NextFractions ""
#list for Forward button...
set NextFiles ""
#BK value of zero is normal text size...
set TextSize 0
#BK =1 if selecting text (used in clipboard code)...
set MakingSel 0
#BK this is traced...
set FlagStuff 0

# The HtmlTraceMask only works if the widget was compiled with
# the -DDEBUG=1 command-line option.  "file" is the name of the
# first HTML file to be loaded.
#
set HtmlTraceMask 0
set file {}
foreach a $argv {
  if {[regexp {^debug=} $a]} {
    scan $a "debug=0x%x" HtmlTraceMask
  } else {
    set file $a
  }
}

# These images are used in place of GIFs or of form elements
#
image create photo biggray -data {
    R0lGODdhPAA+APAAALi4uAAAACwAAAAAPAA+AAACQISPqcvtD6OctNqLs968+w+G4kiW5omm
    6sq27gvH8kzX9o3n+s73/g8MCofEovGITCqXzKbzCY1Kp9Sq9YrNFgsAO///
}
image create photo smgray -data {
    R0lGODdhOAAYAPAAALi4uAAAACwAAAAAOAAYAAACI4SPqcvtD6OctNqLs968+w+G4kiW5omm
    6sq27gvH8kzX9m0VADv/
}
image create photo nogifbig -data {
    R0lGODdhJAAkAPEAAACQkADQ0PgAAAAAACwAAAAAJAAkAAACmISPqcsQD6OcdJqKM71PeK15
    AsSJH0iZY1CqqKSurfsGsex08XuTuU7L9HywHWZILAaVJssvgoREk5PolFo1XrHZ29IZ8oo0
    HKEYVDYbyc/jFhz2otvdcyZdF68qeKh2DZd3AtS0QWcDSDgWKJXY+MXS9qY4+JA2+Vho+YPp
    FzSjiTIEWslDQ1rDhPOY2sXVOgeb2kBbu1AAADv/
}
image create photo nogifsm -data {
    R0lGODdhEAAQAPEAAACQkADQ0PgAAAAAACwAAAAAEAAQAAACNISPacHtD4IQz80QJ60as25d
    3idKZdR0IIOm2ta0Lhw/Lz2S1JqvK8ozbTKlEIVYceWSjwIAO///
}

#BK want images for buttons...
image create photo backphoto -data "R0lGODlhDwANAKL/AM///8DAwJD//y/I/y+X/y9n/wAAAAAAACH5BAEAAAEALAAAAAAPAA0AAAM0GLq2/qE0+AqYVFmB6eZFKEoRIAyCaaYCYWxDLM9uYBAxoe/7dA8ug3AoZOg6mRsyuUxmEgA7"
image create photo forwardphoto -data "R0lGODlhDwANAKL/AM///8DAwJD//y/I/y+X/y9n/wAAAAAAACH5BAEAAAEALAAAAAAPAA0AAAM3GLpa/K8YSMuYlBVwV/kgCAhdsAFoig7ktA1wLA9SQdw4DkuB4f8/Ag2TMRB4GYUBmewRm09FAgA7"
image create photo incphoto -data "R0lGODlhDAAMAJECAICAgAAAAP///wAAACH5BAEAAAIALAAAAAAMAAwAAAIglH+BphxtQADi2fTWkY9qdS2S42HWtECVOmJleGqyUQAAOw=="
image create photo decphoto -data "R0lGODlhDAAMAJECAICAgAAAAP///wAAACH5BAEAAAIALAAAAAAMAAwAAAIalC+hirjdApyUygoCqG/mtEEL03yGFjHdUQAAOw=="
image create photo findphoto -data "R0lGODlhDAAMAJEDAMDAwP///wAAAP///yH5BAEAAAMALAAAAAAMAAwAAAIgnI8oaysa3hDxuMtadFtegE3UAnYYh3XiuGzQqTjJPBQAOw=="
image create photo openphoto -data "R0lGODlhDAAMALMPAOvr605OOfv7iDk5FbGxsZ2dNM3NzY2NjcrKXYaGAImJABoaCIuLABkZAGFhYf///yH5BAEAAA8ALAAAAAAMAAwAAARJ8EkJyBhmanAeDwTXaY/TEE5ROCxrHAcQCAJiIw4xzXSfhAAZrdAoFheNwawwYCieDEZAhhgkrlcF5rGwMrCMLbexKJt1pPQkAgA7"
image create photo contentsphoto -data "R0lGODlhDAAMALMAADg4ONDQ0AEBAZqamv///4aGhrCwsGdnZ2wCAgCYmIaenoaGnj8/BJiYAAQ/P56GhiH5BAAAAAAALAAAAAAMAAwAAARBkAwhACGADqJJOEcgUcAwAGVxKQiSeoKBGqQ5C2JxvkF8VwPVSLRoMEq74GUCVPU2hEfCAaABTxTSBYbbZrJgcAQAOw=="
image create photo stopphoto -data "R0lGODlhDQANALP/AP///1Lq81I5Of+EhCEAAHsAAMYAAP+UQv9zCHuMjP8AMf8AKf+MnK1CSv8QIQAAACH5BAEAAAEALAAAAAANAA0AAARWMMjUTC1J6ubOQYdiCBuIIMuiiCT1OWu6Ys05AMPC4ItBGB8dYMdI+RoHR4qY6v1CwlvRcEQ4brndwFAgJAwIRdPIzVTEYiqXJBEU1FQCW5Mg2O0ZSQQAOw=="



# Construct the main window
#
set underlineHyper 0
set showTableStruct 0
set showImages 1

#BK want buttons...
#frame .g  -borderwidth 5 -relief ridge
frame .g -relief flat
pack .g -anchor n -fill x -side top
button .g.exit -width 15 -height 13 -image stopphoto -command exit
pack .g.exit -side left
button .g.load -width 15 -height 13 -image openphoto -command Load
pack .g.load -side left
#button .g.mainindex  -command LoadIndex -padx 5 -state active -text "Main index"
button .g.mainindex -state active -width 15 -height 13 -image contentsphoto -command LoadIndex
#pack .g.mainindex -ipadx 15 -side left
pack .g.mainindex -side left
#button .g.back  -command Reverse -padx 5 -state disabled -text Back
#pack .g.back -ipadx 15 -side left
button .g.back -state disabled -width 15 -height 13 -image backphoto -command Reverse
pack .g.back -side left
button .g.forward -state disabled -width 15 -height 13 -image forwardphoto -command Forward
pack .g.forward -side left
button .g.find -width 15 -height 13 -image findphoto -command FindPopup
pack .g.find -side left
button .g.bigger -width 15 -height 13 -image incphoto -command BiggerText
pack .g.bigger -side left
button .g.smaller -width 15 -height 13 -image decphoto -command SmallerText
pack .g.smaller -side left


#BK scout has a sophisticated combobox (in BWidget), for now, just keep it simple...
entry .g.l -text "Status Line" -textvariable Message
pack .g.l -anchor w -fill x -padx 10 -side top
#BK ...Message is written to in LoadFile().

#ComboBox .g.ee -command "Load2" -entrybg #ffffff -modifycmd "Load2"\
#        -textvariable Getter -values {http://localhost/} -width 25
#pack .g.ee  -fill x -pady 3 -side top



# Construct the main HTML viewer
#
frame .h
pack .h -side top -fill both -expand 1
html .h.h \
  -yscrollcommand {.h.vsb set} \
  -xscrollcommand {.f2.hsb set} \
  -padx 5 \
  -pady 9 \
  -formcommand FormCmd \
  -imagecommand ImageCmd \
  -scriptcommand ScriptCmd \
  -appletcommand AppletCmd \
  -underlinehyperlinks 0 \
  -bg beige -tablerelief raised

# If the tracemask is not 0, then draw the outline of all
# tables as a blank line, not a 3D relief.
#
if {$HtmlTraceMask} {
  .h.h config -tablerelief flat
}

# A font chooser routine.
#
.h.h config -fontcommand pickFont
proc pickFont {size attrs} { 
  #puts "FontCmd: $size $attrs"
  #BK courier, times, helvetica are bitmap fonts in Puppy...
  set a [expr {-1<[lsearch $attrs fixed]?{courier}:{helvetica}}]
  set b [expr {-1<[lsearch $attrs italic]?{italic}:{roman}}]
  set c [expr {-1<[lsearch $attrs bold]?{bold}:{normal}}]
  #set d [expr {int(12*pow(1.2,$size-4))}]
  #BK in tk, bitmap fonts look best, but must be available sizes...
  #assume $size can be 1-6, giving sizes 8-24...
  if {$a=="times"} {incr size 1}
  #BK render text bigger or smaller...
  global TextSize
  set size [expr $size + $TextSize]
  if {$size<=1} {set d 8} elseif {$size==2} {set d 10} elseif {$size==3} \
     {set d 12} elseif {$size==4} {set d 14} elseif {$size==5} {set d 18} \
     elseif {$size>=6} {set d 24}
  list $a $d $b $c
# return "$a $d $b $c"
} 


# This routine is called for each form element
#
proc FormCmd {n cmd style args} {
  # puts "FormCmd: $n $cmd $args"
  switch $cmd {
    select -
    textarea -
    input {
      set w [lindex $args 0]
      label $w -image nogifsm
    }
  }
}

# This routine is called for every <IMG> markup
#
# proc ImageCmd {args} {
# puts "image: $args"
#   set fn [lindex $args 0]
#   if {[catch {image create photo -file $fn} img]} {
#     return nogifsm
#   } else {
#    global Images
#    set Images($img) 1
#    return $img
#  }
#}
proc ImageCmd {args} {
  global OldImages Images showImages
  if {!$showImages} {
    return smgray
  }
  set fn [lindex $args 0]
  if {[info exists OldImages($fn)]} {
    set Images($fn) $OldImages($fn)
    unset OldImages($fn)
    return $Images($fn)
  }
  if {[catch {image create photo -file $fn} img]} {
    return smgray
  }
  if {[image width $img]*[image height $img]>20000} {
    global BigImages
    set b [image create photo -width [image width $img] \
           -height [image height $img]]
    set BigImages($b) $img
    set img $b
    after idle "MoveBigImage $b"
  }
  set Images($fn) $img
  return $img
}
proc MoveBigImage b {
  global BigImages
  if {![info exists BigImages($b)]} return
  $b copy $BigImages($b)
  image delete $BigImages($b)
  unset BigImages($b)
  update
}


# This routine is called for every <SCRIPT> markup
#
proc ScriptCmd {args} {
  # puts "ScriptCmd: $args"
}

# This routine is called for every <APPLET> markup
#
proc AppletCmd {w arglist} {
  # puts "AppletCmd: w=$w arglist=$arglist"
  label $w -text "The Applet $w" -bd 2 -relief raised
}
namespace eval tkhtml {
    array set Priv {}
}

# This procedure is called when the user clicks on a hyperlink.
# See the "bind .h.h.x" below for the binding that invokes this
# procedure
#
proc HrefBinding {x y} {
  # koba & dg marking text
  .h.h selection clear
  set ::tkhtml::Priv(mark) $x,$y
  set list [.h.h href $x $y]
  if {![llength $list]} {return}
  foreach {new target} $list break
  if {$new!=""} {
    global LastFile
    set pattern $LastFile#
    set len [string length $pattern]
    incr len -1
    if {[string range $new 0 $len]==$pattern} {
      incr len
      .h.h yview [string range $new $len end]
    } else {

     #BK also want to record the vertical offset (fraction)...
     global PrevFractions vFraction
     lappend PrevFractions [lindex [.h.h yview] 0]
     set vFraction 0

      LoadFile $new
    }
  }
}
bind .h.h.x <1> {HrefBinding %x %y}
# marking text with the mouse and copying to the clipboard just with tkhtml2.0 working
bind .h.h.x <B1-Motion> {
    %W selection set @$::tkhtml::Priv(mark) @%x,%y
    # avoid tkhtml0.0 errors 
    # anyone can fix this for tkhtml0.0  ...BK how?
  #BK hacking this. don't write to clipboard here, overloads xclipboard.
  #MakingSel flag is read when B1 released, then writes to clipboard.
  global MakingSel
  set MakingSel 1
}


# Pack the HTML widget into the main screen.
#
pack .h.h -side left -fill both -expand 1
scrollbar .h.vsb -orient vertical -command {.h.h yview}
pack .h.vsb -side left -fill y

frame .f2
pack .f2 -side top -fill x
frame .f2.sp -width [winfo reqwidth .h.vsb] -bd 2 -relief raised
pack .f2.sp -side right -fill y
scrollbar .f2.hsb -orient horizontal -command {.h.h xview}
pack .f2.hsb -side top -fill x

# This procedure is called when the user selects the File/Open
# menu option.
#
set lastDir [pwd]
proc Load {} {
  set filetypes {
    {{Html Files} {.html .htm}}
    {{All Files} *}
  }
  global lastDir htmltext
  set f [tk_getOpenFile -initialdir $lastDir -filetypes $filetypes]
  if {$f!=""} {

    #BK also want to record the vertical offset (fraction)...
    global PrevFractions vFraction
    lappend PrevFractions [lindex [.h.h yview] 0]
    set vFraction 0

    LoadFile $f
    set lastDir [file dirname $f]
  }
}

#BK procedure when press "Main index" button...
proc LoadIndex {} {
 global lastDir htmltext
 set f /usr/share/doc/index.html
 LoadFile $f
 set lastDir [file dirname $f]
}

#BK procedure when press "Back" button...
proc Reverse {} {
 #note, never enter here if less than 2 elements in PrevFiles.
 global lastDir htmltext PrevFiles PrevFractions NextFiles vFraction NextFractions
 #PrevFiles has the current file on end, so chop it off...
 set numelements [llength $PrevFiles]
 set newend [expr $numelements - 2]
  #save for the forward button...
  lappend NextFiles [lindex $PrevFiles end]
  lappend NextFractions $vFraction
 set PrevFiles [lrange $PrevFiles 0 $newend]
 set f [lindex $PrevFiles end]

 #also have to retrieve the saved offset...
 set vFraction [lindex $PrevFractions end]
 #remove offset from list...
 set PrevFractions [lrange $PrevFractions 0 $newend]
 #save current fraction for Forward button...
 lappend NextFractions [lindex [.h.h yview] 0]

 LoadFile $f
 set lastDir [file dirname $f]

 #BK scroll page by amount vFraction... *NOT WORKING*
 #.h.h.x yview moveto $vFraction
 #puts $vFraction
 #...so have delayed it, press space key.
 #wm title . "HELP: Press space key to scroll to previous position"
}

#BK procedure when press "Forward" button...
proc Forward {} {
 #note, will never enter here if 0 elements in NextFiles.
 global lastDir htmltext PrevFiles PrevFractions NextFiles vFraction NextFractions
 #NextFiles has the forward file on end...
 set f [lindex $NextFiles end]
 set vFraction [lindex $NextFractions end]
 set numelements [llength $NextFiles]
 set newend [expr $numelements - 2]
 if {$newend<=-1} {set NextFiles "";set NextFractions ""} else {
  set NextFiles [lrange $NextFiles 0 $newend]
  set NextFractions [lrange $NextFractions 0 $newend]
 }
   #save for Back button (note, PrevFiles also has current file)...
   lappend PrevFiles $f
   #also want to record the vertical offset (fraction)...
   lappend PrevFractions [lindex [.h.h yview] 0]

 LoadFile $f
 set lastDir [file dirname $f]
}



# Clear the screen.
#
# Clear the screen.
#
proc Clear {} {
  global Images OldImages hotkey
  if {[winfo exists .fs.h]} {set w .fs.h} {set w .h.h}
  $w clear
  catch {unset hotkey}
  ClearBigImages
  ClearOldImages
  foreach fn [array names Images] {
    set OldImages($fn) $Images($fn)
  }
  catch {unset Images}
}
proc ClearOldImages {} {
  global OldImages
  foreach fn [array names OldImages] {
    image delete $OldImages($fn)
  }
  catch {unset OldImages}
}
proc ClearBigImages {} {
  global BigImages
  foreach b [array names BigImages] {
    image delete $BigImages($b)
  }
  catch {unset BigImages}
}

# Read a file
#
proc ReadFile {name} {

#BK want to open http: urls with firefox...
  if {[string match {http:*} $name]} {
   eval exec firefox $name &
   return {}
  }

#BK my knowledge of tcl/tk minimal, have to do this separately from above...
  if {[string match {ftp:*} $name]} {
   eval exec firefox $name &
   return {}
  }

#BK ditto. take it that file:// prefix has more serious rendering requirements...
  if {[string match {file:*} $name]} {
   eval exec firefox $name &
   return {}
  }

#BK and handle link to PDF files...
  if {[string match {*.pdf} $name]} {
   eval exec gsview $name &
   return {}
  }

  if {[catch {open $name r} fp]} {
    tk_messageBox -icon error -message $fp -type ok
    return {}
  } else {
    set r [read $fp [file size $name]]
    close $fp
    return $r
  }
}

# Load a file into the HTML widget
#
proc LoadFile {name} {

  #set html [ReadFile $name]
  #if {$html==""} return
    # jcw 06/10/2000 - drop "#tag", if present
    set basename [lindex [split $name #] 0]
    set html [ReadFile $basename]
    if {$html==""} return

  Clear
  global LastFile
  set LastFile $name
   .h.h config -base $name

#BK want to handle text files...
  if {![regexp -nocase {<html>|<!doctype|<body} [string range $html 0 200]]} {
   set html "<pre>$html</pre>\n"
  }

  .h.h parse $html
  ClearOldImages

#BK snitbrowser has this, modified to hopefully work here...
 #if url has an anchor appended, want to scroll to it...
 if {[regexp {(.+)#(.+)} $LastFile match file anchor]} {
  #tk_messageBox -title "Info!" -icon info -message "message jumping to $anchor" -type ok
  .h.h yview $anchor
 }

 global Message
 set Message  $LastFile

 #BK need a back button, so create a history here...
 global PrevFiles NextFiles
 set oldlastfile [lindex $PrevFiles end]
 if {$oldlastfile != $LastFile} {
  lappend PrevFiles $LastFile
 }
 if {[llength $PrevFiles]>1} {.g.back config -state active} else {.g.back config -state disabled}
 if {[llength $NextFiles]==0} {.g.forward config -state disabled} else {.g.forward config -state active}

 #BK problem with using ".h.h yview moveto" here, so do it indirectly...
 global FlagStuff
 set FlagStuff 1
}


#BK modified hack by dgroths for hv.tcl, popup menu for right-button...
menu .popup -tearoff 0
#.popup add separator 
.popup add command -label Home -underline 1 -command LoadIndex
.popup add command -label Back -underline 1 -command Reverse
.popup add command -label Forward -underline 1 -command Forward
.popup add command -label Find -underline 1 -command FindPopup
bind all <ButtonPress-3> {
    if { [winfo exists .popup] } {
        set x [winfo pointerx .]
        set y [winfo pointery .]        
        tk_popup .popup $x $y 
    }
}

#BK want keys to scroll window (not just scrollbar)...
bind all <KeyPress-space> {
 #.h.h yview scroll +1 pages
 global vFraction
 if {$vFraction != 0} {.h.h yview moveto $vFraction ; set vFraction 0} else {.h.h yview scroll +1 pages}

 #.h.h insert [lindex [.h.h text find "Amaya"] 0]
 #.h.h refresh vscroll
 #puts [.h.h text find "Amaya"]
}
bind all <KeyPress-Next> {
    .h.h yview scroll +1 pages 
}
bind all <KeyPress-Down> {
    .h.h yview scroll +2 units
}
bind all <Shift-space> {
    .h.h yview scroll -1 pages
}
bind all <KeyPress-Prior> {
    .h.h yview scroll -1 pages
}
bind all <KeyPress-Up> {
    .h.h yview scroll -2 units
}

#BK move to beginning or end of document...
bind all <Home> {
 .h.h yview moveto 0
}
bind all <End> {
 .h.h yview moveto 1
}

#BK need more control over writing selection to clipboard...
bind .h.h.x <B1-ButtonRelease> {
 global MakingSel
 if {$MakingSel==1} {
  set MakingSel 0
  clipboard clear
  catch { clipboard append [selection get] }
  #xclipboard itself rejects multiple instances running...
  eval exec xclipboard -geometry 296x120-0+0 &
 }
}

# Refresh the current file.
#
proc Refresh {args} {
  global LastFile
  if {![info exists LastFile]} return
  LoadFile $LastFile
}

# If an arguent was specified, read it into the HTML widget.
#
update
if {$file!=""} {
  LoadFile $file
}


# This binding changes the cursor when the mouse move over
# top of a hyperlink.
#
bind HtmlClip <Motion> {
  set parent [winfo parent %W]
  set url [$parent href %x %y] 
  if {[string length $url] > 0} {
    $parent configure -cursor hand2
  } else {
    $parent configure -cursor {}
  }
}

#BK found this on tkhtml mail archive. think came from browsex originally...
proc FindPopup {} {
    # Open a "Find on this Page" dialog.

    set w .html_search
    catch {destroy $w}
    toplevel $w
    wm title $w "Find Text in Puppy HTML viewer"
    # partially stolen from browsex.
    pack [frame $w.sf] -side top -expand yes -fill x -anchor s -padx 10 -pady 4
    pack [entry $w.e -width 40] -side right
    pack [label $w.l -text "Find :"] -side right

    bind $w.e <Return> "html_search \[$w.e get\]"
}

proc html_search {text} {
    set cmd [list .h.h text find $text]
    set last [.h.h index sel.last]
    if {$last != ""} {
    lappend cmd after $last
    }
    # puts "cmd $cmd"
    set found [eval $cmd]
    if {[llength $found] == 0} {
    .h.h selection clear
    error "No (more) match: $text"
    }
    # puts "found $found"
    foreach {begin end} $found break
    # Since text find returns shorter region, we should incr $end
    .h.h selection set $begin [incr_html_index $end]
    html_see $begin
}
proc html_see {ix} {
    foreach {x y} [.h.h.x coords $ix] break
    foreach {mx my} [.h.h.x coords] break
    .h.h.x yview moveto [expr {1.0*$y/$my}]
    .h.h.x xview moveto [expr {1.0*$x/$mx}]
}
proc incr_html_index {ix {off 1}} {
    foreach {token char} [split $ix .] break
    return $token.[incr char $off]
}


proc BiggerText {} {
 global TextSize 
 incr TextSize 1
 if {$TextSize>=2} {.g.bigger config -state disabled}
 .g.smaller config -state active
 Refresh
}

proc SmallerText {} {
 global TextSize 
 incr TextSize -1
 if {$TextSize<=-2} {.g.smaller config -state disabled}
 .g.bigger config -state active
 Refresh
}

#proc DoStuff {a b c} {
# global vFraction
# puts $vFraction
# #if {$vFraction != 0} {.h.h.x yview moveto $vFraction ; set vFraction 0}
# .h.h.x yview moveto 0.5
#}
##BK delayed stuff. note FlagStuff must be global...
#trace variable FlagStuff w DoStuff


#end of file
