### Copyright (C) 1995-1997 Jesper K. Pedersen
### This program is free software; you can redistribute it and/or modify
### it under the terms of the GNU General Public License as published by
### the Free Software Foundation; either version 2 of the License, or
### (at your option) any later version.
###
### This program is distributed in the hope that it will be useful,
### but WITHOUT ANY WARRANTY; without even the implied warranty of
### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
### GNU General Public License for more details.
###
### You should have received a copy of the GNU General Public License
### along with this program; if not, write to the Free Software
### Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.


############################################################
### This function is used in two situations:
### o An FillOutElm is selected in the listbox, and is to
###   be inserted
### o A FillOutElm is select in the entry, and is now to
###   be edited.
###
### If the element is new, the argument 'name' contains
### the name of the FillOut, otherwise it contains the name
### of the FillOutElm
############################################################
proc fillout_list {prefix path name entryname {counter -1}} {
  global __widgetArgs __editInfo __children __activeNivau __clean
  global __fillOutCounter __fillList __answers __changeFunc __initFunc
  global __language
  set function $__editInfo(name)
  set type $__widgetArgs(${function}__${name}__tp)

  ### find out which element was selected
  if {$name == $entryname} {
    ### a new element is inserted
    set new 1
    set index [${path}.box curselection]
    if {$index == ""} return
    $path.box selection clear $index
    set entryname [lindex $__widgetArgs(${function}__${name}__entries) $index]
  } else {
    set new 0
  }
  
  set entries $__widgetArgs(${function}__${entryname}__entries)
  set show $__widgetArgs(${function}__${entryname}__show)
  set title $__widgetArgs(${function}__${entryname}__text)

  ### If there are any entries for the current element, a toplevel
  ### is created for these.
  if {$entries != ""} {
    set w [makeTempWindow $title]
    set function $__editInfo(name)
    if {$new} {
      set counter $__fillOutCounter
    }

    ### creating the frame for the options
    frame $w.options -borderwidth 1 -relief sunken
    pack $w.options  -expand 1 -fill both
    
    ### packing/initialize the children
    foreach child $__children(${function}__$entryname) {
      set default $__widgetArgs(${function}__${child}__default)
      Pack $w.options ${prefix}_$counter $child 1 top 0 1
      if {$new} {
        setVariable $function $child ${prefix}_$counter $default 1
      }
    }
    
    ### Creating the description field
    pack [frame $w.description -bd 0] -fill x
    label $w.description.desc -justify left
    pack $w.description.desc -fill x
    help $entryname $w
    bind $w.description.desc <3> "help $entryname $w"
    
    pack [frame $w.line -height 0.1c -relief sunken -bd 1] -fill x -expand yes

    ### packing the OK buton
    button $w.ok -text $__language(ok) -command "fillOut_OK $entryname $w"
    if {$new} {
      button $w.cancel -text $__language(cancel) -command "set __destroyed 1;destroy $w"
    }
    bind $w.ok <Destroy> "set __destroyed 1"
    pack $w.ok -side left -expand 1
    if {$new} {
      pack $w.cancel -side left -expand 1
    }

    update
    grabSet $w
    ### Due to a bug in Tk I need to take the focus, to avoid another window
    ### still to be active.
    focus $w

    ### creating the change function
    set oldChange $__changeFunc($function)
    set __changeFunc($function) $__widgetArgs(${function}__${entryname}__change)
    setChangeFunc

    ### makes the element the active
    UpdateActive $entryname ${prefix}_$counter
    set __activeNivau($entryname) $counter
    linkVars $function ${prefix}_$counter $entryname

    ### initializing the page the first time, and setup the init function
    ### remember: the init function is called whenever a new element is
    ### inserted into an extentry
    set oldInit $__initFunc($function)
    set __initFunc($function) $__widgetArgs(${function}__${entryname}__init)
    if {$new} {
      uplevel \#0 $__widgetArgs(${function}__${entryname}__init)
      changeAll $entryname
      set __clean(${prefix}_$counter) 1
    }

    ### Call the ShowPage function and change if the page is not clean
    uplevel \#0 $__widgetArgs(${function}__${entryname}__showPage)
    if {! [info exists __clean(${prefix}_$counter)]} {
      changeAll $entryname
      set __clean(${prefix}_$counter) 1
    }
    
    # waiting for the window to disappear
    tkwait window $w

    if {$new} {
      incr __fillOutCounter
    }

    ### restore change/init function
    set __changeFunc($function) $oldChange
    set __initFunc($function) $oldInit
    setChangeFunc

    ### checking whether the window was destroyed.
    global __destroyed
    if {[info exists __destroyed]} {
      unset __destroyed
      unset __activeNivau($entryname)
      unlink $function $entryname ""
      return
    }
    
  }

  # showing the information
  catch {unset __answers}
  set __answers ""

  # redefining the print function
  saveDefinition print
  proc print {args} {
    global __answers __editInfo
    append __answers [join $args]
  }
  
  uplevel \#0 $show

  # redefining the print function to its original.
  loadDefinition print

  # deleteing the information from __activeNivau while the page has been
  # removed.
  if {$entries != ""} {
    unset __activeNivau($entryname)
    unlink $function  $entryname ""
  }
  
  ### inserting the element 
  set elmLength [string length $__answers]
  if {$type == "entry"} {
    set index [$path.2 index insert]
  } else {
    set index [string length [$path.2 get 1.0 insert]]
  }
  
  set changeNext 1
  set newList {}
  ### running through the list and updates it with the new element inserted.
  foreach elm $__fillList($prefix) {
    set start [lindex $elm 0]
    set end [lindex $elm 1]
    set insertNext 1
    if {$start < $index} {
      lappend newList $elm
    } else {
      if {$changeNext} {
        if {!$new} {
          if {$type == "entry"} {
            $path.2 delete $start [expr $end+1]
          } else {
            $path.2 delete "1.0 + ${start}c" "1.1 +${end}c"
          }
          set insertNext 0
        }
        lappend newList \
            [list $index [expr $index+$elmLength-1] $entryname $counter]
        if {!$new} {
          set elmLength [expr $elmLength - ($end-$start)-1]
        }
        set changeNext 0
      }
      if {$insertNext} {
        lappend newList \
            [lreplace $elm 0 1 \
                 [expr $start+$elmLength] [expr $end+$elmLength]]
      }
    }
  }

  $path.2 insert insert $__answers
  if {$type == "entry"} {
    tkEntrySeeInsert $path.2
  } else {
    $path.2 see insert
  }
  if {$changeNext} {
    lappend newList [list $index [expr $index+$elmLength-1] $entryname $counter]
  }
  set __fillList($prefix) $newList
}

############################################################
### This function takes care of insertion and motion in
### the fillout's entry.
### As the Tk actions are disabled, this function has
### to take care of everything.
############################################################
proc fillOutInsert {path prefix name index key state keysymb} {
  global __fillList __editInfo __widgetArgs
  set specialKey ""
  set newList {}
  set function $__editInfo(name)
  set type $__widgetArgs(${function}__${name}__tp)
  
  ### remove modifiers
  foreach k {Mod Shift Alt Lock Control Meta Caps Multi \\?\\? Tab Escape!} {
    if {[string match $k* $keysymb]} {
      return
    }
  }

  ### Check for special keys
  if {$keysymb == "BackSpace"} {
    set specialKey BackSpace
    if {$type == "entry"} {
      tkEntryBackspace $path.2
    } else {
      if {$index != "1.0"} {
        $path.2 delete "$index -1c"
        set index [$path.2 index $index]
      }
    }
  }
  if {$keysymb == "Delete" || ($keysymb == "d" && $state&4)} {
    set specialKey Delete
    $path.2 delete insert
  }
  if {$keysymb == "Left" || ($keysymb == "b" && $state&4)} {
    set specialKey Left
    if {$type == "entry"} {
      $path.2 icursor [expr $index-1]
      tkEntrySeeInsert $path.2
    } else {
      $path.2 mark set insert [$path.2 index "$index -1c"]
      $path.2 see insert
    }
  }
  if {$keysymb == "Right" || ($keysymb == "f" && $state&4)} {
    set specialKey Right
    if {$type == "entry"} {
      $path.2 icursor [expr $index+1]
      tkEntrySeeInsert $path.2
    } else {
      $path.2 mark set insert [$path.2 index "$index +1c"]
      $path.2 see insert
    }
  }
  if {$keysymb == "Up" || $keysymb == "Down"} {
    if {$type == "entry"} return
    set specialKey $keysymb
    
    regexp {.([0-9]+)$} $index all thisChar

    if {$keysymb == "Up"} {
      set linestart [$path.2 index "$index linestart"]
      regexp {^([0-9]+).([0-9]+)$} \
          [$path.2 index "$linestart -1c"] all otherLine otherChar
    } else {
      set lineend  [$path.2 index "$index lineend"]
      regexp {^([0-9]+).([0-9]+)$} \
          [$path.2 index "$lineend+1c lineend"] all otherLine otherChar
    }
    if {$thisChar > $otherChar} {
      set newIndex $otherLine.$otherChar
    } else {
      set newIndex $otherLine.$thisChar
    }
    $path.2 mark set insert $newIndex
    set newIndex [string length [$path.2 get 1.0 $newIndex]]
    $path.2 see insert
  }
  if {$keysymb == "e" && $state&4} {
    # end of line
    if {$type == "entry"} {
      $path.2 icursor end
      tkEntrySeeInsert $path.2
    } else {
      $path.2 mark set insert [$path.2 index "$index lineend"]
      $path.2 see insert
    }
    return
  }
  if {$keysymb == "a" && $state&4} {
    # start of line
    if {$type == "entry"} {
      $path.2 icursor 0
      tkEntrySeeInsert $path.2
    } else {
      $path.2 mark set insert [$path.2 index "$index linestart"]
      $path.2 see insert
    }
    return
  }
  if {$keysymb == "Return"} {
    set specialKey Return
  }
  if {$specialKey == "" && ($state&4 || $state&8)} return

  ### Set the number of elements to be inserted/erasured
  if {$specialKey == "Delete"} {
    set count -1
  } elseif {$specialKey == "BackSpace"} {
    if {($index != 0 && $type =="entry") || ($index != "1.0" && $type == "text")} {
      set count -1
    } else {
      set count 0
    }
  } elseif {$specialKey == "Left" || $specialKey == "Right" ||
          $specialKey == "Up" || $specialKey == "Down"} {
    set count 0
  } elseif {$specialKey == "Return"} {
    if {$type == "entry"} {
      ### Do nothing
      set count 0
    } else {
      set count 1
      $path.2 insert $index \n
      $path.2 see insert
    }
  } else {
    if {$type == "entry"} {
      tkEntryInsert $path.2 $key
    } else {
      $path.2 insert insert $key
      $path.2 see insert
    }
    set count 1
  }

  if {$type == "text"} {
    set index [string length [$path.2 get 1.0 $index]]
  }
  ### runs through the list of fill elements
  foreach elm $__fillList($prefix) {
    set start [lindex $elm 0]
    set end [lindex $elm 1]
    set insertNext 1

    ### BackSpace
    if {$specialKey == "BackSpace" && 
    (($end == $index-1 && $type == "entry") || ($end == $index && $type == "text")) } {
      set count [expr -($end-$start+1)]
      if {$type == "entry"} {
        $path.2 delete $start $end
        tkEntrySeeInsert $path.2
      } else {
        $path.2 delete "1.0 + ${start}c" "1.0 + ${end}c"
        $path.2 see insert
      }
      set insertNext 0
    }

    ### Delete
    if {$specialKey == "Delete" && $start == $index} {
      set count [expr -($end-$start+1)]
      if {$type == "entry"} {
        $path.2 delete $start $end
        tkEntrySeeInsert $path.2
      } else {
        $path.2 delete "1.0 + ${start}c" "1.0 + ${end}c"
        $path.2 see insert
      }
      set insertNext 0
    }

    ### Left
    if {$specialKey == "Left" && $end == $index-1} {
      if {$type == "entry"} {
        $path.2 icursor $start
        tkEntrySeeInsert $path.2
      } else {
        $path.2 mark set insert "1.0 +${start}c"
        $path.2 see insert
      }
      return
    }

    ### Right
    if {$specialKey == "Right" && $start == $index} {
      if {$type == "entry"} {
        $path.2 icursor [expr $end+1]
        tkEntrySeeInsert $path.2
      } else {
        $path.2 mark set insert "1.1 +${end}c"
        $path.2 see insert
      }
      return
    }

    ### Up or Down
    if {$specialKey == "Up" || $specialKey == "Down"} {
      if {$newIndex > $start && $newIndex <= $end} {
        if {$specialKey == "Up"} {
          set newIndex $start
        } else {
          set newIndex [expr $end+1]
        }
        $path.2 mark set insert "1.0 + ${newIndex}c"
        return
      }
    }

    ### update the list if elements are inserted or deleted
    if {$start < $index-1} {
      if {$insertNext} {
        lappend newList $elm
      }
    } else {
      if {$insertNext} {
        lappend newList \
            [lreplace $elm 0 1 [expr $start+$count] [expr $end+$count]]
      }
    }
  }
  set __fillList($prefix) $newList
  if {$type == "text"} {
    global ${prefix}
    set ${prefix} [$path.2 get 1.0 end]

  }
}

############################################################
# This function checks wether the cursor is placed on
# a FillOuElm in the entry. If it is it calls fillout_list
############################################################
proc fillOutSet {path prefix name x y} {
  global __fillList __widgetArgs __editInfo
  set function $__editInfo(name)
  set type $__widgetArgs(${function}__${name}__tp)

  ### first set the cursor in the entry, this is not done
  ### automaticly, as the tk procedures are not called!
  if {$type == "entry"} {
    tkEntryButton1 $path.2 $x
    set index [$path.2 index insert]
  } else {
    $path.2 mark set insert @$x,$y
    set index [string length [$path.2 get 1.0 @$x,$y]]
    focus $path.2
  }

  foreach elm $__fillList($prefix) {
    set start [lindex $elm 0]
    set end [lindex $elm 1]
    if {$index <= $start} break
    if {$index > $end} continue
    if {$type == "entry"} {
      $path.2 icursor $start
    } else {
      $path.2 mark set insert "1.0 +${start}c"
    }
    set elmName [lindex $elm 2]
    if {$__widgetArgs(${function}__${elmName}__entries) == ""} {
      set text $__widgetArgs(${function}__${elmName}__text)
      set help $__widgetArgs(${function}__${elmName}__help)
      if {![winfo exists .fillOutInfo]} {
        toplevel .fillOutInfo
        pack [message .fillOutInfo.message]
        pack [button .fillOutInfo.ok \
                  -command {catch "destroy .fillOutInfo"} -text OK]
      }
      .fillOutInfo.message configure -text "$text\n\n$help"
    } else {
      fillout_list $prefix $path $name $elmName [lindex $elm 3]
    }
    break
  }
}

proc fillOutPaste {path prefix name x y} {
  global __fillList __widgetArgs __editInfo __language
  set function $__editInfo(name)
  set type $__widgetArgs(${function}__${name}__tp)
  
  ### calculate the index, for the cursor
  if {$type == "entry"} {
    set index [$path.2 index @$x]
  } else {
    set index [string length [$path.2 get 1.0 @$x,$y]]
  }

  ### decide the length of the clipboard
  if {[catch "selection get"]} {
    error $__language(fillouts,1)
  }
  set selection [selection get]
  set len [string length $selection]

  ### run through the elements
  set newlist {}
  foreach elm $__fillList($prefix) {
    set start [lindex $elm 0]
    set end [lindex $elm 1]
    if {$index > $start && $index <= $end} {
      error $__language(fillouts,2)
    }

    if {$index <= $start} {
      set start [expr $start + $len]
      set end [expr $end + $len]
    }
    lappend newlist [lreplace $elm 0 1 $start $end]
  }
  set __fillList($prefix) $newlist

  ### insert the text
  if {$type == "entry"} {
    $path.2 icursor @$x
  } else {
    $path.2 mark set insert @$x,$y
    focus $path.2
  }
  $path.2 insert insert $selection
}

############################################################
### This function set the variable associated to a FillOut
### The value is calculated from all the save functions.
############################################################
proc fillOutSave {function name func} {
  global __widgetArgs __children __editInfo __fillList __fillAnswer __activeNivau __parent __func
  if {$func == ""} {
    set funcPre ""
  } else {
    set funcPre $func@
  }
  ### link the actual variable to the one called result in our scope
  upvar \#0 $funcPre$name result
  
  ### redefining the print function
  saveDefinition print
  proc print {args} {
    global __fillAnswer __editInfo
    append __fillAnswer [join $args]
  }
  set lastend -1
  set result ""
  set prefix [buildPath $name $func]
  global ${prefix}_$name
  
  ### runnning through all the elements of the FillOut
  foreach elm $__fillList(${prefix}_$name) {
    set start [lindex $elm 0]
    set end [lindex $elm 1]
    set entryname [lindex $elm 2]
    set counter [lindex $elm 3]
    set save $__widgetArgs(${function}__${entryname}__save)
    
    ### read the text up to the last token
    append result \
    [string range [set ${prefix}_$name] [expr $lastend+1] [expr $start-1]]
    
    ### evaluating the save function.
    set __activeNivau($entryname) $counter
    linkVars $function ${prefix}_${name}_$counter $entryname $func
    set __fillAnswer ""
    set __func $funcPre
    uplevel \#0 $save
    unset __func
    unset __activeNivau($entryname)
    unlink $function $entryname $func
    
    append result $__fillAnswer
    set lastend $end
  }
  
  append result [string range [set ${prefix}_$name] [expr $lastend+1] end]
  
  ### redefining the print function to its original.
  loadDefinition print
}

############################################################
# This function make help available foreach listbox element
############################################################
proc fillout_help {path name y} {

  global __widgetArgs __editInfo
  set function $__editInfo(name)
  set index [$path.box nearest $y]
  set elmName [lindex $__widgetArgs(${function}__${name}__entries) $index]
  set help $__widgetArgs(${function}__${elmName}__help)
  if {$help == "No Help"} {
    set help $__widgetArgs(${function}__${name}__help)
    set text $__widgetArgs(${function}__${name}__text)
  } else {
    set text $__widgetArgs(${function}__${elmName}__text)
  }
  setDesc "$text\n\n$help" $path
}

############################################################
# This function set the default value for a fillOut elm.
############################################################
proc fillOut_setDefault {function name prefix default} {
  global ${prefix}_$name __widgetArgs __fillList __children __answers
  global __fillOutCounter
  set percent 0
  set slash 0
  set string ""
  set intext 1
  set child "" ; # name of the next child to handle.
  set entryIndex 0; # index in the entry
  set ${prefix}_$name ""
  set __fillList(${prefix}_$name) {}
  
  ### parsing the default string.
  for {set index 0} {$index < [string length $default]} {incr index} {
    set char [string index $default $index]
    switch -exact -- $char {
      \\ {
        if {$slash} {
          append string "\\"
        }
        set slash [expr ($slash+1) %2]
      }
      
      % {
        if {$slash} {
          append string "%"
          set slash 0
        } else {
          # The start/end of a elmenet or a variable
          if {$intext} {
            # The content of string is just ordanary text which shal be
            # inserted in the entry
            append ${prefix}_$name $string
            set intext 0
            incr entryIndex [string length $string]
            set string ""
          } else {
            # the content of string is either the name of a element
            # or the value of a variable
            if {$child != ""} {
              # the value of string is the content to the variable,
              # named '$child'
              setVariable $function $child \
                  ${prefix}_${name}_$__fillOutCounter $string 1
              set child \
                  [lindex $childs [expr [lsearch -exact $childs $child] +1]]
              
            } else {
              # now we got a element.

              set elmName $string
              if {[lsearch -exact $__children(${function}__$name) $elmName] == -1} {
                error "$elmName was not a element in $name,\nwhile reading default string $default.\nThe error was found when an element name was wanted at string index $index"
              }

              # checking whether the element have any __children
              set childs $__children(${function}__$elmName)
              if {$childs != ""} {
                set child [lindex $childs 0]
                incr __fillOutCounter
              }
            }

            if {$child == ""} {
              ### read the last child (if there was any)
              set intext 1

              # redefining the print function
              saveDefinition print
              proc print {args} {
                global __answers __editInfo
                append __answers [join $args]
              }

              ### linking variables and evaluating the save function.
              if {$childs != ""} {
                set __activeNivau($elmName) $__fillOutCounter
                linkVars $function ${prefix}_${name}_$__fillOutCounter \
                    $elmName ""
              }
              catch {unset __answers}
              set __answers ""
              uplevel \#0 $__widgetArgs(${function}__${elmName}__show)
              if {$childs != ""} {
                unset __activeNivau($elmName)
                unlink $function $elmName ""
              }
              # redefining the print function to its original.
              loadDefinition print

              # inserting the element
              append ${prefix}_$name $__answers
              if {$childs != ""} {
                set c $__fillOutCounter
              } else {
                set c -1
              }
              lappend __fillList(${prefix}_$name) \
                  [list $entryIndex \
                       [expr $entryIndex+[string length $__answers]-1]\
                       $elmName $c]
              incr entryIndex [string length $__answers]
            }
          }
          set string ""
        }
      }

      default {
        if {$slash} {
          append string "\\"
          set slash 0
        }
        append string $char
      }
    }
  }
  if {$child != ""} {
    error "missing values to \"$elmName\", got to element \"$child\", in default string to element \"$name\""
  }
  if {!$intext} {
    error "End of default string, when reading an element, in \"$name\""
  }
  append ${prefix}_$name $string
}

######################################################################
### This function is invoked when the user press the OK button
### or kill the window on a page, which configures a FillOutElm
######################################################################
proc fillOut_OK {entryname w} {
  global __widgetArgs __editInfo __destroyed __func __language
  upvar \#0 __errmsg errmsg
  set function $__editInfo(name)
  ### expand should not be used in pageEnd!
  ### Sat Mar  1 01:53:32 1997 -- Jesper Pedersen
  ###  set __func ""; # used by expand
  set err [uplevel \#0 catch \{$__widgetArgs(${function}__${entryname}__pageEnd)\} __errmsg]
  if {$err} {
    tk_dialog .errmsg $__language(fillouts,3) $errmsg error 0 $__language(ok)
    return
  }
  catch {destroy $w}
  unset __destroyed
  grab release $w
}

######################################################################
### This function evaluates the show function, which should be done
### before the element is shown. Because it may depend on other pages
######################################################################
proc fillOut_setShow {function name prefix} {
  global __fillList __widgetArgs __answers __children
  upvar \#0 ${prefix}_$name fillElm

  set lastEnd -1
  set result ""
  set newFillList ""


  if {![info exists __fillList(${prefix}_$name)]} {
    ### this happens when setShow is called on an uninitialized element
    ### which is one in an extentry, where there's not scrolled to this
    ### element yet.
    return
  }
      
  foreach elm $__fillList(${prefix}_$name) {
    set start [lindex $elm 0]
    set end [lindex $elm 1]
    set entryName [lindex $elm 2]
    set counter [lindex $elm 3]
    set childs $__children(${function}__$entryName)
    
    append result [string range $fillElm [expr $lastEnd+1] [expr $start-1]]

    ### makes the element the active
    if {$childs != ""} {
      UpdateActive $entryName ${prefix}_${name}_$counter
      set __activeNivau($entryName) $counter
      linkVars $function ${prefix}_${name}_$counter $entryName
    }
    
    catch {unset __answers}
    set __answers ""

    # redefining the print function
    saveDefinition print
    proc print {args} {
      global __answers __editInfo
      append __answers [join $args]
    }

    uplevel \#0 $__widgetArgs(${function}__${entryName}__show)

    if {$childs != ""} {
      unset __activeNivau($entryName)
      unlink $function $entryName ""
    }

    # redefining the print function to its original.
    loadDefinition print

    set newStart [string length $result]
    append result $__answers
    lappend newFillList [list $newStart [expr [string length $result]-1] \
                             $entryName $counter]
    set lastEnd $end
  }
  append result [string range $fillElm [expr $lastEnd+1] end]

  set fillElm $result
  set __fillList(${prefix}_$name) $newFillList
}