1 files changed, 298 insertions, 0 deletions
diff --git a/comm/OLD/TclAgent.cc b/comm/OLD/TclAgent.cc
new file mode 100644
index 0000000..a72bee0
--- /dev/null
+++ b/comm/OLD/TclAgent.cc
@@ -0,0 +1,298 @@
+/*
+ *	The Unix Channel
+ *
+ *	by Michel Beaudouin-Lafon
+ *
+ *	Copyright 1990-1993
+ *	Laboratoire de Recherche en Informatique (LRI)
+ *
+ *	An extension to Tcl for using agents
+ *
+ *	$Id$
+ *	$CurLog$
+ */
+
+#include "TextStream.h"
+#include "ccu/String.h"
+#include "TkMultiplexer.h"
+#include <stdio.h>
+#include <string.h>
+
+extern "C" {
+#include <tcl.h>
+}
+#undef const
+
+class TclAgent : public UchTextService {
+public:
+		TclAgent (Tcl_Interp*, const char*);
+		~TclAgent ();
+	
+	void	SetGotServerCmd (const char*);
+	void	SetLostServerCmd (const char*);
+	void	SetAbandonCmd (const char*);
+	void	SetClosingCmd (const char*);
+inline	const char*	GetName () const	{ return tclName; }
+
+	
+protected:
+	CcuString	tclName;
+	Tcl_Interp*	interp;
+	CcuString		gotServerCmd;
+	CcuString		lostServerCmd;
+	CcuString		abandonCmd;
+
+	Tcl_CmdBuf	buffer;
+	
+	cmd_res	Execute (const UchTextLine&);
+	void	LostServer ();
+	void	GotServer ();
+	void	AbandonRestart ();
+};
+
+
+TclAgent :: TclAgent (Tcl_Interp* i, const char* nm)
+: UchTextService (),
+  tclName (nm),
+  gotServerCmd (),
+  lostServerCmd (),
+  abandonCmd ()
+{
+	interp = i;	
+	buffer = Tcl_CreateCmdBuf ();
+}
+
+void
+TclAgent :: SetGotServerCmd (const char* cmd)
+{
+	gotServerCmd = cmd;
+}
+
+void
+TclAgent :: SetLostServerCmd (const char* cmd)
+{
+	lostServerCmd = cmd;
+}
+
+void
+TclAgent :: SetAbandonCmd (const char* cmd)
+{
+	abandonCmd = cmd;
+}
+
+TclAgent :: ~TclAgent ()
+{
+	Tcl_DeleteCmdBuf (buffer);
+}
+
+/*
+ *	eval the following command:
+ *		catch { agentname.cmd args }
+ *	where cmd is the first word of the line, i.e. the reply sent by the agent
+ *	and agentname the name of the agent as defined with the 'agent' command.
+ *	catch allows to handle undefined handlers for replies gracefully.
+ */
+UchTextStream::cmd_res
+TclAgent :: Execute (const UchTextLine& line)
+{
+	char buf [1024];
+	char* p;
+	
+	
+	sprintf (buf, "catch { %s.%s ", tclName, (const char*) (line [0]));
+	p = buf + strlen (buf);
+	
+	for (int i = 1; i < line.NumWords (); i++) {
+		if (line[i].IsInt ())
+			sprintf (p, "%d ", int (line[i]));
+		else
+			sprintf (p, "{%s} ", (const char*) (line[i]));
+		p += strlen (p);
+	}
+	strcpy (p, "}");
+	
+	if (Tcl_GlobalEval (interp, buf) == TCL_OK)
+		return isCmdOk;
+	return isCmdError;
+}
+
+void
+TclAgent :: LostServer ()
+{
+	UchTextService::LostServer ();
+	
+	if (lostServerCmd)
+		Tcl_GlobalEval (interp, (char*)(const char*)lostServerCmd);
+}
+
+void
+TclAgent :: GotServer ()
+{
+	UchTextService::GotServer ();
+
+	if (gotServerCmd)
+		Tcl_GlobalEval (interp, (char*)(const char*)gotServerCmd);
+}
+
+void
+TclAgent :: AbandonRestart ()
+{
+	if (abandonCmd)
+		Tcl_GlobalEval (interp, (char*)(const char*) abandonCmd);
+	
+	Tcl_DeleteCommand (interp, (char*)(const char*) tclName);
+	CloseNow ();
+}
+
+//---------------- Tcl commands
+
+/*
+ *	command to send requests to an agent and to operate an agent
+ *		agentname send request args...
+ *		agentname status
+ *			returns unavailable, error, running, lost
+ *		agentname close
+ *		agentname closenow
+ */
+int
+AgentCmd (ClientData data, Tcl_Interp* interp, int argc, char* argv [])
+{
+	TclAgent*	agent = (TclAgent*) data;
+	
+	/* check arguments: at least two */
+	if (argc < 2) {
+		Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+			" status | close | closenow | send request [args ...]\"", (char *) NULL);
+		return TCL_ERROR;
+	}
+	
+	const char* cmd = argv [1];
+	
+	/* send command */
+	if (strcmp (cmd, "send") == 0) {
+		if (argc < 3) {
+			Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+				" send request [args ...]\"", (char *) NULL);
+			return TCL_ERROR;
+		}
+	
+		for (int i = 2; i < argc; i++) {
+			agent->Append (argv [i]);
+			if (i < argc -1)
+				agent->Append (" ");
+		}
+		agent->Send ("\n");
+		return TCL_OK;
+	}
+	
+	/* simple commands */
+	if (argc != 2) {
+		Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+			" status | close | closenow | send request [args ...]\"", (char *) NULL);
+		return TCL_ERROR;
+	}
+	
+	if (strcmp (cmd, "status") == 0) {
+		switch (agent->GetStatus ()) {
+		case UchTextService::isUnavailable:
+			sprintf (interp->result, "unavailable");
+			break;
+		case UchTextService::isError:
+			sprintf (interp->result, "error");
+			break;
+		case UchTextService::isRunning:
+			sprintf (interp->result, "running");
+			break;
+		case UchTextService::isLost:
+			sprintf (interp->result, "lost");
+			break;
+		}
+	} else if (strcmp (cmd, "close") == 0) {
+		Tcl_DeleteCommand (interp, (char*) agent->GetName ());
+		agent->Close ();
+	} else if (strcmp (cmd, "closenow") == 0) {
+		Tcl_DeleteCommand (interp, (char*) agent->GetName ());
+		agent->CloseNow ();
+	} else {
+		Tcl_AppendResult(interp, "bad option name: \"", cmd,
+			"\"", (char *) NULL);
+		return TCL_ERROR;
+	}
+	
+	return TCL_OK;
+}
+
+/*
+ *	command to create a new agent:
+ *		agent name [-option value ...]
+ */
+int
+CreateAgentCmd (ClientData, Tcl_Interp* interp, int argc, char* argv [])
+{
+	TclAgent*	agent;
+	
+	/* check arguments: at least two, and even number overall */
+	if (argc < 2 || (argc & 01) != 0) {
+		Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+			" name [-option value ...]\"", (char *) NULL);
+		return TCL_ERROR;
+	}
+	
+	char* name = argv [1];
+	char* host = 0;
+	agent = new TclAgent (interp, name);
+	
+	for (int i = 2; i < argc; i++) {
+		char* option = argv [i++];
+		char* value = argv [i];
+		if (strcmp (option, "-host") == 0)
+			host = value;
+		else
+		if (strcmp (option, "-name") == 0)
+			name = value;
+		else
+		if (strcmp (option, "-init") == 0)
+			agent->SetGotServerCmd (value);
+		else
+		if (strcmp (option, "-lost") == 0)
+			agent->SetLostServerCmd (value);
+		else
+		if (strcmp (option, "-abandon") == 0)
+			agent->SetAbandonCmd (value);
+		else {
+			Tcl_AppendResult(interp, "bad option name: \"", argv[i-1],
+				"\"", (char *) NULL);
+			return TCL_ERROR;
+		}
+	}
+
+	agent->Init (name, host);
+	
+	/* define the command for manipulating the source */
+	Tcl_CreateCommand (interp, name, AgentCmd, (ClientData) agent, 0);
+	
+	return TCL_OK;
+}
+
+//---------------- initialization
+
+/*
+ *	initialize the audio gizmo
+ *	returns 0 if error and leaves the message in interp->result
+ */
+UchTkMultiplexer mpx;
+
+extern "C" int
+InitAgent (Tcl_Interp* interp)
+{
+	Tcl_CreateCommand (interp, "agent", CreateAgentCmd, 0, 0);
+	
+	return 1;
+}
+
+extern "C" int tkmain (int, char* []);
+
+main (int argc, char* argv [])
+{
+	return tkmain (argc, argv);
+}