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