------------------------->  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_SERVER_END is
   -- The server end of the gui socket.  Uses tcl/tk.

   private shared asynch_socket: SOCKET;
   -- Used for commands from App->Server, and callbacks from Server->App.
   private shared synch_socket: SOCKET;
   -- Synchronous command socket - for commands with return values
   private shared tcl:TCL_TK;
   
   private shared debug: BOOL := true;
   private shared tcldebug: BOOL := false;
   -- Debug flag for debug messages in less critical areas

   
   main(args:ARRAY{STR}) is
      -- Optional single argument, which is host name to connect to.
      -- If present, Internet-doman sockets are used instead of Unix-domain.
      sather_home: STR := UNIX::get_env("SATHER_HOME");
      if void(sather_home) then 
	 raise "gui_server_end: couldn't find SATHER_HOME" 
      end;
      tcl := #TCL_TK("SatherGui",sather_home+"/");
      TCL_TK_COMMANDS::sather_command(tcl.interp_to_int,
				      bind(exec_callback(_)));

      INIT_GUI::gui_setup(tcl);
      hostname:STR;
      if args.size>1 then hostname:=args[1] end;
      deb("Connecting to asynch socket ...");
      if void(hostname) then
	 asynch_socket:=SOCKET::create_connecting_unix("GUI_ASYNCH")
      else
	 deb("Hostname not void: "+hostname+" Hence using inet sockets.");
	 asynch_socket:=SOCKET::create_connecting_inet(hostname,5000)
      end;
      if asynch_socket.is_dead then 
	 raise "gui_server_end: Failed to create connecting asynch_socket\n";  
      end;
      deb("Asynch connection made. Connecting to synch socket ...");
      if void(hostname) then
	 synch_socket:=SOCKET::create_connecting_unix("GUI_SYNCH")
      else
	 synch_socket:=SOCKET::create_connecting_inet(hostname,5001)
      end;
      if synch_socket.is_dead then 
	 raise "gui_server_end: Failed to create connecting synch_socket\n";  
      end;
      INIT_GUI::gui_post_socket_init(tcl);
      deb("Entering main tcl loop ...");
      tcl.main_loop;
   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 handle_pending_app_commands
      elsif command_name = "server_debug" then debug := argv[2]="true";
      elsif command_name = "server_tcldebug" then tcldebug := argv[2]="true";
      else
	 if debug then deb("Executing callback with:"+arr_str(argv)); end;
	 if debug then deb("Size of argument list:"+(argv.size)); end;
	 asynch_socket+command_name;      -- Send the window name
	 asynch_socket+(argv.size-2).str; -- Send the number of arguments
	 i ::= 2;
	 loop until!(i = argv.size);
	    asynch_socket+argv[i];	-- Send the arguments
	    i := i+1;
	 end;
         if asynch_socket.is_dead then 
            raise "gui_server_end: asynch_socket dead on sending callback"
         end;
	 assert ~void(tcl);
	 C_TCL_TK::Tcl_SetResult(tcl.interpreter, 
				 "DontCare",
				 C_TCL_TK::ConstTclVolatile);
	 if debug then deb("Set tcl result to DontCare"); end;
      end;
   end;
      
   arr_str(a: ARRAY{STR}): STR is
      res ::= "";  loop res := res+" "+a.elt!; end;  return res;
   end;
   
   handle_pending_app_commands is
      -- A special callback to handle commands from sather
      -- Process any commands pending on "asynch_socket"
      -- This depends on "poll" being called appropriately
      -- in the tcl application
      if asynch_socket.is_dead then 
	 raise "gui_server_end: asynch_socket dead before receiving "
	       "sather commands"
      end;
      if asynch_socket.can_read_without_block then
	 if debug then deb("Polling and asynch commands present"); end;
	 loop until!(~asynch_socket.can_read_without_block);
	    s ::= asynch_socket.get_str;
	    if asynch_socket.is_dead then 
	       raise "gui_server_end: asynch_socket dead receiving "
		     "sather commands"
	    end;
	    if debug then deb("Poll(read)->"+s+"<-"); end;
	    if ~void(s) and s.length > 0 then
	       if tcldebug then #ERR+s+"\n" end;
	       if s="terminate" then shutdown end;
	       assert ~void(tcl);
	       res ::= tcl.eval(s);
	       if debug then deb("Poll(return):"+res) end;
	    else   
	       if debug then deb("Poll(read): read void");  end;
	    end;
	 end;
	 if debug then deb("Finished asynch poll loop"); end;
      end;
      if asynch_socket.is_dead then 
	 raise "gui_server_end: synch_socket dead before receiving "
	       "sather commands"
      end;
      if synch_socket.can_read_without_block then
	 deb("Polling and data present on synch command socket");
	 loop until!(~synch_socket.can_read_without_block);
	    s ::= synch_socket.get_str;
	    if synch_socket.is_dead then 
	       raise "gui_server_end: synch_socket dead receiving "
		     "sather commands"
	    end;
	    if debug then deb("Poll(read synch)->"+s+"<-"); end;
	    if ~void(s) and s.length > 0 then
	       if tcldebug then #ERR+s+"\n" end;
	       assert ~void(tcl);
	       res ::= tcl.eval(s);
	       if void(res) or res.size = 0 then res := "NoReturnValue";  end;
	       if debug then deb("Poll(return):"+res.size+","+res) end;
	       synch_socket+res;
               if synch_socket.is_dead then
                  raise "gui_server_end: synch_socket sending response "
			"to command"
               end;
	    else   
	       if debug then deb("Poll(read): read void "); end;
	    end;
	 end;
	 if debug then deb("Finished synch poll loop"); end;
      end;
   end;
   
   shutdown is
      asynch_socket.close;
      synch_socket.close;
      UNIX::exit(0);
   end;
   
   private deb(s: STR) is
      if debug then #ERR+"GUI_SERVER_END::debug : "+s+"\n" end;
   end;

end; -- class GUI_SERVER_END
-------------------------------------------------------------------
