From e0b1bf56fae7f31706067564527156644a7a5fc2 Mon Sep 17 00:00:00 2001 From: chatty Date: Tue, 27 Jul 1993 13:54:59 +0000 Subject: Initial revision --- comm/OLD/TclAgent.cc | 298 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 298 insertions(+) create mode 100644 comm/OLD/TclAgent.cc (limited to 'comm/OLD/TclAgent.cc') 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 +#include + +extern "C" { +#include +} +#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); +} -- cgit v1.1