######################################################################
### This is the main function for the import mechanism.
### This will import the file called 'filename'
######################################################################
proc import-file {fileName} {
  global __LINENO __DEBUG __INPUT __token __page __readPage
  global __progList __err loadingExports __activeNivau __language

  set loadingExports 1
  
  if {![file exists $fileName]} {
    error "File \"$filename\" doesn't exist"
  }

  set __token ""
  set __page ""

  if {![info exists __DEBUG]} {
    set __DEBUG 0
  }
  set __LINENO 1
  set __INPUT [open $fileName]
  set __readPage 0

  timeWindow [expr [llength $__progList]+1] "Importing" \
      $__language(import,1)
  read_imports
  incrTimeWindow
  destroyTimeWindow
  set loadingExports 0

  catch "unset __activeNivau"
}

######################################################################
############################## PARSER ################################
######################################################################
### This is the parser for the import format. See the dotdot
### documentation for a BNF diagram. Each production in the diagram
### result in a function called read_<production>
######################################################################

######################################################################
proc read_imports {} {
  global __INPUT
  
  while {[lsearch -exact {checkbox entry int float radio menu listbox command\
                              extentry fillout page textbox combobox label} \
              [nextToken]] != -1} {
    ########## imports -> import | import imports ##########
    read_import
  }
  if {![eof $__INPUT]} {
    import_error imports "Unexpected token: \"[nextToken]\" (expected one of:"\
        "checkbox entry int float textbox combobox label radio menu listbox"\
        "command extentry fillout page)"
  }
  debugInfo "Read all text!"
}
######################################################################
proc read_import {} {
  global __page __progList __readPage __loadOverWrite __loadMerge

  if {[nextToken] == "page"} {
    ########## import -> page id ##########
    readToken "page" import
    set id [readId]
    
    debugInfo read page '$id'
    if {[lsearch -exact $__progList $id] == -1} {
      import_warning read_import "Page \"$id\" doesn't exists in the module"
      set __page ""
    } else {
      set __readPage 1
      incrTimeWindow
    }
    if {[lsearch $__loadOverWrite $id] == -1 &&
        [lsearch $__loadMerge $id] == -1} {
      ### The page is not to be loaded
      set __page ""
    } else {
      set __page $id
    }
      
  } else {
    ########## import -> element ##########
    if {$__readPage == ""} {
      import_error import "You have to start the file with a page"
    }
    read_element top __$__page
  }
}
######################################################################
proc read_elements {parent prefix} {
  global __INPUT
  set count 0
  while {[lsearch -exact {checkbox entry int float radio menu listbox command\
                           textbox combobox label extentry fillout} [nextToken]] != -1} {
    ########## elements -> element | element elements ##########
    read_element $parent $prefix
    incr count
  }
  if {$count == 0} {
    import_error elements "unexpected token: \"[nextToken]\"" \
        "(expected on of: checkbox entry int float radio menu listbox"\
        "textbox combobox label command extentry fillout page)"
  }
}
######################################################################
proc read_element {parent prefix} {
  global __widgetArgs __page __entryIndex
  set token [nextToken]
  switch -- $token {
    checkbox -
    entry -
    int -
    float -
    combobox -
    textbox -
    label -
    command  -
    radio -
    menu -
    listbox {
      ########## element -> checkbox id val ##########
      readToken $token element
      set id [readId]
      set val [readVal element]
      debugInfo read $token '$id' '$val'
      import_assign element $token $id $val $parent $prefix
    }
    extentry {
      ########## element -> extentry id extentry_val ##########
      readToken extentry element
      set id [readId]

      ### testing if the element exists
      set ok [import_isType element extentry $id $parent]
      if {!$ok} {
        set page $__page
        set __page ""
      }
      read_extentry_val $id $prefix
      debugInfo read extentry '$id' ...
      if {!$ok} {
        set __page $page
      }
    }
    fillout {
      ########## element -> fillout id { fillout_vals }  ##########
      readToken fillout element
      set id [readId]

      ### testing if the element exists
      set ok [import_isType element fillout $id $parent]
      if {!$ok} {
        set page $__page
        set __page ""
      }
      
      ### setting up to read fillout_elms
      if {$__page != ""} {
        set __entryIndex 0
        uplevel \#0 "set ${prefix}_$id {}"
        uplevel \#0 "set __fillList(${prefix}_$id) {}"
      }

      ### reading the arguments
      readToken \{ element
      read_fillout_vals $id $prefix
      readToken \} element
      debugInfo read fillout '$id' ...
      if {!$ok} {
        set __page $page
      }
    }
    default {
      import_error element "unexpected token: \"[nextToken]\""\
          "(expected one of: checkbox entry int float textbox combobox label radio menu"\
          "listbox command extentry fillout)"
    }
  }
}
######################################################################
proc read_extentry_val {parent prefix} {
  global __page __children __scrollBar __widgetArgs changeElm __initFunc
  global __editInfo
  set count 0
  if {$__page != ""} {
    set maxentries $__widgetArgs(${__page}__${parent}__maxentries)
    if {$maxentries != "Inf"} {
      set index 0
    } else {
      set index [lindex $__scrollBar(${prefix}_$parent) 1]
    }
  } else {
    set index 0 ;# just a dummy variable
  }
  
  
  while {[nextToken] == "\{" } {
    ### initializing
    if {$__page != ""} {
      foreach child $__children(${__page}__$parent) {
        setVariable $__page $child ${prefix}_$parent$index \
            $__widgetArgs(${__page}__${child}__default) 0
        changeState $__page ${prefix}_$parent$index $child normal 1
      }
      ### call the init function
      set __editInfo(name) $__page
      UpdateActive $child ${prefix}_$parent$index
      set changeElm $parent
      uplevel \#0 $__initFunc($__page)
      unlink $__page top ""
    }

    readToken \{ extentry_val
    if {[nextToken] != "\}"} {
      read_elements $parent ${prefix}_$parent$index
    }
    readToken \} extentry_val
    incr count
    incr index
  }

  ### Setting the scrollbar
  if {$__page != ""} {
    if {$maxentries == "Inf"} {
      set __scrollBar(${prefix}_$parent) "0 $index"
    } else {
      set __scrollBar(${prefix}_$parent) "0 $maxentries"
    }
  }
  
  if {$count == 0 && $__page != ""} {
    import_error extentry_val \
        "unexpected token: \"[nextToken]\" (expected \"\{\")"
  }
}
######################################################################
proc read_fillout_vals {parent prefix} {
  set count 0
  while {[nextToken] != "\}"} {
    if {[nextToken] == "text" || [nextToken] == "filloutelm"} {
      read_fillout_val $parent $prefix
      incr count
    } else {
      import_error fillout_vals "unexpected token: \"[nextToken]\""\
          "(expected either \"text\" or \"filloutelm\")"
    }
  }
  if {$count == 0 && $__page != ""} {
    import_error fillout_vals "unexpected token \"[nextToken]\""
  }
}
######################################################################
proc read_fillout_val {parent prefix} {
  global __fillOutCounter __entryIndex __page __children __widgetArgs
  global __fillList __activeNivau

  if {$__page != ""} {
    upvar \#0 ${prefix}_$parent variable
  }
  switch -- [nextToken] {
    filloutelm {
      ########## fillout_val -> filloutelm id { filloutelm_val } ##########
      readToken filloutelm fillout_val
      set id [readId]

      ### testing if the element exists
      set ok [import_isType element filloutelm $id $parent]
      if {!$ok} {
        set page $__page
        set __page ""
      }

      ### getting ready to read the children of the element
      if {$__page != "" && $__children(${__page}__$id) != {}} {
        incr  __fillOutCounter
        foreach child $__children(${__page}__$id) {
          setVariable $__page $child ${prefix}_${parent}_$__fillOutCounter \
              $__widgetArgs(${__page}__${child}__default) 0
        }
      }
      
      ### reading the arguments
      readToken \{ fillout_val
      read_filloutelm_val $id ${prefix}_${parent}_$__fillOutCounter
      readToken \} fillout_val

      ### initializeing non set elements of extentries
      if {$__page != ""} {
        foreach child $__children(${__page}__$id) {
          setDefaultsFromElm $__page $child \
              ${prefix}_${parent}_${__fillOutCounter}_$child \
              $__widgetArgs(${__page}__${child}__default)
        }
      }

      ### inserting the result in the string
      if {$__page != ""} {
        append variable DUMMY
        if {$__children(${__page}__$id) != {}} {
          set c $__fillOutCounter
        } else {
          set c -1
        }

        lappend __fillList(${prefix}_$parent) \
            [list $__entryIndex \
                 [expr $__entryIndex+[string length DUMMY]-1]\
                 $id $c]
        incr __entryIndex [string length DUMMY]
      }
      
      if {!$ok} {
        set __page $page
      }
    }
    text {
      ########## fillout_val -> text val ##########
      readToken text fillout_val
      set val [readVal fillout_val]
      if {$__page != ""} {
        incr __entryIndex [string length $val]
        append variable $val
      }
    }
    default {
      import_error fillout_val "unexpected token: \"[nextToken]\""\
          "(expected either \"text\" or \"filloutelm\")"
    }
  }
}
######################################################################
proc read_filloutelm_val {parent prefix} {
  if {[lsearch -exact {checkbox entry int float textbox combobox label radio menu\
                           listbox command extentry fillout} \
           [nextToken]] != -1} {
    read_elements $parent $prefix
  } elseif {[nextToken] == "\}"} {
    return
  } else {
    import_error filloutelm_val "unexpected token \"[nextToken]\""\
        "(expected one of: checkbox entry int float textbox combobox label radio menu"\
        "listbox command extentry fillout or \"\}\""
  }
}








######################################################################
############################# LEXER ##################################
######################################################################
### The lexer consist of two major function:
### getNextToken - The parser expect a keyword, an identifier or
###                a brace, as the next element
### readVal      - The parser expect a value as the next element
###
### The reason for this split up is that the lexer have to be
### context sensitiv to know what to do, when it read a start brace
### Ie. is { checkbox a 1 } a block, which set the checkbox a to 1
### or is it a value delimited with braces.
######################################################################

######################################################################
### This function return the next string, which is to be read. This
### function is only called when a keyword, identifier or brace is
### expected.
######################################################################
proc nextToken {} {
  global __token
  if {$__token == ""} {
    getNextToken
  }
  return [string tolower $__token]
}

######################################################################
### This function test wether the next token is 'token', and
### if it is it removes the token from the input, otherwise
### an error is raise.
######################################################################
proc readToken {token rule} {
  global __token
  if {$__token == ""} {
    getNextToken
  }
  if {[string tolower $__token] == $token} {
    set __token ""
  } else {
    import_error $rule "unexpected token \"$__token\", (expected $token)"
  }
}

######################################################################
### This function read an identifier from the input.
######################################################################
proc readId {} {
  global __INPUT __token
  if {$__token == ""} {
    getNextToken
  }
  set ret $__token
  set __token ""
  return $ret
}

######################################################################
### This function read characters from the input, in the hope
### that it will find either a keyword, an identifier og a brace.
######################################################################
proc getNextToken {} {
  global __INPUT __LINENO __token
  set char [readSpace]

  while {![eof $__INPUT]} {
    switch -- $char {
      " " -
      "\t" {return}
      "\n" {incr __LINENO; return}
      "\"" -
      "\\" -
      "$" -
      "!" -
      "@" -
      "." -
      "\#" -
      "%" -
      "^" -
      "(" -
      ")" -
      "=" -
      "+" -
      "[" -
      "]" {
        import_error "???" "illigel character in keyword or id: \"$char\""
      }
      "\{" -
      "\}" {
        if {$__token == ""} {
          set __token $char
          return
        } else {
          seek $__INPUT -1 current
          return
        }
      }
      default {
        append __token $char
      }
    }
    set char [read $__INPUT 1]
  }
  debugInfo "EOF while reading keyword or identifyer, read \"$__token\""
}
      
  
######################################################################
### This function read a value from the input
######################################################################
proc readVal {rule} {
  global __token __INPUT __LINENO
  if {$__token != ""} {
    import_error "???" "Internal error: read value after a getToken!"
  }

  set slash 0
  set text ""
  set newSlash 0
  set level 0
  
  set char [readSpace]
  ### how is the next token delimited
  switch -- $char {
    "\"" {
      set delim quote
      set char [read $__INPUT 1]
      set __nextToken val
    }
    "\{" {
      set delim brace
      set char [read $__INPUT 1]
      set __nextToken val
      set level 1
    }
    default {
      set delim none
    }
  }


  while {![eof $__INPUT]} {
    switch -- $char {
      " " -
      "\t" -
      "\n" {
        if {$char == "\n"} {
          incr __LINENO
        }
        if {$slash} {
          append text " "
        } else {
          if {$delim != "none"} {
            append text $char
          } else {
            return $text
          }
        }
      }
      "\"" {
        if {$slash} {
          append text \"
        } else {
          if {$delim == "quote"} {
            return $text
          } elseif {$delim == "brace"} {
            append text \"
          } else {
            append text \"
          }
        }
      }
      "\\" {
        if {$delim == "brace"} {
          append text "\\"
        } else {
          if {$slash} {
            append text "\\"
          } else {
            set newSlash 1
          }
        }
      }
      "\{" {
        if {$delim == "brace"} {
          incr level
        }
        append text "\{"
      }
      "\}" {
        if {$delim == "brace"} {
          incr level -1
          if {$level == 0} {
            return $text
          }
          if {$level == -1} {
            import_error rule "unmatch \}"
          }
        }
        append text "\}"
      }
      default {
        if {$slash} {
          append text "\\"
        }
        append text $char
      }
    }
    if {$newSlash} {
      set slash 1
    } else {
      set slash 0
    }
    set newSlash 0
    set char [read $__INPUT 1]
  }
  debugInfo "EOF while reading value, read \"$text\""
  return $text
}

######################################################################
### This function is used to discard spaces and comment from the input 
######################################################################
proc readSpace {} {
  global __INPUT __LINENO
  set char [read $__INPUT 1]
  while {$char == " " || $char == "\t" || $char == "\n" || $char == "\#"} {
    if {$char == "\n"} {
      incr __LINENO
    }
    if {$char == "\#"} {
      while {$char != "\n"} {
        set char [read $__INPUT 1]
      }
      incr __LINENO
    }
    set char [read $__INPUT 1]
  }
  return $char
}

  
  




######################################################################
############################## UTILITIES #############################
######################################################################

######################################################################
### This function is used to write debug information about
### what the parser is doing
######################################################################
proc debugInfo {args} {
  global __DEBUG
  if {$__DEBUG} {
    puts [join $args]
  }
}

######################################################################
### This function is used to raise an error in the parser.
######################################################################
proc import_error {rule args} {
  global __LINENO
  error "Error while reading rule \"$rule\", input line $__LINENO (or end of line [expr $__LINENO-1]):\n[join $args]"
}

######################################################################
### This function is used to raise a warning in the parser.
######################################################################
proc import_warning {rule args} {
  global __LINENO
  puts "Warning: (while reading rule \"$rule\")\ninput line $__LINENO (or end of line [expr $__LINENO-1]):\n[join $args]\n\n"
}

######################################################################
### This function assign a value to a simple element
### ie. to a checkbox, entry etc. (not extentry and fillout)
######################################################################
proc import_assign {rule type id val parent prefix} {
  global __page
  if {$__page != ""} {
    if {[import_isType $rule $type $id $parent]} {
      setVariable $__page $id $prefix $val 1
    }
  }
}

######################################################################
### This function check that an element is of the type specified,
### and that the element is a child of the widget just parsed.
######################################################################
proc import_isType {rule type id parent} {
  global __widgetArgs __page __children
  if {$__page != ""} {
    if {![info exists __widgetArgs(${__page}__${id}__type)]} {
      import_warning $rule \
          "There doesn't exists a widget called \"$id\" on page"\
          "\"$__page\""
      return 0
    }
    if {[lsearch -exact [variableChildren $__page $parent] $id] == -1} {
      import_warning $rule "widget \"$id\" is not a child of \"$parent\""
      return 0
    }
    if {$__widgetArgs(${__page}__${id}__type) != $type} {
      set wtype $__widgetArgs(${__page}__${id}__type)
      import_warning $rule "widget \"$id\" has type"\
          "\"$wtype\" on page \"$__page\"\nyou said it had type \"$type\""
      if {$wtype != "extentry" && $wtype != "fillout" &&
          $type  != "extentry" && $type  != "fillout"} {
        ### The types may be compatible
        return 1
      } else {
        return 0
      }
    }
    return 1
  }
  return 1
}