toplevel.sa


Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
 
---------------------------> Sather 1.1 source file <--------------------------
-- toplevel.sa: Toplevel widget
-- Author: Benedict A. Gomes <gomes@samosa.ICSI.Berkeley.EDU>
-- Copyright (C) 1995, International Computer Science Institute
-- toplevel.sa,v 1.1 1995/11/15 03:36:51 gomes Exp
--
-- COPYRIGHT NOTICE: This code is provided WITHOUT ANY WARRANTY
-- and is subject to the terms of the SATHER LIBRARY GENERAL PUBLIC
-- LICENSE contained in the file: Sather/Doc/License of the
-- Sather distribution. The license is also available from ICSI,
-- 1947 Center St., Suite 600, Berkeley CA 94704, USA.


class TK_TOPLEVEL_CFG < $TK_WIDGET_CFG

class TK_TOPLEVEL_CFG < $TK_WIDGET_CFG is include TK_WIDGET_CFG_INCL borderwidth->borderwidth, highlightcolor->highlightcolor, highlightbackground->highlightbackground, highlightthickness->highlightthickness, relief_none->relief_none,relief_groove->relief_groove, relief_raised->relief_raised,relief_sunken->relief_sunken, relief_flat->relief_flat,relief_ridge->relief_ridge ; end;

class TK_TOPLEVEL < $TK_WIDGET

class TK_TOPLEVEL < $TK_WIDGET is include TK_WIDGET_INCL{TK_TOPLEVEL_CFG} create->private widget_create; private tk_widget_type: STR -- Returns the tk_widget type. As the root window is also a toplevel -- but has a different type name, there has a distinction to be made. is if self=root_window then return "RootWindow(.)" else return "toplevel" end end; widget_name: STR is if self=the_root_window then return "." end; return path_name end; root_window: TK_TOPLEVEL -- Dedicating one special object as the root window. This root window -- does not comply with the regular creation process, so do something -- sepcial here. is if void(the_root_window) then the_root_window := new; the_root_window.name := ""; the_root_window.path_name := ""; the_root_window.bindings := #; the_root_window.parent := void; end; return the_root_window end; private shared the_root_window: TK_TOPLEVEL; -- The dedicated object will be stored here. create: SAME is -- Create a new toplevel with default options under the root window return create("toplevel",default_config); end; create(np: STR, cf: TK_TOPLEVEL_CFG): SAME is if void(cf) then cf := default_config; end; res ::= new; res.init(np,cf); return res; end; private init(np: STR,cf: TK_TOPLEVEL_CFG) is name ::= fix_tcl_name(np)+UNIQ::next; deb("Creating widget named:"+name+" specfied name:"+np); path_name := "."+name; eval("toplevel",path_name); register; eval(actual_widget_name,"configure", cf.str); end; private default_config: TK_TOPLEVEL_CFG is return #TK_TOPLEVEL_CFG; end; act_on(i: INT,args: ARRAY{STR}) is raise "Can't bind events to toplevels yet"; end; end; -- class TK_TOPLEVEL