#
# $RCSfile: keywordObj.itcl,v $ --
#
#      This file contains the implementation of the ::guib::keywordObj
# class. The ::guib::keywordObj is the base class for the GUIB
# objects.  There are several ::guib::keywordObj classes. The highest
# super-class derived from super-class is the ::guib::moduleObj
# class. Namely, the construction of the GUI is embedded inside the
# "module" keyword, for example:
#
# module #auto -title "Simple GUI -script {
#    ...
# }
#
# The "module" keyword construct the moduleObj object, which holds the
# whole GUI. The "moduleObj" IS-A "keywordObj" class. Inside the
# module's script are GUIB keywords, the two main types being
# item-keywords (var, dimension, table, keyword, ...) and
# object-keywords (page, line, group, namelist, ...). These latest are
# derived from keywordObj base-class. Currently, there are
# ::guib::keywordObj::nameObj and ::guib::keywordObj::voidObj
# derived-classes. The first is used for the object-keyword which have
# the "-name" option (page, line, namelist), while the latter is used
# for optional and required object-keywords.
#
#
# 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: keywordObj.itcl,v 1.3 2008-05-08 18:44:36 kokalj Exp $ 
#
# ------------------------------------------------------------------------


# ------------------------------------------------------------------------
#****c* ::guib/keywordObj
#  NAME
#    ::guib::keywordObj -- a base class for the GUIB
#
#  DESCRIPTION 
#    This is a base class for the GUIB. All the GUIB objects (i.e. 
# moduleObj, nameObj, and voidObj) inherit it.
#    
#    The GUIB script is a Tcl script which is encapsulated inside the
# "module" keyword and contains GUIB keywords (plus all Tcl
# stuff). These keywords are methods of moduleObj class (expect
# "module" which is a proc). Some of this keywords create new objects
# (page, namelist, optional, required, line, group) and then the
# script belonging to such a keyword is executed within that object
# scope (i.e. this is how the nesting of the object-keywords is
# managed). The keywords belonging to a given keywordObj's object are
# sequentially labeled with an ID. Here an example of how the
# hierarchy of keywordObj is handled. Consider the following script:
# 
# module \#auto -title "Testing" -script {
#     page p1 -name "Page No.1" {
# 	line l1st -name "1st line" {
# 	    var title -label "Title:"
# 	    var code  -label "Code:"
# 	}
# 	line l2nd -name "2nd line" {
# 	    var description -label "Description:"
# 	}
#     }
#     line llast -name "last line" {
# 	var conclusion -label "Conclusion:"
#     }
# }
# 
# The corresponding hierarchy tree is the following:
# 
# moduleObj[module]
#    |
#    +--(ID=0)--keywordObj[page] (p1)
#    |          |
#    |          +--ID=0--keywordObj[line] (l1st)
#    |          |        |
#    |          |        +--ID=0--item[var] (title)
#    |          |        +--ID=1--item[var] (code)
#    |          |
#    |          +--ID=1--keywordObj[line] (l2nd)
#    |                   |
#    |                   +--ID=0--item[var] (description)
#    |
#    +--(ID=1)--keywordObj[line] (llast)    
#               |
#               +--ID=0--item[var] (conclusion)
# 
#
#  METHODS
#    getID          -- keywords within a keywordObj object are sequentially 
#                      labeled (1st item's ID==0), this method returns the 
#                      current value of the counter, which equals to the 
#                      number of items within a given keywordObj object
#    incrID         -- increases the current counter value and returns its 
#                      new value 
#    setKey         -- stores the current keyword   
#    setChild       -- stores the name of the newly created keywordObj object 
#    setOptions     -- merges a default and parsed option values of a keyword
#                      and stores them
#    getKey         -- returns the keyword which has the requested ID
#    getChild       -- returns the child keywordObj object which has the requested ID
#    getOptions     -- returns all the options of the ID-th keyword 
#                      (i.e. result has the form of [arrey get arrayName])
#    getOptionValue -- return the ID-th option value
#    getIdFromVarname  -- returns the ID of the keyword which contains the 
#                         requested variable (i.e. -variable option)
#    getIdFromVarident -- returns the ID of the keyword which contains the 
#                         requested variable's identifier (i.e. -variable option)
#    getOutFmt      -- returns the output-format
#    getInFmt       -- returns the input-format
#
#******
# ------------------------------------------------------------------------

itcl::class ::guib::keywordObj {    
    public variable parent  {}
    public variable widget  {}
    public variable type    {}

    protected variable cmd    
    protected variable child   
    protected variable itemID -1

    method getID              {}
    method incrID             {}
    method setKey             {id key {ident ""}}
    method setChild           {id childObj}
    method setOptions         {id opts}
    method getKey             {id}
    method getChild           {id}
    method getOptions         {id {pattern *}}
    method getOptionValue     {id option}
    method getIdFromVarname   {varName} 
    method getIdFromVarident  {varIdent} 
    method getOutFmt          {id}
    method getInFmt           {id}
}


# ------------------------------------------------------------------------
#****m* keywordObj/getID
#  NAME
#    ::guib::keywordObj::getID -- returns the current counter ID value
#  USAGE
#    getID
#  DESCRIPTION
#    Keywords within a keywordObj object are sequentially labeled (1st
# item's ID==0). This method returns the current value of the counter,
# which equals to the number of items within a given keywordObj object.
#  RETURN VALUE
#    The current ID number.
#  EXAMPLE
#    set id [$obj getID]
#  SOURCE

itcl::body ::guib::keywordObj::getID {} { return $itemID }    
#******
# ------------------------------------------------------------------------


# ------------------------------------------------------------------------
#****m* keywordObj/incrID
#  NAME
#    ::guib::keywordObj::incrID -- increases the counter ID's value by +1    
#  USAGE
#    incrID
#  RETURN VALUE
#    The increased ID number.
#  EXAMPLE
#    set id [$obj incrID]
#  SOURCE

itcl::body ::guib::keywordObj::incrID {} { return [incr itemID] }
#******
# ------------------------------------------------------------------------


# ------------------------------------------------------------------------
#****m* keywordObj/setKey
#  NAME
#    ::guib::keywordObj::setKey -- stores the name of the ID-th keyword (item)
#  USAGE
#    setKey id key
#  ARGUMENTS
#    id  -- the ID number
#    key -- the name of the keyword
#  RETURN VALUE
#    The value of argument key.
#  EXAMPLE
#    $obj setKey $id line
#  SOURCE

itcl::body ::guib::keywordObj::setKey {id key {ident ""}} { 
    if { $ident != "" } {
	# I should check if ident already exists !!!
	set cmd($id,ident) $ident

	# the default value of cmd($id,variable) is $cmd($id,ident)
	#set cmd($id,variable) $ident
    }
    return [set cmd($id,key) $key] 
}
#******
# ------------------------------------------------------------------------


# ------------------------------------------------------------------------
#****m* keywordObj/setChild
#  NAME
#    ::guib::keywordObj::setChild -- stores the child keywordObj object name of the ID-th item
#  USAGE
#    setChild id childObj
#  DESCRIPTION
#    Some of the GUIB keywords creates new keywordObj objects (i.e. child objects).
#    This method stores the name of the child objects. These objects have
#    a sequential ID like the rest of the GUIB keywords items.
#  ARGUMENTS
#    id       -- the ID number
#    childObj -- the name of the child keywordObj object
#  RETURN VALUE
#    The name of the child keywordObj object.
#  EXAMPLE
#    $obj setChild $id $childObj
#  SOURCE

itcl::body ::guib::keywordObj::setChild {id childObj} { return [set child($id) $childObj] }
#******
# ------------------------------------------------------------------------


# ------------------------------------------------------------------------
#****m* keywordObj/setOptions
#  NAME
#    ::guib::keywordObj::setOptions -- stores the options of the ID-th keyword
#  USAGE
#    setOptions id opts
#  ARGUMENTS
#    id   -- the ID number
#    opts -- the list of option-value pairs in the "array get" style
#  RETURN VALUE
#    The option-value pairs of the ID-th keyword.
#  EXAMPLE
#    $obj setOptions [array get $options]
#  SOURCE

itcl::body ::guib::keywordObj::setOptions {id opts} {	
    foreach {elem value} $opts {
	# do some checking for the allowed values for various options
	if { $value != "" } {
	    switch -exact $elem {
		validate {		
		    regsub -all integer $value int vl
		    foreach v $vl {
			if { ! [string match $v string] && [info procs ::guib::widgets::${v}*] == {} } {
			    if { ! [auto_load ::guib::widgets::$v] } {
				::tclu::abort "syntax error in definition file: wrong validation, $vl,\nspecified by -validate option"
			    }
			}		    
		    }
		}
		widget   {
		    set wid [lindex $value 0]
		    if { [info procs ::guib::widgets::${wid}help] == {} } {
			if { ! [auto_load ::guib::widgets::${wid}help] } {
			    #set allowed [info procs ::guib::widgets::*help]
			    #regsub -all ::guib::widgets:: $allowed {} allowed
			    #regsub -all help $allowed {} allowed
			    ::tclu::abort "syntax error in definition file: wrong widget, $wid,\nspecified by -widget option"
			}
		    }
		}
	    }
	}
	set cmd($id,$elem) $value
    }
    return $opts
}
#******
# ------------------------------------------------------------------------


# ------------------------------------------------------------------------
#****m* keywordObj/getKey
#  NAME
#    ::guib::keywordObj::getKey -- returns the name of the ID-th keyword (item)
#  USAGE
#    getKey id
#  RETURN VALUE
#    The name of the ID-th keyword.
#  EXAMPLE
#    set key [$obj getKey $id]
#  SOURCE

itcl::body ::guib::keywordObj::getKey {id} { return [lindex [array get cmd $id,key] 1] }
#******
# ------------------------------------------------------------------------


# ------------------------------------------------------------------------
#****m* keywordObj/getChild
#  NAME
#    ::guib::keywordObj::getChild -- returns the child keywordObj object name of the ID-th keyword
#  USAGE
#    getChild id
#  RETURN VALUE
#    The name of the child object.
#  EXAMPLE
#    set childObj [$obj getChild $id]
#  SOURCE

itcl::body ::guib::keywordObj::getChild {id} { return [lindex [array get child $id] 1] }
#******
# ------------------------------------------------------------------------


# ------------------------------------------------------------------------
#****m* keywordObj/getOptions
#  NAME
#    ::guib::keywordObj::getOptions -- returns the options of the ID-th keyword
#  USAGE
#    getOptions id ?pattern?
#  ARGUMENTS
#    id     -- the ID number
#    patern -- the glob pattern for the option retrival (default value of pattern is *)
#  RETURN VALUE
#    The option-value pairs of the ID-th keyword that match pattern
#  EXAMPLE
#    set opts [$obj getOptions var*]
#  SOURCE

itcl::body ::guib::keywordObj::getOptions {id {pattern *}} { return [array get cmd $id,$pattern] }
#******
# ------------------------------------------------------------------------


# ------------------------------------------------------------------------
#****m* keywordObj/getOptionValue
#  NAME
#    ::guib::keywordObj::getOptionValue -- returns the value of a given ID-th keyword option
#  USAGE
#    getOptionValue id option
#  ARGUMENTS
#    id     -- the ID number
#    option -- the name of the querying option
#  RETURN VALUE
#    The value of the querying ID-th keyword option
#  EXAMPLE
#    set value [$obj getOptionvalue $id textvalue]
#  SOURCE

itcl::body ::guib::keywordObj::getOptionValue {id option} { return [lindex [array get cmd $id,$option] 1] }
#******
# ------------------------------------------------------------------------


# ------------------------------------------------------------------------
#****m* keywordObj/getIdFromVarname
#  NAME
#    ::guib::keywordObj::getIdFromVarname -- returns the ID of a keyword which contain the specified variable
#  USAGE
#    getIdFromVarname varName
#  DESCRIPTION 
#    The method returns the ID of a keyword which contain the specified
# variable, that is, the value of the keywords -variable option.
#  RETURN VALUE
#    Returns the ID of a keyword which contain the specified variable or -1
#    if the variable is not found.
#  EXAMPLE
#    set id [$obj getIdFromVarname varName]
#******
# ------------------------------------------------------------------------

itcl::body ::guib::keywordObj::getIdFromVarname {varName} {
    for {set id 0} {$id <= $itemID} {incr id} {
	if { [info exists cmd($id,variable)] } {
	    #if { $varName == $cmd($id,variable) } {
	    #	return $id
	    #}
	    if { [::tclu::stringMatch $varName $cmd($id,variable) $::guib::settings(NAMELIST.varname_nocase)]} {
		return $id
	    }
	}
    }
    return -1
}


# ------------------------------------------------------------------------
#****m* keywordObj/getIdFromVarident
#  NAME
#    ::guib::keywordObj::getIdFromVarident -- returns the ID of a keyword which contain the specified GUIB's variable identifier
#  USAGE
#    getIdFromVarident VarIdent
#  DESCRIPTION

#    This method is used to get the ID of the keyword containing the
# specified identifier. This is used, for example, by the "help"
# keyword where the help associated with some variable's idenifier is
# specified. For this purpose an ID (and keywordObj' object pointer)
# of the corresponding keyword is needed in order to set the help data
# via the "$obj setOptions $id "help $help".

#  RETURN VALUE
#    Returns the ID of a keyword which contain the specified identifier or -1
#    if the keyword is not found.
#  EXAMPLE
#    set id [$obj getIdFromVarident varIdent]
#******
# ------------------------------------------------------------------------

itcl::body ::guib::keywordObj::getIdFromVarident {varIdent} {
    for {set id 0} {$id <= $itemID} {incr id} {
	if { [info exists cmd($id,ident)] } {
	    if { $varIdent == $cmd($id,ident) } {
		return $id
	    }
	}
    }
    return -1
}


# ------------------------------------------------------------------------
#****m* keywordObj/getOutFmt
#  NAME
#    ::guib::keywordObj::getOutFmt
#  USAGE
#    getOutFmt id     
#  DESCRIPTION
#    This method returns the output format. It first queries the
#    "outfmt" GUIB option, if it is not set then it queries the "fmt"
#    option.
#  RETURN VALUE
#    Returns the output-format string.
#  EXAMPLE
#    set outFmt [$obj getOutFmt $id]
#********
# ------------------------------------------------------------------------

itcl::body ::guib::keywordObj::getOutFmt {id} {
    set _fmt [getOptionValue $id outfmt]
    if { $_fmt == {} } {
	set _fmt [getOptionValue $id fmt]
    }
    if { $_fmt == {} } {
	# if $_fmt is still {} return %S
	return %S
    } else {
	return $_fmt
    }
}


# ------------------------------------------------------------------------
#****m* keywordObj/getInFmt
#  NAME
#    ::guib::keywordObj::getInFmt
#  USAGE
#    getInFmt id     
#  DESCRIPTION
#    This method returns the input format. It first queries the
#    "outfmt" GUIB option, if it is not set then it queries the "fmt"
#    option.
#  RETURN VALUE
#    Returns the input-format string.
#  EXAMPLE
#    set inFmt [$obj getInFmt $id]
#********
# ------------------------------------------------------------------------

itcl::body ::guib::keywordObj::getInFmt {id} {
    set _fmt [getOptionValue $id infmt]
    if { $_fmt == {} } {
	set _fmt [getOptionValue $id fmt]
    }
    #if { $_fmt == {} } {
    #	# if $_fmt is still {} return %S
    #	return %S
    #} else {
    #	return $_fmt
    #}
    return $_fmt
}



# ------------------------------------------------------------------------
#****c* keywordObj/nameObj
#  NAME
#    ::guib::keywordObj::nameObj -- a class for the name GUIB objects (e.g. page, namelist)
#  PURPOSE
#    This is the class for the "name" GUIB object. The name object are those,
#    whose corresponding keywords have -name option (e.g. page, namelist)
#  IS-A
#    ::guib::keywordObj
#  METHODS
#    None.
#********
# ------------------------------------------------------------------------

itcl::class ::guib::keywordObj::nameObj {
    inherit keywordObj
    
    public variable name {}
    
    constructor {args} {
	eval configure $args
    } 
}

# ------------------------------------------------------------------------
#****c* keywordObj/voidObj
#  NAME
#    ::guib::keywordObj::voidObj -- a class for the void GUIB objects (e.g. optional, required)
#  PURPOSE
#    This is the class for the "void" GUIB object. The void object are those,
#    whose corresponding keywords don't have -name option (e.g. page, namelist)
#  IS-A
#    ::guib::keywordObj
#  METHODS
#    None.
#********
# ------------------------------------------------------------------------

itcl::class ::guib::keywordObj::voidObj {
    inherit keywordObj
        
    constructor {args} {
	eval configure $args
    }
}

