# parserdep.tcl --
#
#        Este fichero implementa el código Tcl para reconocer la secuencia
#        asociada a una dependencia.
#
# Copyright (c) 2000 CIMNE
#

package provide ParserDep 0.1
namespace eval ParserDep {
    namespace export Init Start
    variable StrInput ""
    variable pchr 0
    variable lstr 0
    variable DepList {}
    variable LastValue ""
    variable LastActionList {}
    variable LastAction ""
    variable LastLabel ""
    variable LastArgument ""
    variable ErrFound ""
    variable ActionName { "HIDE" "SET" "RESTORE" "-" "CONDITION" "TITLESTATE" }
}

proc ParserDep::DumpInput { } {
    variable StrInput
    variable pchr
    
    puts [string range $StrInput $pchr end]
}

proc IsSpace { chr } {
    if { ($chr == " ") || ($chr == "\t") } {
	return 1
    } else {
	return 0
    }
}

proc ParserDep::BackChar { } {
    variable pchr

    incr pchr -1
}

proc ParserDep::SkipSpace { } {
    while { [InputAvailable] } {
	set chr [GetChar]
	if { ![IsSpace $chr] } {
	    BackChar
	    break
	}
    }
}

proc ParserDep::GetChar { } {
    variable StrInput
    variable pchr
    
    set chr [string index $StrInput $pchr]
    incr pchr
    return $chr
}

proc ParserDep::SeeChar { } {
    variable StrInput
    variable pchr

    return [string index $StrInput $pchr]
}

proc ParserDep::InputAvailable { } {
    variable pchr
    variable lstr

   
    return [expr $pchr < $lstr]
}

proc ParserDep::Error { {Msg ""} } {
    variable StrInput
    variable pchr
    variable ErrFound

    if { $Msg != "" } {
	set MsgErr "Expected $Msg"
    } else {
	set MsgErr "Unexpected error"
    }
    
    set ErrFound "$MsgErr near position $pchr of $StrInput"
    return 0
}

proc ParserDep::Init { Input } {
    variable StrInput $Input
    variable pchr 0
    variable lstr [string length $Input]
    variable DepList {}
    variable LastActionList {}
    variable LastValue ""
    variable LastAction ""
    variable LastLabel ""
    variable LastArgument ""
    variable ErrFound ""
}

proc ParserDep::AppendAction { } {
    variable LastAction
    variable LastLabel
    variable LastArgument
    variable LastActionList
    
    if { $LastArgument == "" } {
	return [Error "Argument"]
    } else {
	#regsub -all "_" $LastArgument " " LastArgument

# 	WarnWinText "Aceptada la accion [list $LastAction $LastLabel $LastArgument]"

	if [string equal $LastAction "TITLESTATE"] {
	    set LastArgument [string tolower $LastArgument]
	}
	lappend LastActionList [list $LastAction $LastLabel $LastArgument]
	return 1
    }
}

proc ParserDep::AppendDep { } {
    variable LastValue
    variable LastActionList
    variable DepList

    if { [AppendAction] } {
	lappend DepList [list $LastValue $LastActionList]
	return 1
    }
    return 0
}

proc ParserDep::AppendImplicit { } {
    variable LastValue
    variable DepList

    lappend DepList [list $LastValue "-"]
    return 1
}

proc ParserDep::LookFor { L } {
    while { [InputAvailable] } {
	set cchr [GetChar]
	foreach A $L {
	    if { $cchr == [lindex $A 0] } {
		set CheckCmd [lindex $A 1]
		set NextState [lindex $A 2]
		if { ($CheckCmd != "") && ![$CheckCmd] } {
		    return 0
		}
		return [$NextState]
	    }
	}
	switch -- $cchr {
	    " " -
	    "\t" {
		continue
	    }
	    default {
		return [Error $cchr]
	    }
	}
    }
}

proc ParserDep::Start { } {
    
    SkipSpace

    if { [InputAvailable] } {
	set chr [GetChar]
	if { $chr == "(" } {
	    return [ParserValue]
	} else {
	    return [Error "("]
	}
    } else {
	return 1
    }
}

proc ParserDep::XXXX { } {
    # esto es un case de ParserValue

    "\"" {
	while [InputAvailable] {
	    set chr [GetChar]
	    if { $chr == "\"" } {
		break
	    }
	    append LastValue $chr
	}
	if { $chr != "\"" } {
	    return [Error "\""]
	}
    }
}

proc ParserDep::ParserValue { } {
  variable LastValue
  variable LastActionList {}
  
  SkipSpace
  set LastValue ""
  while { [InputAvailable] } {
    set chr [GetChar]
    switch -- $chr {
      "\"" {
        while [InputAvailable] {
          set chr [GetChar]
          if { $chr == "\"" } {
            break
          }
          append LastValue $chr
        }
        if { $chr != "\"" } {
          return [Error "\""]
        }
      }
      "," {
        return [ParserAction]
      }
      ")" {
        return [Error ","]
      }
      default {
        append LastValue $chr
      }
    }
  }
  return [Error ","]
}

# Comentado, 27/11/00
# 	    " " -
# 	    "\t" {
# 		return [LookFor {{"," "" ParserAction}}]
#	    }


proc ParserDep::CheckValue { } {
    variable LastValue
    
    set LastValue [string trim $LastValue]
    if { $LastValue == "" } {
	return [Error "Value"]
    }
    if { ![string compare [string toupper $LastValue] "\#DEFAULT\#"] } {
	set LastValue "default"
    } else {
	#regsub -all "_" $LastValue " " LastValue
    }
#     WarnWinText "Aceptado el valor $LastValue"
    return 1
}

proc ParserDep::ParserAction { } {
    variable LastActionList
    variable LastAction
    
    if { ![CheckValue] } {
	return 0
    }
    SkipSpace
    set LastAction ""
    if { [llength $LastActionList] == 0 } {
	if { [set chr [SeeChar]] == "-" } {
	    GetChar
	    return [LookFor {{")" AppendImplicit Start}} ]
	}
    }
    while { [InputAvailable] } {
	set chr [GetChar]
	switch -- $chr {
	    "," {
		return [ParserLabel]
	    }
	    ")" {
		return [Error ","]
	    }
	    " " -
	    "\t" {
		return [LookFor {{"," CheckAction ParserLabel}}]
	    }
	    default {
		append LastAction $chr
	    }
	}
    }
    return [Error ","]
}

proc ParserDep::CheckAction { } {
    variable LastAction
    variable ActionName

    if { $LastAction == "" } {
	return [Error "Action"]
    }
    set LastAction [string toupper $LastAction]
    if { [lsearch -exact $ActionName $LastAction] == -1 } {
	set strerr ""
	foreach AN $ActionName {
	    append strerr "$AN,"
	}
	return [Error " $strerr instead of $LastAction"]
    } else {
# 	WarnWinText "Aceptada la accion $LastAction"
	return 1
    }
}

proc ParserDep::ParserLabel { } {
    variable LastLabel
    
    if { ![CheckAction] } {
	return 0
    }
    SkipSpace
    set LastLabel ""
    while { [InputAvailable] } {
	set chr [GetChar]
	switch -- $chr {
	    "," {
		return [ParserArgument]
	    }
	    ")" {
		return [Error ","]
	    }
	    " " -
	    "\t" {
		return [LookFor {{"," "" ParserArgument}}]
	    }
	    default {
		append LastLabel $chr
	    }
	}
    }
    return [Error ","]
}

proc ParserDep::ParserArgumentBolsa { } {
    "\"" {
	while [InputAvailable] {
	    set chr [GetChar]
	    if { $chr == "\"" } {
		break
	    }
	    append LastArgument $chr
	}
	if { $chr != "\"" } {
	    return [Error "\""]
	}
    }
}

proc ParserDep::ParserArgument { } {
  variable LastLabel
  variable LastArgument
  
  if { $LastLabel == "" } {
    return [Error "Label"]
  }
  
  #     WarnWinText "Aceptada la referencia $LastLabel"
  
  SkipSpace
  set LastArgument ""
  while { [InputAvailable] } {
    set chr [GetChar]
    switch -- $chr {
      ")" {
        if { [AppendDep] } {
          return [Start]
        } else {
          return 0
        }
      }
      "," {
        if { [AppendAction] } {
          return [ParserAction]
        } else {
          return 0
        }
      }
      "\"" {
        while [InputAvailable] {
          set chr [GetChar]
          if { $chr == "\"" } {
            break
          }
          append LastArgument $chr
        }
        if { $chr != "\"" } {
          return [Error "\""]
        }
      }
      default {
        append LastArgument $chr
      }
    }
  }
  return [Error ")"]
}

# Comentado, 27/11/00
# 	    " " -
# 	    "\t" {
# 		return [LookFor {{"," AppendAction ParserAction} {")" AppendDep Start}}]
#	    }
