#
# $RCSfile: open.itcl,v $ --
#
#     This file contains the implementation for reading/parsing the
# input file according to definition of input syntax as specified in
# guib-definition file.
#
# Copyright (c) 2003--2004  Anton Kokalj   Email: tone.kokalj@ijs.si
#
#
# This file is distributed under the terms of the GNU General Public
# License. See the file `COPYING' in the root directory of the present
# distribution, or http://www.gnu.org/copyleft/gpl.txt .
#
# 
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
# OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
# ANTON KOKALJ BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN
# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
# CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
#
#
# $Id: open.itcl,v 1.6 2008-05-08 18:44:37 kokalj Exp $ 
#

# ------------------------------------------------------------------------
#****m* moduleObj/openFile
#  NAME
#    ::guib::moduleObj::openFile -- open an input-file and calls readFile
#
#  USAGE
#    openFile fileName
#
#  RETURN VALUE
#    Returns opened filename.
#  EXAMPLE
#    $moduleObj openFile myFile.inp
#******
# ------------------------------------------------------------------------

itcl::body ::guib::moduleObj::openFile {fileName} {
    if { ! [file exists $fileName] } {
    	::tclu::errorDialog "file \"$fileName\" does not exists"
	return
    }
    set fileChannel [open $fileName r]
    readFile $fileChannel $fileName
}


# ------------------------------------------------------------------------
#****m* moduleObj/readFile
#  NAME
#    ::guib::moduleObj::readFile -- reads and input-file
#
#  USAGE
#    readFile fileChannel ?fileName?
#
#  DESCRIPTION
#     This method reads the content of file-channel of a given input
# file. An example of the usage of the method is in ::guib::menuOpen
# proc, i.e., upon the user selection of an input file this method is
# called.
#
#  RETURN VALUE
#    OK           -- input file is OK
#    SYNTAX_ERROR -- input file contains syntax errors
#    WRONG_FORMAT -- input file is not in appropriate format
#
#  EXAMPLE
#    $moduleObj readFile $fID myFile.inp
#******
# ------------------------------------------------------------------------

itcl::body ::guib::moduleObj::readFile {fileChannel {fileName {}}} {
    variable ::guib::status

    set readNewLine  1
    set readError    0

    if { $readFilter != "" } {
	set fileChannel [$readFilter $this $fileChannel]
    }

    if { $readError == 1 } { 
	# a fatal syntax error in input file was detected in
	# readfilter routine. Skip reading the file.
	return WRONG_FORMAT
    }

    ::tku::watchExec {_open $this $fileChannel}
    
    if { [winfo exists $toplevel] } {
	# a moduleObj has its own toplevel (i.e. ::guib::simpleTplwGUI mechanism)
	set title   [$this cget -title]    
	set postfix "(File: [file tail $fileName]) (No.$::guib::module($title))"
	set toplevelTitle "$title $postfix"
	$toplevel configure -title $toplevelTitle    
    }

    if { $readError } {
	return SYNTAX_ERROR
    }

    return OK  
}


# ------------------------------------------------------------------------
#****m* moduleObj/readFileError
#  NAME
#    ::guib::moduleObj::readFileError --  method for dealing with file-read errors
#
#  USAGE
#    readFileError errMsg
#
#  DESCRIPTION
#    When an error occurs while reading an input file, this method
# should be called to display an error and skip the reading of the
# input file. This method is supposed to be used from readfilter routines.
# 
#  ARGUMENTS
#     errMsg     -- error message to display when syntax error is encountered
#******
# ------------------------------------------------------------------------

itcl::body ::guib::moduleObj::readFileError {errMsg} {
    set readError 1
    ::tclu::errorDialog "while reading input file: $errMsg"
}


# ------------------------------------------------------------------------
#****m* moduleObj/readFileWrongFormat
#  NAME
#    ::guib::moduleObj::readFileWrongFormat --  method for dealing with wrong-formatted input file
#
#  USAGE
#    readFileWrongFormat formatName ?diagnosisText?
# DESCRIPTION 
# When an input-file is not in a proper format, this method should be
# called to display an appropriate error-message and skip the reading
# of the input file. This method is supposed to be used from
# readfilter routines.
# 
#  ARGUMENTS
#     formatName     -- name of the format (i.e. an arbitrary string)
#     diagnosisText  -- a text containing a diagnose of the syntax errors [OPTIONAL]
#******
# ------------------------------------------------------------------------

itcl::body ::guib::moduleObj::readFileWrongFormat {formatName {diagnosisText {}}} {
    set readError 1
    set errMsg "selected file is not a ${formatName}-formatted or contains severe syntax errors."
    if { $diagnosisText != "" } {
	append errMsg "\n\nDiagnosis:\n$diagnosisText"
    }
    tk_messageBox -title ERROR -message "Read ERROR: $errMsg" -type ok -icon error
    #::tclu::errorDialog $errMsg
}


# ------------------------------------------------------------------------
#****im* moduleObj/_openSyntaxError
#  NAME
#    ::guib::moduleObj::_open --  method for dealing with file-read errors
#
#  USAGE
#    _openSyntaxError errMsg ?addSkipMsg?
#
#  DESCRIPTION
#    When an error occurs while reading an input file, this method
# should be called to correctly handle the error. When a syntax error
# is encountered the reading should be skippe immediately, otherwise
# the GUI might trap in an infinite loop!!!
# 
#  ARGUMENTS
#     errMsg     -- error message to display when syntax error is encountered
#     addSkipMsg -- do we add "Skipping the rest of the input file" text
#******
# ------------------------------------------------------------------------

itcl::body ::guib::moduleObj::_openSyntaxError {errMsg {addSkipMsg 1}} {
    
    set readError 1
    
    if { $addSkipMsg == 1 } {
	::tclu::errorDialog "syntax error in the input file: ${errMsg}\n\nSkipping the rest of the input file !!!"
    } else {
	::tclu::errorDialog $errMsg
    }
}


# ------------------------------------------------------------------------
#****im* moduleObj/_open
#  NAME
#    ::guib::moduleObj::_open -- reads the content of file-channel of a given input-file recursively
#
#  USAGE
#    _open keywordObj fileChannel
#
#  DESCRIPTION
#    This method reads the content of file-channel of a given
# input-file recursively. Hence, it makes all the work for readFile
# method.
#
#  ARGUMENTS
#    obj         -- the keywordObj object where the read content will be stored
#    fileChannel -- file-channel of a given input file
#  RETURN VALUE
#    None.
#
#  EXAMPLE
#    _open $keywordObj $fID
#******
# ------------------------------------------------------------------------

itcl::body ::guib::moduleObj::_open {obj fileChannel} {
    
    if { $readError == 1 } {
	# skip reading of the input file immediately ...
	return
    }

    set NItem [$obj getID]    
    for {set id 0} {$id <= $NItem} {incr id} {

	if { $readError == 1 } {
	    # skip reading of the input file immediately ...
	    return
	}

	update;	update idletask

	set key      [$obj getKey   $id]
	set childObj [$obj getChild $id]
	
	if { $childObj != {} } {
	    #------------------------------------------------------------
	    #
	    # we have new child object
	    #
	    #------------------------------------------------------------
	    # object types are: "page", "namelist", "optional", 
	    # "required", "line", "group"
	    #------------------------------------------------------------
	    
	    if { [::tclu::lpresent $disabledNameObjList $childObj] } {
		# object is disabled --> skip-it
		continue
	    }

	    if { $key == "namelist" } {

		# --------------------------------------------------
		#  INSIDE namelist
		# --------------------------------------------------
		# namelist can have dimensions and tables, and since some 
		# variables might be optional, we do not know the length
		# of the namelist, therefore read until end-of-namelist is 
		# encountered

		set name     [$obj getOptionValue $id name]				    
		set readline [_openGets $fileChannel]

		::tclu::DEBUG open: --namelist--  readline: $readline
		
		# t.k.
		#_openCompareStr \
		#    [string range $readline 1 [string length &$name]] "&$name"
		_openCompareStr -nocase $readline "&$name"
		
		while {1} {
		    set readline [_openGets $fileChannel]
			
		    # check if we need to close the namelist
		    
		    if { [regexp -nocase -- $::guib::settings(NAMELIST.end_regexp) $readline] } {
			#set readline [_openGets $fileChannel]
			break
		    }
			
		    # There can be sevaral vars on one line. Scan trough
		    # varname = varvalue pairs until the end of line ...
			
		    while { $readline != {} } {

			# check for comment-character "!" 

			if { [string match ! [string range [lindex $readline 0] 0 0]] } {
			    # ignore the rest of line. 
			    break
			}
			set varIdent  [_openReadNamelistVar $childObj $fileChannel]
			set varValue  [_openReadNamelistValue]
			varset $varIdent -value $varValue

			::tclu::DEBUG open: --namelist--       var: $varIdent
			::tclu::DEBUG open: --namelist--     value: $varValue
		    }
		}    
	    } else {
		set _line 0
		if { $key == "line" } {
		    set _line 1
		}
		#----
		_open $childObj $fileChannel 
		#----
		if { $_line } {
		    set readNewLine 1
		}
	    }
	} else {
	    #------------------------------------------------------------
	    #
	    # we have a new key 
	    #
	    #------------------------------------------------------------
	    # input-content keys are: var, dimension, table, keyword
	    #------------------------------------------------------------

	    # check if the key is disabled ...
	    _isDisabledKey $obj $id [$obj getOptionValue $id ident]

	    #set ident  [$obj getOptionValue $id ident]
	    #if { $ident != "" } {
	    #	set widget [getWidgetFromVarident $ident]
	    #	if { [::tclu::lpresent $disabledWidList $widget] } {
	    #	    continue
	    #	}
	    #	# maybe it is a keyword ...
	    #	if { [$obj getOptionValue $id keyword] != "" } {
	    #	    if { [::tclu::lpresent $disabledKeywordidentList $ident] } {
	    #		continue
	    #	    }
	    #	}
	    #}		
	    
	    if { $readNewLine } {
		set readline [_openGets $fileChannel]
	    }

	    set varIdentList {}
	    set fmt          {}
	    set makeFmt      0	    
	    
	    #"dimension" {
	    #    #------------------------------------------------------
	    #    #--> INSIDE namelist 
	    #    #------------------------------------------------------
	    #    # one gets here, since usually one does not specify all
	    #    # namelist variables. Hence we should proceed to next 
	    #    # iteration, but new readline should not be read !!!!
	    #    set readNewLine 0
	    #}		

	    # --------------------------------------------------
	    #    If we came here, we are OUTSIDE namelist !!!
	    # --------------------------------------------------
	    switch -exact -- [$obj getKey $id] {
		"keyword" {
		    set keyword [$obj getOptionValue $id keyword]

		    # NOTE: check if keyword contain the newline
		    # character; if it does then it is OK as next iteration
		    # new-line will be read. However if it doesn't than
		    # we should scan forward ...
		    #
		    # -->one solution is to  use readNewLine variable !!!
			
		    ::tclu::DEBUG --keyword-- Keyword:  \"$keyword\"
		    ::tclu::DEBUG --keyword-- Readline: \"$readline\"

		    _openReadKeyword $keyword
		    
		    if { [string match "*\n" $keyword] } {
			# read forward the line
			set readNewLine 1
		    } else {
			set readNewLine 0
			::tclu::DEBUG --keyword-- readline=0
			::tclu::DEBUG --keyword-- New.readline: $readline
		    }
		}
		    		
		"var" {
		    set fmt [$obj getInFmt $id]
		    if { $fmt == {} } {
			set fmt "%s" ; # ????
		    }

		    set varIdent [$obj getOptionValue $id ident]
		    set widget   [getWidgetFromVarident $varIdent]
		    set varValue ""

		    eval {::tclu::scan $readline $fmt} varValue		    

		    if { $varValue != "" } {
			regsub -- $varValue $readline {} readline
		    }
		    #t.k.: check if it is allowed for varValue not
		    # to be set in above line
		    if { [info exists varValue] } {
			varset $varIdent -value $varValue
		    }
		    
		    set readNewLine 0
		}
		
		"text" {
		    set varIdent [$obj getOptionValue $id ident]
		    set readVar  [$obj getOptionValue $id readvar]
		    set widget   [getWidgetFromVarident $varIdent]
		    
		    tclu::DEBUG +++ readvar == $readVar
		    tclu::DEBUG +++ readvar exists: [info exists $readVar]

		    if { [info exists $readVar] } {
			upvar \#0 $readVar readValue
			varset $varIdent -textvalue $readValue
			$widget setText $readValue
		    }
		    
		    set readNewLine 0
		}
			
		"table" { 
		    #------------------------------------------------------
		    # -->here only OUTSIDE namelist 

		    set _fmt [$obj getInFmt $id]
		    if { $_fmt == {} } {
			set makeFmt 1 
		    }

		    set tableIdent [$obj getOptionValue  $id ident]
		    set tableWid   [$this getWidgetFromVarident $tableIdent]
		    set nrow       [$tableWid cget -rows]
		    set ncol       [$tableWid cget -cols]

		    for {set ir 1} {$ir <= $nrow} {incr ir} {
			set varIdentList  {}	
			set fmt          {}
			for {set ic 1} {$ic <= $ncol} {incr ic} {
			    # format
			    set varIdent  ${tableIdent}($ir,$ic)
			    if { $makeFmt } {
				append fmt "%s "
			    } else {
				append fmt "[lindex $_fmt [expr $ic - 1]] "
			    }
			    lappend varIdentList  $varIdent
			}
			
			eval {::tclu::scan $readline $fmt} $varIdentList
			foreach varident $varIdentList {
			    upvar 0 $varident varvalue
			    if { [info exists varvalue] } {
				#t.k.: check if it is allowed for varvalue not
				# to exists
				varset $varident -value $varvalue
			    }
			}
			if {$ir < $nrow} {
			    ::tclu::DEBUG table: readline
			    set readline [_openGets $fileChannel]
			}
			set readNewLine 1		     
		    }
		}
		
		default {
		    # other keys like packwidgets; do not read a new line ...
		    set readNewLine 0
		}
	    } ; # switch
	} ; # if-else
    } ; # for
    
    # t.k.: Tue Sep 30 15:35:50 CEST 2003--2004below lines were OK for
    # most cases, but failed when objects where found inside the "line
    # { ... }" object, i.e., line { group {...}; group {...}} has
    # failed !!!
    #---
    #if { $line } {
    #	set readNewLine 1
    #	set line 0
    #}
    #---
    #/t.k.
}


itcl::body ::guib::moduleObj::_openCompareStr {args} {		

    set argc [llength $args]    
    if { $argc == 2 } {
	set nocase  0
	set lineStr [lindex $args 0]
	set str     [lindex $args 1]
    } elseif { $argc == 3 && [lindex $args 0] == "-nocase" } { 
	set nocase  1
	set lineStr [lindex $args 1]
	set str     [lindex $args 2]
    } else {
	::tclu::ERROR "usage: _openCompareStr ?-nocase? lineStr str"
    }
    
    set readStr {}
    if { [scan $lineStr %s readStr] != 1 } {
	#-->EOF
	_openSyntaxError "end of file while reading input" eof
	return -code return
    }

    if { $nocase } {
	set result [string compare -nocase $readStr $str]
    } else {
	set result [string compare $readStr $str]
    }
    if { $result != 0 } {
	#-->READ ERROR
	_openSyntaxError "NOT-MATCH ERROR"
	return -code return
    }
}

itcl::body ::guib::moduleObj::_openGets {fileChannel} {
    # check for empty line: read as long as to skip all the empty lines
    set readNewLine 1
    set i [gets $fileChannel _line]
    #
    # We might have a string such as: "string what ever"
    # Replace double-quotes with single quotes
    #	
    regsub -all -- \" $_line ' line

    # the regular expresion for empty line is: {^[[:space:]]+$|^$}
    #while { $i > -1 && [regexp {^[[:space:]]+$|^$} $line] } {}

    while { $i > -1 && [llength $line] == 0 } {
	set i [gets $fileChannel _line]
	regsub -all -- \" $_line ' line
    }
    ::tclu::DEBUG --readline-- $line
    return $line
}

#body ::guib::moduleObj::_openGets_llength {line} {
#    #
#    # We might have a string such as: "string what ever"
#    # Replace double-quotes with single quotes
#    #	
#    regsub -all -- \" $line ' _line
#    return [llength $_line]
#}


itcl::body ::guib::moduleObj::_openReadNamelistVar {obj fileChannel} {

    set ind [string first = $readline]

    if { $ind <= 0 } {
	_openSyntaxError "syntax error in the namelist"
	return -code return
    }
    scan [lindex [split $readline =] 0] %s result    

    # do we have dimension/table, i.e., var(1) , var(1,2) ???    
    set varName [lindex [split $result ()] 0]
    set elem    [lindex [split $result ()] 1]
    if { $elem != "" } {
	set elem (${elem})
    }

    #
    # map from varName (or varName(elem)) to varIdent
    #

    # assume read variable is a scalar
    set ident [varnameToVarident $obj $result $::guib::settings(NAMELIST.varname_nocase)]
    if { $ident != "" } {
	return $ident
    } else {
	# maybe read variable is a dimension/table
	set ident [varnameToVarident $obj $varName $::guib::settings(NAMELIST.varname_nocase)]
	if { $ident != "" } {
	    return ${ident}${elem}
	}
    }

    #
    # if we came here, we have an undefined variable
    #
    if { $::guib::settings(NAMELIST.variable_support_undefined) } {
	if { ! [info exists objWidgetArray(UNDEFINED_VAR,$obj)] } {
	    # make the "Undefined variables" label
	    set objWidgetArray(UNDEFINED_VAR,$obj) 1
	    _separator $obj {-label "--- The following undefined variables were found ---"}
	    _buildGUI_constructItem [$obj getID] $obj $objWidgetArray(CHILDSITEWIDGET,$obj) separator
	}
	_manageKeyword $obj var [_makeIdent $result] \
	    [list -label "Undefined variable ($result):" -variable $result]	
	_buildGUI_constructItem [$obj getID] $obj $objWidgetArray(CHILDSITEWIDGET,$obj) var
	return $result
    }
    
    # If we came here, then the variable could not be allocated
    _openSyntaxError "namelist's variable \"$result\" not allowed."
    return -code return
}


itcl::body ::guib::moduleObj::_openReadNamelistValue {} {    

    # trim white-space and tabs characters
    set readline [string trim $readline "\t "]

    set index [expr [string first = $readline 0] + 1]
    set readline [string trim [string range $readline $index end] "\t "]
    
    ::tclu::DEBUG --_openReadNamelistValue-- readline: $readline

    if { [string first ' $readline] == 0 } {
	::tclu::DEBUG --_openReadNamelistValue-- YES
	#
	# we have a string such as: 'string what ever' or "string what ever"
	#	
	scan $readline {'%[^']} value
	
	# now shrink the readline
	set index [expr [string first ' $readline 1] + 1]
	set readline [string trim [string range $readline $index end] "\t ,"]
	return '${value}'
    } else {
	::tclu::DEBUG --_openReadNamelistValue-- NO

	#
	# not a string
	#
	set value [string trim [lindex $readline 0] "\t ,"]

	# now shrink the readline

	set index [expr [string first $value $readline 0] + [string length $value] + 1]
	set readline [string trim [string range $readline $index end] "\t ,"]
	return $value
    }
}

itcl::body ::guib::moduleObj::_openReadKeyword {keyword} {
    set keyword [string trim $keyword \n]
    if { $::guib::settings(INPUT.nocase) } {
	set _count [regsub -nocase -- $keyword $readline {} readline]
    } else {
	set _count [regsub -- $keyword $readline {} readline]
    }
    ::tclu::DEBUG --count $_count $keyword $readline
    if { $_count == 0 } {
	set keyword [string trim $keyword "\n"]
	_openSyntaxError "expecting keyword \"$keyword\", but read \"$readline\" instead."
	return -code return
    }
}


itcl::body ::guib::moduleObj::_isDisabledKey {obj id ident} {
    set ident  [$obj getOptionValue $id ident]
    if { $ident != "" } {
	set widget [getWidgetFromVarident $ident]
	if { [::tclu::lpresent $disabledWidList $widget] } {
	    return -code continue
	}
	# maybe it is a keyword ...
	if { [$obj getOptionValue $id keyword] != "" } {
	    if { [::tclu::lpresent $disabledKeywordidentList $ident] } {
		return -code continue
	    }
	}
    }		
    return ""
}

#body ::guib::moduleObj::_openReadNamelistValue {} {    
#    
#    foreach elem [split $readline {=, }] {
#	# get rid of empty elements
#	if { $elem != "" } {
#	    lappend List $elem
#	}
#    }
#
#    # a namelist variable value can contain { =,} characters, which means
#    # we have split that. But of this occurs than the value must be bracketed
#    # in ', and should not be double ' (i.e '') !!!
#    #
#    # ...check for this here...
#
#    set Len [llength $List]
#    if { $Len > 2 } {
#	# there is more than one variable on the line; shorten the
#	# readline
#	set readline {}
#	for {set i 2} {$i < $Len} {incr i 2} {
#	    append readline "[lindex $List $i] = [lindex $List [expr $i + 1]] "
#	}
#    } else {
#	set readline {}
#    }
#    ::tclu::DEBUG --namelist-- readline: $readline
#    return [string trimright [lindex $List 1] ,]
#}

