#------------------------------------------------------------------------ # 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 "" "$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 #----------------------------------------------------------------------- # ======================================================================