#! /usr/bin/X11/wafe --f

set currFile [lindex $ARGV 1]
if {$currFile=={}} {set currFile "/u/neumann/wafe/src/wafe.html"}

set XLIB /usr/lib/X11
# set XLIB /goodies/lib/
set FILESEARCHPATH $XLIB/wafe/faces/%N:$XLIB/twm/%N

mergeResources topLevel {
  *font  -adobe-times-medium-r-normal-*-17-*-*-*-*-*-iso8859-1
  *titleFont -adobe-times-bold-r-normal-*-24-*-*-*-*-*-iso8859-1
  *italicFont -adobe-times-medium-i-normal-*-17-*-*-*-*-*-iso8859-1
  *boldFont -adobe-times-bold-r-normal-*-17-*-*-*-*-*-iso8859-1
  *fixedFont -adobe-courier-medium-r-normal-*-17-*-*-*-*-*-iso8859-1
  *header1Font -adobe-times-bold-r-normal-*-24-*-*-*-*-*-iso8859-1
  *header2Font -adobe-times-bold-r-normal-*-18-*-*-*-*-*-iso8859-1
  *header3Font -adobe-times-bold-r-normal-*-17-*-*-*-*-*-iso8859-1
  *header4Font -adobe-times-bold-r-normal-*-14-*-*-*-*-*-iso8859-1
  *header5Font -adobe-times-bold-r-normal-*-12-*-*-*-*-*-iso8859-1
  *header6Font -adobe-times-bold-r-normal-*-10-*-*-*-*-*-iso8859-1
  *addressFont -adobe-times-medium-i-normal-*-17-*-*-*-*-*-iso8859-1
  *plainFont -adobe-courier-medium-r-normal-*-14-*-*-*-*-*-iso8859-1
  *listingFont -adobe-courier-medium-r-normal-*-12-*-*-*-*-*-iso8859-1
  *background gainsboro
  *XmPushButton*FontList -adobe-times-bold-*-normal-*-14-*-*-*-*-*-iso8859-1
  *FontList -adobe-times-medium-*-normal-*-14-*-*-*-*-*-iso8859-1=charseta,-adobe-times-bold-*-normal-*-14-*-*-*-*-*-iso8859-1=charsetb
}


# Stack to keep track of hyperlink movements
set htmlStack {}
set currPos "top"

# Load a file
proc getFile {fileName} {
  if [file exists $fileName] {
    set result [read [set fd [open $fileName r]]]
    close $fd
  } else {
    set result "File $fileName not found"
    puts stderr $result
  }
  return $result
}

# Manage the html stack: Push
proc htmlPush {ref} {
  global htmlStack
  lappend htmlStack $ref
}

# Manage the href stack: Pop
proc htmlPop {} {
  global htmlStack

  set len [llength $htmlStack]
  if {$len == 0} {
    return ""
  } else {
    incr len -1
    set last [lindex $htmlStack $len]
    set htmlStack [lreplace $htmlStack $len $len]
  }
  return $last
}

# Move in the current file to href
proc htmlMoveInFile {widget href} {
  global currPos currFile 

  htmlMoveCursor $widget $href

  htmlPush $currPos
  htmlPush $currFile
  set currPos $href
}

# Load the requested file and move to specified href
proc htmlMove {widget href} {
  global currPos currFile

  if {[string index $href 0] == "#"} {
    set newHref [string trimleft $href "#"]
    htmlMoveInFile $widget $newHref
  } else {
    if {[scan $href {%[^#]#%s} requFile requHref] == 2} {
      unmapWidget $widget
      sV $widget text [getFile $requFile]
      htmlMoveInFile $widget $requHref
      mapWidget $widget
    } else {
      sV $widget text [getFile $requFile]
      htmlHome $widget
      htmlPush $currPos
      htmlPush $currFile
      set currPos "top"
    }
    set currFile $requFile
  }
}

# Pop last filename/anchor from stack and go there
proc htmlBack {widget} {
  global currPos currFile

  set newFile [htmlPop]
  if {$newFile == ""} {
    return
  }
  set href [htmlPop]

  if {$newFile != $currFile} {
    unmapWidget $widget
    sV $widget text [getFile $newFile]
    set currFile $newFile
  }
  if {$href == "top"} {
    htmlHome $widget
  } else {
    htmlMoveCursor $widget $href
  }
  set currPos $href
  mapWidget $widget
}

# Move cursor to href and xpos/ypos
proc htmlMoveCursor {widget href} {
  hTMLClearSelection $widget
  
  set newID [hTMLAnchorToId $widget $href]

  hTMLAnchorToPosition $widget $href xpos ypos
  
  set newy [expr $ypos - [gV $widget height]/2]
  if {$newy<0} {set newy 0}

  set scrollId [expr $newID-15]
  if {$scrollId<0} {set scrollId 0}
  hTMLGotoId $widget $scrollId

  # Fake Cursor: Select first character
  set selStart(id) $newID
  set selEnd(id) $newID
  set selStart(pos) 0
  set selEnd(pos) 1
  hTMLSetSelection $widget selStart selEnd

}


# Move the fake cursor to upper left corner
proc htmlHome {widget} {
  hTMLClearSelection $widget
  hTMLGotoId $widget 1
#  set selStart(id) 1  
#  set selEnd(id) 1
#  set selStart(pos) 0
#  set selEnd(pos) 1
#  hTMLSetSelection $widget selStart selEnd
}

# 
# Create the viewport and html widgets
#

mMainWindow main topLevel {
  width 600
  height 580
  scrollingPolicy AUTOMATIC
  scrollBarDisplayPolicy AS_NEEDED
}

html html main unmanaged {
  width 580
  height 600
  marginWidth 10
  anchorUnderlines 1
  marginHeight 0
  anchorColor forestGreen
  anchorCallback {htmlMove %w %h}
  text [getFile $currFile]
}


mRowColumn rc main orientation HORIZONTAL
mPushButton Quit rc activateCallback quit

mPushButton Back rc {
  sensitive False
  activateCallback "htmlBack html"
}

mPushButton Print rc {
  activateCallback {
    set fd [open html.ps w];
    puts $fd [hTMLGetText html 2];
    close $fd
  }
}

mLabel title rc {
  labelString "                   Document Title:   ^charsetb [gV html titleText]"
}

sV main commandWindow rc
sV main workWindow html
manageChild html

#set htmlHeight [gV h height]
#if {$htmlHeight < 700} {sV vport height $htmlHeight}

realize

action html.View replace {\
    <Btn1Down>:     select-start()
    <Btn1Motion>:   extend-adjust()
    <Btn1Up>:       extend-end(PRIMARY, CUT_BUFFER0)
    <Btn2Down>:     exec(htmlBack html)
}

register usr1 {sV html text [getFile $currFile]}
