#------------------------------------------------------------------------
# Compagny	:	4Js
# Developper	:	PM
# Program	:	$PROJET/attrlist.obj
# Date		:	23.05.1995
# Last modif.	:	15.10.1995
# Title		:	Description de la classe Attributlist
#------------------------------------------------------------------------
# Explication :   
#	This class is composed by a toplevel object, in witch is
# stored a list of lines, themself composed by the name of an attribut,
# and his value. For the moment, this line will be represented by the
# class field.
#======================================================================

Class Attributlist {
inherit Toplevel
	global Default
#vars :
	public -geo_title	"Attributlist"
	public -geo_padx	$Default(Attributlist,PadX)
	public -geo_pady	$Default(Attributlist,PadY)
	public -int_owner	"" ;# object from witch the attributs must be taken.
#	public -int_geoman	""
	public -int_soons	"lines control"
	public -int_lines	""
	public -int_control	""
	public -int_specif	""

#-----------------------------------------------------------------------
# Define_Attributlist :
#	Creation of the graphical object, with full path...
# When this function is being executed, we can assume that the widget
# corresponding to the object $name of the descended class Toplevel,
# exists. But, it is a class, that should not use tk-instructions...
# Entry :	name : Entity name of object
# Returns :	nothing.
#.......................................................................

method define { } {
set owner $int_owner 
# global $owner

Toplevel::define

#puts "Caracterisation d'un attributlist ..... >$name(geo,widget)<"

Field reference		\
	-int_geoman		"pack_it"	\
	-geo_attach		"top"	\
	-geo_fill		"x"	\
	-geo_padx		0	\
	-geo_pady		0	\
	-geo_relief		flat	\
	-int_label_width	12

set int_lines ""
set elements ""
# set elements [array names $int_owner]

foreach entity $elements {	;#	entity, is a full attribut name, with prefix
	if {[string match $name(int,specif),* $entity]} {
	   regsub  "$name(int,specif),"	 $entity  "a_"  a_entity
	   global $a_entity
#		puts "Le nom propre est >$a_entity<"
	   call reference copy_to $a_entity

	   regsub "a_" $a_entity "" ${a_entity}(geo,text)
	   set ${a_entity}(int,variable)	"${owner}($entity)"	
	   lappend name(int,lines)		$a_entity

#	   puts "Attribut <$entity> of $owner is \"[set ${owner}($entity)]\""
	   } else {
#	   puts "$entity not good"
	   }
	}
catch {unset reference}

# The following is to save the integrity of the valid variable set.
# set_binding "<Destroy>" "$int_owner show_attr_done $int_specif "

lappend int_control [Button a_ok -int_command "$int_owner show_attr_done $int_specif"]
a_ok	config -geo_text "  Done  " \
		 -int_geoman	"pack_it" \
		 -geo_width	10 \
		 -geo_height	0 \
		 -geo_attach	"left"

lappend int_control [Button a_doit -int_command "$int_owner display"]
a_doit	config -geo_text "  Do it  " \
		 -int_geoman	"pack_it" \
		 -geo_width	10 \
		 -geo_height	0 \
		 -geo_attach	"left"

lappend int_control [Button a_cancel -int_command "$int_owner show_attr_cancel $int_specif"]
a_cancel	config -geo_text "  Cancel  " \
		 -int_geoman	"pack_it" \
		 -geo_width	10 \
		 -geo_height	0 \
		 -geo_attach	"left"

#puts "Fin Creation d'un attributlist ..... $name(geo,widget)"
  }
}	;# end of class Attrlist
#-----------------------------------------------------------------------
# ======================================================================