#!../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 FILESEARCHPATH $XLIB/wafe/faces/%N:$XLIB/twm/%N:html/%N

# setting TEAR_OFF_ENABLED in resources to accomplish 1.1 comptatibility
mergeResources topLevel {
  *menu_bar*tearOffModel TEAR_OFF_ENABLED
  *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
  *HTML*background gray95
  *background gainsboro
  *foreground black
  *FontList -adobe-times-medium-*-normal-*-14-*-*-*-*-*-iso8859-1=charseta,-adobe-times-bold-*-normal-*-14-*-*-*-*-*-iso8859-1=charsetb
}

#  *XmPushButton*FontList -adobe-times-bold-*-normal-*-14-*-*-*-*-*-iso8859-1
# Stack to keep track of hyperlink movements
set htmlStack {}

# 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
  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
}

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

  setBusy $widget true
  set visited($href) 1
  htmlPush [htmlGetCurrentPosition $widget]
  htmlPush $currFile

  if {[string index $href 0] == "#"} {
    set newHref [string trimleft $href "#"]
    htmlMoveCursor $widget $newHref
  } else {
    if {[scan $href {%[^#]#%s} requFile requHref] == 2} {
      htmlNewFile $widget $requFile
      htmlMoveCursor $widget $requHref
    } else {
      htmlNewFile $widget $requFile
      htmlHome $widget
    }
  }
  setBusy $widget false
}

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

  set newFile [htmlPop]
  if [string match "" $newFile] return
  set pos [htmlPop]

  if [string compare $newFile $currFile] {
    htmlNewFile $widget $newFile
  }
  if [string match top $pos] {
    htmlHome $widget
  } else {
    htmlSetCurrentPosition $widget $pos
    HTMLRetestAnchors $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
    sV message labelString "Reference $href not found"
    return
  }
  sV message labelString ""

  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
}

proc htmlNewFile {widget fileName {realized 1}} {
  global currFile htmlSearchLastPos
  if $realized {unmapWidget $widget}
  sV $widget text [getFile $fileName]
  if $realized {mapWidget $widget}
  set currFile $fileName
  setTitle [gV $widget titleText]
  set htmlSearchLastPos(id) 0
  set htmlSearchLastPos(pos) 0
}

# Move the fake cursor to upper left corner
proc htmlHome {widget} {
  HTMLClearSelection $widget
  HTMLGotoId $widget 1
}

proc htmlGetCurrentPosition {widget} {
  XmScrollBarGetValues $widget.Vbar val size incr page
  # puts stderr "XmScrollBarGetValues $widget.Vbar $val $size $incr $page"
  # the returned val from XmScrollBarGetValues appears to be incorrect 
  # in Motif 1.2.3; so we are using gV instead.
  return [list [gV $widget.Vbar value] $size $incr $page]
}

proc htmlSetCurrentPosition {widget l} {
  set pos [lindex $l 0]
  set size [lindex $l 1]
  set incr [lindex $l 2]
  set page [lindex $l 3]
#  puts stderr "XmScrollBarSetValues $widget.Vbar $pos $size $incr $page true"
  XmScrollBarSetValues $widget.Vbar $pos $size $incr $page true
}

proc handleHtmlSearch {widget searchString dirString} {
  case [doHTMLSearch $widget $searchString $dirString] {
    1 { sV message labelString "No keyword specified"; bell topLevel 10 }
    2 { sV message labelString "Not found"; bell topLevel 10 }
    0 { sV message labelString "Found" }
  }
}
 
proc doHTMLSearch {widget searchString dirString} {
    global htmlSearchLastPos 
    if [string match "" $searchString] { return 1 } 

    set keyLength [string length $searchString]
    if [string compare forward $dirString] {
      set dir 1
      incr htmlSearchLastPos(pos) -$keyLength
    } else {
      set dir 0
    }
   
    if [string compare -1 [HTMLSearchText $widget $searchString \
	   htmlSearchLastPos outStart outEnd $dir 1]] {
	HTMLGotoId $widget $outStart(id)
	HTMLSetSelection $widget outStart outEnd
	set htmlSearchLastPos(id) $outEnd(id) 
	set htmlSearchLastPos(pos) $outEnd(pos)	 
	return 0
    } else {
	# Not found ...
	if {$dir == 1} {incr htmlSearchLastPos(pos) $keyLength}
	return 2
    }
}

proc pressedToggle {box} {
  set result {}
  foreach w [gV $box children] {
    if [gV $w set] { lappend result [widgetName $w] }
  }
  return $result
}

proc setTitle {title} {
  sV title labelString "Document Title:   ^charsetb $title"
}

# 
# Create main window and HTML widget
XmMainWindow main topLevel {
  scrollingPolicy APPLICATION_DEFINED
  visualPolicy VARIABLE
}

HTML html main unmanaged {
  width 580
  height 610
  marginWidth 10
  anchorUnderlines 1
  anchorColor slateBlue
  anchorCallback {htmlMove %W %h}
}

register htmlVisited {
  return [info exists visited($HTMLHREF)]
}


  XmMenuBar menu_bar main
    XmPulldownMenu mp1 menu_bar unmanaged
      XmPushButton Print mp1 \
	accelerator Ctrl<Key>P \
	acceleratorText Ctrl+P \
        activateCallback {
           set fd [open html.ps w];
           puts $fd [HTMLGetText html 2];
           close $fd
           sV message labelString "Document printed into html.ps"
        }
      XmPushButton ReRead mp1 \
	accelerator Ctrl<Key>R \
	acceleratorText Ctrl+R \
        activateCallback { 
           set pos [gV html.Vbar value]
           sV html text [getFile $currFile]
           XmScrollBarGetValues html.Vbar val size incr page
           XmScrollBarSetValues html.Vbar $pos $size $incr $page true
           sV message labelString "Document reloaded"
        }
      XmPushButton Quit mp1 \
	accelerator Ctrl<Key>C \
	acceleratorText Ctrl+C \
	activateCallback quit
    XmCascadeButton File menu_bar \
	subMenuId mp1 \
	mnemonic F

    XmPulldownMenu mp2 menu_bar unmanaged
      XmPushButton Back mp2 \
	  sensitive False \
	  accelerator Ctrl<Key>B \
	  acceleratorText Ctrl+B \
	  activateCallback "htmlBack html"
      XmPushButton Search mp2 \
	  accelerator Ctrl<Key>S \
	  acceleratorText Ctrl+S \
	  activateCallback {
	    set htmlSearchLastPos(id) 0
	    set htmlSearchLastPos(pos) 0
	    manageChild htmlSearchDialog
          } 

    XmCascadeButton Navigate menu_bar \
	subMenuId mp2 \
	mnemonic N

    XmPulldownMenu mp3 menu_bar unmanaged
      XmPushButton Help mp3 \
	activateCallback "manageChild helpbox"
      XmPushButton Version mp3 \
	activateCallback "manageChild versionbox"
    XmCascadeButton Help menu_bar \
	subMenuId mp3 \
	mnemonic H

XmLabel message main labelString "" height 20 recomputeSize false
XmLabel title main 
htmlNewFile html $currFile 0

XmMainWindowSetAreas main menu_bar title NULL NULL html
sV menu_bar menuHelpWidget Help
sV main messageWindow message showSeparator true
manageChild html
realize

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


proc scroll {w direction} {
  switch $direction {
    Down   { callActionProc $w.Vbar {} IncrementDownOrRight 0          }
    Up     { callActionProc $w.Vbar {} IncrementUpOrLeft 0             } 
    Prior  { callActionProc $w.Vbar {} PageUpOrLeft 0                  } 
    Next   { callActionProc $w.Vbar {} PageDownOrRight 0               } 
    Home   { XmScrollBarGetValues $w.Vbar val size incr page
             XmScrollBarSetValues $w.Vbar 0 $size $incr $page true     } 
    End    { XmScrollBarGetValues $w.Vbar val size incr page
	     set max [expr [gV $w.Vbar maximum]-[gV $w.Vbar sliderSize]]
             XmScrollBarSetValues $w.Vbar $max $size $incr $page true  } 
  }
}

# we use main as parent to obtain better placement, 
# when the accelerator CTRL+S is used
XmPromptDialog htmlSearchDialog main unmanaged \
    selectionLabelString "Enter Search Term:" \
    autoUnmanage false \
    okCallback { handleHtmlSearch html "%s" [pressedToggle htmlSearchDir] } \
    cancelCallback {unmanageChild %W}

  XmSimpleRadioBox htmlSearchDir htmlSearchDialog
      XmToggleButton forward  htmlSearchDir \
	  labelString "Search Forward" set true
      XmToggleButton backward htmlSearchDir \
	  labelString "Search Backward"

regexp {[^/]*$} $argv0 progName
XmMessageDialog versionbox mp3 unmanaged \
	dialogTitle "Motif Demo Program using XmGraph" \
	okLabelString "Close" \
	messageString "$progName 0.00001, May 26, 1994"

XmMessageDialog helpbox mp3 unmanaged \
	dialogTitle "$progName Help" \
	okLabelString "Close" \
	messageString "This program is a simple demo program for HTML widget."

unmanageChild \
	[XmSelectionBoxGetChild htmlSearchDialog DIALOG_HELP_BUTTON] 
unmanageChild \
	[XmMessageBoxGetChild versionbox DIALOG_CANCEL_BUTTON] \
	[XmMessageBoxGetChild versionbox DIALOG_HELP_BUTTON] 
unmanageChild \
	[XmMessageBoxGetChild helpbox DIALOG_CANCEL_BUTTON] \
	[XmMessageBoxGetChild helpbox DIALOG_HELP_BUTTON] 

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