#------------------------------------------------------------------------ # Compagny : 4Js # Developper : PM # Program : $PROJET/objects/toplevel.obj # Date : 19.05.1995 # Last modif : 13.10.1995 # Title : Description des classes de base #------------------------------------------------------------------------ # Explication : (later) #====================================================================== Class Toplevel { inherit Container global Default public geo_title "" public geo_width $Default(Toplevel,Width) public geo_height $Default(Toplevel,Height) public int_geoman "" constructor { } { set geo_title "Toplevel - $this" } #----------------------------------------------------------------------- # Define_Toplevel : # Creation of the graphical object, with full path... # Entry : name : Entity name of object # Returns : nothing. #....................................................................... method define { } { # Creation de la commande adaptee a l'objet !!! set cmd "" lappend cmd toplevel $geo_root$int_name lappend cmd -background $geo_bg lappend cmd -borderwidth $geo_borderwidth lappend cmd -relief $geo_relief if { $geo_width != 0} { lappend cmd -width $geo_width } if { $geo_height != 0} { lappend cmd -height $geo_height } set geo_widget [ eval $cmd ] set_title # To prevent abnormal terminaison (Alt-F4 for example), the following # seccurs the internal objects structure, so we can call without # problem like attribut is set, but do not exist. set_binding "$this clear" # puts "Sortie d'un toplevel ..... $geo_widget " } #----------------------------------------------------------------------- # Refresh_Toplevel : # Nearly identical with Define_..., but don't recreate. It only # reconfigures the thing. #....................................................................... method refresh { } { set cmd "" lappend cmd $geo_widget configure lappend cmd -background $geo_bg lappend cmd -borderwidth $geo_borderwidth lappend cmd -relief $geo_relief if {$geo_width ] != 0} { lappend cmd -width $geo_width } if {$geo_height != 0} { lappend cmd -height $geo_height } eval $cmd set_title raise } #----------------------------------------------------------------------- # Set_Toplevel_Title : # Sets the title of the toplevel window # Parameters : name of objects, # his title (optionnal). # Returns : a good work #....................................................................... method set_title { {title "xxx"} } { if {$title == "xxx"} { wm title $geo_widget $geo_title } else { set geo_title $title wm title $geo_widget $title } } #----------------------------------------------------------------------- # Raise_Toplevel : # Returns : a good work #....................................................................... #method raise { } { # # if {$geo_widget != ""} { # raise $geo_widget # } else { # puts stderr "Calling of raise for <$this> since there is no widget" # } # } } ;# end of class # ======================================================================