#! ../wafe --f
scriptNeeds HTML "This script needs the HTML Widget"

set currFile [lindex $ARGV 1]
if [string match "" $currFile] {
  set currFile [resolvePathname topLevel NULL wafe.html NULL \
      "./%N:../%N:$WAFELIB/%N"]
}

set FILESEARCHPATH "$FILESEARCHPATH:$WAFELIB/faces/%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
  *Scrollbar*shadowWidth 3
  *Scrollbar*background gray80
}


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

# Load a file
proc getFile {fileName} {
  set fn [resolvePathname topLevel NULL $fileName NULL "%N:html/%N"]
  if [file exists $fn] {
    set result [read [set fd [open $fn 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 [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
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<0} {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
#  set selStart(id) 1  
#  set selEnd(id) 1
#  set selStart(pos) 0
#  set selEnd(pos) 1
#  HTMLSetSelection $widget selStart selEnd
}

# 
# Create the HTML widget

HTML h topLevel {
  width 700
  height 700
  marginWidth 10
  anchorUnderlines 1
  marginHeight 0
  anchorColor forestGreen
  anchorCallback {htmlMove %w %h}
  submitFormCallback { submit "%h" "%n" "%v" }
  text [getFile $currFile]
}

proc submit {href names values} {
  puts stderr "the form is submitted:"
  puts stderr "    action = <$href>"
  puts stderr "    names  = <$names>"
  puts stderr "    values = <$values>"
  foreach v $values {
    puts stderr "       value=<$v>"
  }
  set val [lindex $values 0]
  puts stderr "    1. val = $val"
  puts stderr "    2. val = [lindex $values 1]"
} 

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

realize

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

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