#!../mofe --f
# demo script to demonstrate usage of HTML forms from wafe (Athena only)
# Gustaf Neumann                      Sun Oct 31 23:23:18 GMT 1993

mergeResources topLevel \
  *background gainsboro \
  *HTML*XmTextField*background gray95

#create the "Command center"
XmRowColumn f topLevel orientation HORIZONTAL

  XmPushButton t1 f \
    labelString "Form 1" \
    activateCallback {doForm 1}
  XmPushButton t2 f \
    labelString "Form 2" \
    activateCallback {doForm 2}
  XmPushButton quit f \
    background red \
    activateCallback quit
realize

# create a HTML Form with the given number and pop it up
proc doForm {nr} {
  global form
  set shell s$nr
  if ![isWidget $shell] {
    mergeResources topLevel \
      *$shell.f$nr.XmPushButton.leftAttachment ATTACH_WIDGET \
      *$shell.f$nr.XmPushButton.topAttachment ATTACH_WIDGET 
      
    XmDialogShell $shell topLevel unmanaged 

    XmForm f$nr $shell unmanaged \
      autoUnmanage false \
      defaultPosition false \
      mapCallback "position %w $nr \[gV f x\] \[gV f y\]"
      
    HTML h$nr f$nr unmanaged \
      width 330 height 410 \
      text $form($nr) \
      submitFormCallback { submit "%h" "%n" "%v" }
    XmSeparatorGadget sep$nr f$nr unmanaged \
      topWidget h$nr topAttachment ATTACH_WIDGET width 300
    XmPushButton dismiss$nr f$nr unmanaged \
      labelString Dismiss \
      activateCallback "popdown $shell; destroyWidget $shell" \
      topWidget sep$nr
    XmPushButton entries$nr f$nr  unmanaged \
      labelString Entries \
      activateCallback "showEntries h$nr $nr" \
      topWidget sep$nr leftWidget dismiss$nr
    XmPushButton next$nr f$nr  unmanaged \
      labelString Next \
      activateCallback "showRecord $nr +" \
      topWidget sep$nr leftWidget entries$nr
    XmPushButton prev$nr f$nr  unmanaged \
      labelString Previous \
      activateCallback "showRecord $nr -" \
      topWidget sep$nr leftWidget next$nr
    showRecord $nr 1
    manageChild h$nr sep$nr dismiss$nr entries$nr next$nr prev$nr 
    manageChild f$nr
  }
  manageChild $shell 

  foreach w [gV h$nr.View children] {
    action $w override "\
               Shift<Key>Tab:   exec(nextField $nr -1)\n\
                    <Key>Tab:   exec(nextField $nr +1)\n\
                    <Btn1Down>: exec(gotoField $nr %W)"
  }
  turnOn $nr 0
}

proc position {w nr x y} {
  sV $w x [expr $x+([expr $nr-1]*30)] y [expr $y+($nr*20)]
}

# submit should be used to enter data into a database or simliar issuis
proc submit {href names values} {
  puts stderr "the Form is submitted:"
  puts stderr "    action = <$href>"
  puts stderr "    names  = <$names>"
  puts stderr "    values = <$values>"
} 

# show entries shows how to access the items in the Form without
# using submit; note that the way how $children is computed here
# will be wrong in case a Scrollbar is added
proc showEntries {html nr} {
  set children [gV $html.View children]
#  puts stderr "the widget ids of the entry fields of form $nr are $children"
  foreach widgetId $children {
    set widgetName [widgetName $widgetId]
    if [string compare "" $widgetName] {
      case [getClass $widgetId] {
	XmTextField    {set value [gV $widgetId value]}
	XmToggleButton {set value [expr {[gV $widgetId set]=={true}?{on}:{off}}]}
      }
      puts stderr "the contents of $widgetName is <$value>"
    }
  }
}

# show record displays the nth record of the form
proc showRecord {formNr recNr} {
  global current values
  set nr [expr {[info exists current($formNr)] ? $current($formNr) : 1}]
  case $recNr {
    {+} {incr nr}
    {-} {incr nr -1}
    default {set nr $recNr}
  }
  sV next$formNr sensitive [expr {$nr==$values($formNr) ? {false} : {true}}]
  sV prev$formNr sensitive [expr {$nr==1 ? {false} : {true}}]
  fillIn $formNr $nr
  set current($formNr) $nr
}

# fill in actually fills the values of an record into the displayed form
# (could be easily combined with showRecord)
proc fillIn {formNr recNr} {
  global values content
  foreach child [gV h$formNr.View children] {
    set e [widgetName $child]
#    puts stderr "name of $child is <$e>"
    if [info exists content($formNr,$e,$recNr)] {
      if {[getClass $child]=={XmToggleButton}} {
	sV $child set [expr {[string match on $content($formNr,$e,$recNr)]?{true}:{false}}]
      } else {
	sV $child value $content($formNr,$e,$recNr)
      }
    }
  }
}

# goto field jumps to field $f in form $formNr
proc gotoField {formNr f} {
  set children [gV h$formNr.View children]
  turnOn $formNr [lsearch -exact $children $f]
}

# next field jumps to the next field in form $formNr
proc nextField {formNr diff} { 
#  puts stderr "nextfield $formNr $diff"
  global currentField
  set children [gV h$formNr.View children]
  turnOn $formNr \
    [expr ($currentField($formNr)$diff)%[llength $children]]
}

# hilights the specified field of form $formNr
proc turnOn {formNr index} {
   global currentField
   set currentField($formNr) $index
   set children [gV h$formNr.View children]
#   puts stderr "turnon index=$index, children=<$children>, length=[llength $children]"
   set widgetId [lindex $children $index]
   XmProcessTraversal $widgetId TRAVERSE_CURRENT
}


# This is the sample "Database"
# values($formNr)                         holds the number of records
# content($formNr,$fieldName,$recordNr)   holds the actual value
set values(1) 2
set content(1,t1,1) "first value"
set content(1,t1,2) "second value"

set values(2) 3
set content(2,t1,1) "this is a"
set content(2,c1,1) "on"
set content(2,t2,1) 1
set content(2,t1,2) "this is b"
set content(2,c1,2) "off"
set content(2,t2,2) 2
set content(2,t1,3) "this is c"
set content(2,c1,3) "on"
set content(2,t2,3) 3

#-----------------------------------------------------------------------
# this is sample form 1. 
# note that this firm could be easly retrieved from a file or database,
# and that also enduser should be able to modify the screen appreance
# without knowing much detail, how the data is processed. HTML text 
# processing capabilities (various fonts, lists, headings, rules etc)
# and images can be used in forms as well...

set form(1) {
<TITLE>Fill-Out Form Example #1</TITLE>
<H1>Fill-Out Form Example #1</H1>

This is a very simple fill-out Form example. <P>

<FORM>

A single text entry field goes here: <input name="t1"> <P>

Note that it has no default value, the value is supplied from 
the tcl array "content(FormNumber,FieldName,recordNumber)<P>

To submit the query, press this button: <input type="submit"
value="Submit Query">. <P>

</FORM>

That's it. <P>
}

#-----------------------------------------------------------------------
# this is sample form 2 

set form(2) {
<TITLE>Fill-Out Form Example #2</TITLE>
<H1>Fill-Out Form Example #2</H1>

This is a very simple fill-out Form example. <P>

<FORM action="print">

A single text entry field with an input length of 25 characters 
goes here:<input name=t1 size=25 maxlen=25> <P> 

This is a checkbox <input name=c1 type=checkbox> which can be in a state
"on" or in a state "off". This is just another input field <input name=t2> <P>

To submit the query, press this button: <input type="submit"
value="Submit Query">. <P>

</FORM>
}
