------------------------->  GNU Sather - sourcefile  <-------------------------
-- Copyright (C) 1995 by International Computer Science Institute            --
-- This file is part of the GNU Sather library. It is free software; you may --
-- redistribute  and/or modify it under the terms of the GNU Library General --
-- Public  License (LGPL)  as published  by the  Free  Software  Foundation; --
-- either version 2 of the license, or (at your option) any later version.   --
-- This  library  is distributed  in the  hope that it will  be  useful, but --
-- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/LGPL for more details.       --
-- The license text is also available from:  Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA                     --
-------------->  Please email comments to <bug-sather@gnu.org>  <--------------

-- Author: Benedict A. Gomes <gomes@samosa.ICSI.Berkeley.EDU>

class GUI_APP_END is
   -- The application-end code for the GUI.
   -- Though, the application programmer will normally use only
   -- GUI_UTIL and the Widget classes.
    
   shared debug: BOOL := false;	-- Debug the sather code
   shared tcldebug: BOOL := false; -- Print out the tcl code sent in both 
   -- directions
   shared is_done: BOOL := false; -- True when the application is done
   -- and must quit
   shared tcl_tk:TCL_TK;	-- Set up to point to the interpreter
   
   startup is
      sather_home ::= UNIX::sather_home;
      deb("Starting tcl, initializing...");
      -- Changed the order of the next two lines for Cliff's multiple interpreter
      -- version. Creating TCL_TK should not execute any callbacks, since the
      -- callback handler is not initialized till the next line (the interpreter
      -- number is required to install the callback handler)
      tcl_tk := #TCL_TK("SatherGui",sather_home+"/");
      TCL_TK_COMMANDS::sather_command(tcl_tk.interp_to_int,
				      bind(exec_callback(_)));
      INIT_GUI::gui_setup(tcl_tk);
      INIT_GUI::gui_post_socket_init(tcl_tk);
   end;
    
   terminate is UNIX::exit(0); end;
    
   main_loop is tcl_tk.main_loop end;
    
   private init is
      deb("Done with init");
   end;
    
   eval(s: STR): STR is
      res ::= tcl_tk.eval(s);
      if tcldebug then #ERR+s+"\n"; end;
      return res;
   end;
    
   eval(s: STR) is 
      res ::= tcl_tk.eval(s);
      if tcldebug then #ERR+s+"\n"; end;
      if debug then deb("Sent string") end;
   end;
    
   exec_callback(argv: ARRAY{STR}) is
      -- Three special callbacks are
      -- "poll"  Poll sather for more commands
      -- "debug" Turn on debugging flag
      -- "nodebug" Turn off debugging flag
      command_name ::= argv[1];
      if command_name = "poll" then ;
      elsif command_name = "server_debug" then ;
      elsif command_name = "server_tcldebug" then ;
      else
	 raw_args:ARRAY{STR}:= #(argv.size-2);
	 widget_name: STR := command_name;
	 i ::= 2; loop until!(i=argv.size);
	    raw_args[i-2] := argv[i]; i := i + 1; 
	 end;
	 if debug then deb("Executing callback with:"+arr_str(argv)); end;
	 if widget_name="app_debug"  then 
	    debval ::= raw_args[0];
	    if debval = "true" then
	       debug:=true;
	       deb("gui_app_end: turned on app debugging");
	    else
	       deb("gui_app_end: turning off app debugging");
	       debug := false;
	    end;
	 elsif widget_name="app_tcldebug"  then 
	    debval ::= raw_args[0];
	    if debval = "true" then 
	       tcldebug := true;
	       deb("gui_app_end: turned on tcldebug debugging");
	    else
	       deb("gui_app_end: turning off tcldebug debugging");
	       tcldebug := false;
	    end;
	 else
	    if raw_args.size < 1 then raise "Not enough arguments!"  end;
	    if debug then deb("Converting id to int") end;
	    action_id ::= to_int(raw_args[0]);
	    if debug then deb("Action id is:"+action_id); end;
	    widget: $TK_WIDGET := TK_WIDGET_MAP::get_widget(widget_name);
	    if debug then deb("Calling command...") end;
	    widget.act_on(action_id,raw_args);
	 end;
	 C_TCL_TK::Tcl_SetResult(tcl_tk.interpreter, 
				 "DontCare",
				 C_TCL_TK::ConstTclVolatile);
	 if debug then deb("Set tcl result to DontCare"); end;
      end;
   end;
    
   shutdown is
      UNIX::exit(0);
   end;
    
   private arr_str(a: ARRAY{STR}): STR is
      res ::= "";  loop res := res+" "+a.elt!; end;   return res;
   end;
    
   private int_if_poss(s: STR,default: INT): INT is
      c ::= #STR_CURSOR(s);
      res ::= c.int;
      if c.has_error then return default  else return res end;
   end;
   
   private to_int(s: STR): INT is
      c ::= #STR_CURSOR(s);
      res ::= c.int;
      if c.has_error then raise "Error in converting:"+s+" to int\n";  end;
      return res;
   end;
    
   deb(s: STR) is
      if debug then #ERR+"gui_server_end: "+s+"\n" end;
   end;
    
end; -- class GUI_SERVER_END
-------------------------------------------------------------------
