#!../mofe --f

set currFile [lindex $ARGV 1]
if [string match "" $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
  sV Back sensitive True
}

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

  set len [llength $htmlStack]
  if {$len == 0} {
    return ""
  } else {
    if {$len == 1} {sV Back sensitive False}
    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 [string match "" $newFile] {
    return
  }
  set href [htmlPop]

  if {$newFile != $currFile} {
    unmapWidget $widget
    sV $widget text [getFile $newFile]
    set currFile $newFile
  }
  if [string match "top" $href] {
    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]
  if {$newID==0} {
    # reference was not found
    bell topLevel 1
    return
  }

  set scrollId [expr $newID-15]
  if {$scrollId<1} {set scrollId 1}
  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
}

# 
# Create main window and HTML widget
XmMainWindow main topLevel {
  width 600
  height 580
  scrollingPolicy APPLICATION_DEFINED
  visualPolicy VARIABLE
}

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


XmRowColumn rc main orientation HORIZONTAL
XmPushButton Quit rc activateCallback quit

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

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

#XmLabel title rc \
#  labelString "                   Document Title:   [gV html titleText]"
XmLabel 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]}
