home *** CD-ROM | disk | FTP | other *** search
-
- /*
- ** This source code was written by Tim Endres
- ** Email: time@ice.com.
- ** USMail: 8840 Main Street, Whitmore Lake, MI 48189
- **
- ** Some portions of this application utilize sources
- ** that are copyrighted by ICE Engineering, Inc., and
- ** ICE Engineering retains all rights to those sources.
- **
- ** Neither ICE Engineering, Inc., nor Tim Endres,
- ** warrants this source code for any reason, and neither
- ** party assumes any responsbility for the use of these
- ** sources, libraries, or applications. The user of these
- ** sources and binaries assumes all responsbilities for
- ** any resulting consequences.
- */
-
- #pragma segment TCLCTB
-
- #include "tickle.h"
- #include "tcl.h"
-
- #include <Connections.h>
- #include <CTBUtilities.h>
- #include <CommResources.h>
- #include <FileTransfers.h>
- #include <Terminals.h>
-
- extern int errno;
- extern int macintoshErr;
-
- typedef enum
- {
- CONNECTION_CLOSED_STATE,
- CONNECTION_LISTEN_STATE,
- CONNECTION_OPEN_STATE,
- CONNECTION_UNUSED_STATE
- } CONN_STATE;
-
- typedef struct
- {
- CONN_STATE state;
- ConnHandle connH;
- short connID;
- char name[32];
- } CTB_NAMED_CONN;
-
-
- #define MAX_CTB 16
-
- int _ctb_is_available_ = 0;
- static int _max_ctb_ = 0;
- static CTB_NAMED_CONN *_ctb_ = NULL;
-
-
- init_tcl_ctb()
- {
- int i;
-
- _ctb_is_available_ = 0;
- if ( CheckForCTB() )
- {
- if ( InitCTBCommunications() )
- {
- _ctb_is_available_ = 1;
-
- _ctb_ = (CTB_NAMED_CONN *) malloc(sizeof(CTB_NAMED_CONN) * MAX_CTB);
- if (_ctb_ == NULL)
- _max_ctb_ = 0;
- else
- _max_ctb_ = MAX_CTB;
-
- for ( i = 0 ; i < _max_ctb_ ; ++i )
- {
- _ctb_[i].state = CONNECTION_UNUSED_STATE;
- _ctb_[i].connH = (ConnHandle) 0;
- _ctb_[i].connID = -1;
- _ctb_[i].name[0] = '\0';
- }
- }
- }
- }
-
- close_tcl_ctb()
- {
- int i, myerr;
-
- if (! _ctb_is_available_)
- return;
-
- for ( i = 0 ; i < _max_ctb_ ; ++i )
- {
- if (_ctb_[i].connH != (ConnHandle)0)
- {
- myerr = CMClose(_ctb_[i].connH, (Boolean)0, NULL,
- (long)0, (Boolean)1);
- CMDispose(_ctb_[i].connH);
- }
- }
- }
-
-
- int
- Cmd_CTBCreate(clientData, interp, argc, argv)
- char *clientData;
- Tcl_Interp *interp;
- int argc;
- char **argv;
- {
- ConnHandle connH;
- short connID;
- Str255 tool_name;
- CMBufferSizes sizes;
- int index, myerr;
- #pragma unused (clientData)
-
- if ( ! _ctb_is_available_ )
- {
- Tcl_AppendResult(interp, "CTB is not available on this Macintosh", NULL);
- return TCL_ERROR;
- }
-
- if (argc < 3 || argc > 4)
- {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ctbname toolname ?configstr?\"", NULL);
- return TCL_ERROR;
- }
-
- for (index = 0 ; index < _max_ctb_ ; ++index)
- {
- if (_ctb_[index].connH == NULL)
- break;
-
- if (strcmp(_ctb_[index].name, argv[1]) == SAMESTR)
- {
- Tcl_AppendResult(interp, "\"", argv[0], "\" duplicate connection name '",
- argv[1], "'", (char *) NULL);
- return TCL_ERROR;
- }
- }
-
- if (index >= _max_ctb_)
- {
- Tcl_AppendResult(interp, "\"", argv[0], "\" max connection's open", NULL);
- return TCL_ERROR;
- }
-
- connH = NULL;
- connID = -1;
-
- if ( strcmp(argv[2], "any") == 0 )
- {
- myerr = CRMGetIndToolName((OSType)classCM, 1, tool_name);
- if (myerr != noErr)
- {
- strcpy(tool_name, "Serial Tool");
- c2pstr(tool_name);
- }
- }
- else
- {
- strcpy(tool_name, argv[2]);
- c2pstr(tool_name);
- }
-
- connID = CMGetProcID(tool_name);
- if (connID == -1)
- {
- Tcl_AppendResult(interp, "could not open tool \"", argv[2], "\"", NULL);
- return TCL_ERROR;
- }
-
- sizes[cmDataIn] = 1024;
- sizes[cmDataOut] = 1024;
- sizes[cmCntlIn] = 0;
- sizes[cmCntlOut] = 0;
- sizes[cmAttnIn] = 0;
- sizes[cmAttnOut] = 0;
- connH = CMNew( (short)connID,
- (CMRecFlags) ( cmData | cmNoMenus | cmQuiet ),
- sizes, (long)0, (long)0);
-
- if (connH == NULL)
- {
- Tcl_AppendResult(interp, "could not open CTB connection", NULL);
- return TCL_ERROR;
- }
-
- if (argc == 4)
- {
- myerr = CMSetConfig(connH, (Ptr)argv[3]);
- if (myerr != noErr)
- Tcl_AppendResult(interp, "warning - config string error", NULL);
- }
-
- strcpy(_ctb_[index].name, argv[1]);
- _ctb_[index].connH = connH;
- _ctb_[index].connID = connID;
- _ctb_[index].state = CONNECTION_CLOSED_STATE;
-
- return TCL_OK;
- }
-
- int
- Cmd_CTBOpen(clientData, interp, argc, argv)
- char *clientData;
- Tcl_Interp *interp;
- int argc;
- char **argv;
- {
- int index, myerr;
- #pragma unused (clientData)
-
- if ( ! _ctb_is_available_ )
- {
- Tcl_AppendResult(interp, "CTB is not available on this Macintosh", NULL);
- return TCL_ERROR;
- }
-
- if (argc != 2)
- {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ctbname\"", NULL);
- return TCL_ERROR;
- }
-
- for (index = 0 ; index < _max_ctb_ ; ++index)
- {
- if (strcmp(_ctb_[index].name, argv[1]) == SAMESTR)
- break;
- }
-
- if (index >= _max_ctb_)
- {
- Tcl_AppendResult(interp, "connection \"",
- argv[1], "\" not found", (char *) NULL);
- return TCL_ERROR;
- }
-
- myerr = CMOpen(_ctb_[index].connH, (Boolean)0, (ProcPtr)0, (long)0 );
- if (myerr != noErr)
- {
- Tcl_AppendResult(interp, "error opening connection \"", argv[1],
- "\", ", Tcl_MacGetError(interp, myerr), NULL);
- return TCL_ERROR;
- }
-
- _ctb_[index].state = CONNECTION_OPEN_STATE;
-
- return TCL_OK;
- }
-
- int
- Cmd_CTBListen(clientData, interp, argc, argv)
- char *clientData;
- Tcl_Interp *interp;
- int argc;
- char **argv;
- {
- int index, myerr;
- #pragma unused (clientData)
-
- if ( ! _ctb_is_available_ )
- {
- Tcl_AppendResult(interp, "CTB is not available on this Macintosh", NULL);
- return TCL_ERROR;
- }
-
- if (argc != 2)
- {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ctbname\"", NULL);
- return TCL_ERROR;
- }
-
- for (index = 0 ; index < _max_ctb_ ; ++index)
- {
- if (strcmp(_ctb_[index].name, argv[1]) == SAMESTR)
- break;
- }
-
- if (index >= _max_ctb_)
- {
- Tcl_AppendResult(interp, "connection \"",
- argv[1], "\" not found", (char *) NULL);
- return TCL_ERROR;
- }
-
- myerr = CMListen(_ctb_[index].connH, (Boolean)1, NULL, -1);
- if (myerr != noErr)
- {
- Tcl_AppendResult(interp, "error listening on connection \"", argv[1],
- "\", ", Tcl_MacGetError(interp, myerr), NULL);
- return TCL_ERROR;
- }
-
- _ctb_[index].state = CONNECTION_LISTEN_STATE;
-
- return TCL_OK;
- }
-
- int
- Cmd_CTBAccept(clientData, interp, argc, argv)
- char *clientData;
- Tcl_Interp *interp;
- int argc;
- char **argv;
- {
- int index, myerr;
- CMStatFlags flags;
- CMBufferSizes sizes;
- #pragma unused (clientData)
-
- if ( ! _ctb_is_available_ )
- {
- Tcl_AppendResult(interp, "CTB is not available on this Macintosh", NULL);
- return TCL_ERROR;
- }
-
- if (argc != 2)
- {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ctbname\"", NULL);
- return TCL_ERROR;
- }
-
- for (index = 0 ; index < _max_ctb_ ; ++index)
- {
- if (strcmp(_ctb_[index].name, argv[1]) == SAMESTR)
- break;
- }
-
- if (index >= _max_ctb_)
- {
- Tcl_AppendResult(interp, "connection \"",
- argv[1], "\" not found", (char *) NULL);
- return TCL_ERROR;
- }
-
- if (_ctb_[index].state != CONNECTION_LISTEN_STATE)
- {
- Tcl_AppendResult(interp, "connection \"", argv[1],
- "\" is not listening", NULL);
- return TCL_ERROR;
- }
-
- myerr = CMStatus(_ctb_[index].connH, sizes, &flags);
- if (myerr != noErr)
- {
- Tcl_AppendResult(interp, "error getting connection \"", argv[1],
- "\" status, ", Tcl_MacGetError(interp, myerr), NULL);
- return TCL_ERROR;
- }
-
- if ( (flags & cmStatusIncomingCallPresent) == 0 )
- {
- Tcl_AppendResult(interp, "connection \"", argv[1],
- "\" does not have incoming call", NULL);
- return TCL_ERROR;
- }
-
- myerr = CMAccept(_ctb_[index].connH, (Boolean)1);
- if (myerr != noErr)
- {
- Tcl_AppendResult(interp, "error accepting on connection \"", argv[1],
- "\", ", Tcl_MacGetError(interp, myerr), NULL);
- return TCL_ERROR;
- }
-
- _ctb_[index].state = CONNECTION_OPEN_STATE;
-
- return TCL_OK;
- }
-
- int
- Cmd_CTBToolname(clientData, interp, argc, argv)
- char *clientData;
- Tcl_Interp *interp;
- int argc;
- char **argv;
- {
- int index, myerr;
- Str255 toolname;
-
- # pragma unused (clientData)
-
- if ( ! _ctb_is_available_ )
- {
- Tcl_AppendResult(interp, "CTB is not available on this Macintosh", NULL);
- return TCL_ERROR;
- }
-
- if (argc < 2 || argc > 3)
- {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ctbname ?varname?\"", NULL);
- return TCL_ERROR;
- }
-
- for (index = 0 ; index < _max_ctb_ ; ++index)
- {
- if (strcmp(_ctb_[index].name, argv[1]) == SAMESTR)
- break;
- }
-
- if (index >= _max_ctb_)
- {
- Tcl_AppendResult(interp, "connection \"",
- argv[1], "\" not found", (char *) NULL);
- return TCL_ERROR;
- }
-
- CMGetToolName(_ctb_[index].connID, toolname);
- p2cstr(toolname);
-
- if (argc == 3)
- {
- if ( Tcl_SetVar(interp, argv[2], toolname, TCL_LEAVE_ERR_MSG) == NULL )
- return TCL_ERROR;
- }
- else
- {
- Tcl_AppendResult(interp, toolname, NULL);
- }
-
- return TCL_OK;
- }
-
- int
- Cmd_CTBGetConfig(clientData, interp, argc, argv)
- char *clientData;
- Tcl_Interp *interp;
- int argc;
- char **argv;
- {
- ConnHandle connH;
- short connID;
- Ptr configstr;
- int index, myerr;
- #pragma unused (clientData)
-
- if ( ! _ctb_is_available_ )
- {
- Tcl_AppendResult(interp, "CTB is not available on this Macintosh", NULL);
- return TCL_ERROR;
- }
-
- if (argc < 2 || argc > 3)
- {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ctbname ?varname?\"", NULL);
- return TCL_ERROR;
- }
-
- for (index = 0 ; index < _max_ctb_ ; ++index)
- {
- if (strcmp(_ctb_[index].name, argv[1]) == SAMESTR)
- break;
- }
-
- if (index >= _max_ctb_)
- {
- Tcl_AppendResult(interp, "connection \"",
- argv[1], "\" not found", (char *) NULL);
- return TCL_ERROR;
- }
-
- configstr = CMGetConfig(_ctb_[index].connH);
- if (configstr == NULL)
- {
- Tcl_AppendResult(interp, "error getting configuration string", NULL);
- return TCL_ERROR;
- }
-
- if (argc == 3)
- {
- if ( Tcl_SetVar(interp, argv[2], configstr, TCL_LEAVE_ERR_MSG) == NULL )
- {
- DisposPtr(configstr);
- return TCL_ERROR;
- }
- }
- else
- {
- Tcl_AppendResult(interp, configstr, NULL);
- }
-
- DisposPtr(configstr);
-
- return TCL_OK;
- }
-
- int
- Cmd_CTBGetStatus(clientData, interp, argc, argv)
- char *clientData;
- Tcl_Interp *interp;
- int argc;
- char **argv;
- {
- char str[64], *statestr;
- int index, myerr;
- CMStatFlags flags;
- CMBufferSizes sizes;
- #pragma unused (clientData)
-
- if ( ! _ctb_is_available_ )
- {
- Tcl_AppendResult(interp, "CTB is not available on this Macintosh", NULL);
- return TCL_ERROR;
- }
-
- if (argc != 2)
- {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ctbname\"", NULL);
- return TCL_ERROR;
- }
-
- for (index = 0 ; index < _max_ctb_ ; ++index)
- {
- if (strcmp(_ctb_[index].name, argv[1]) == SAMESTR)
- break;
- }
-
- if (index >= _max_ctb_)
- {
- Tcl_AppendResult(interp, "connection \"",
- argv[1], "\" not found", (char *) NULL);
- return TCL_ERROR;
- }
-
- myerr = CMStatus(_ctb_[index].connH, sizes, &flags);
- if (myerr != noErr)
- {
- Tcl_AppendResult(interp, "error getting connection status, ",
- Tcl_MacGetError(interp, myerr), NULL);
- return TCL_ERROR;
- }
-
- switch (_ctb_[index].state)
- {
- case CONNECTION_UNUSED_STATE: statestr = "UNUSED"; break;
- case CONNECTION_CLOSED_STATE: statestr = "CLOSED"; break;
- case CONNECTION_LISTEN_STATE: statestr = "LISTEN"; break;
- case CONNECTION_OPEN_STATE: statestr = "OPEN"; break;
- default:
- sprintf(str, "UNKNOWN-%d", _ctb_[index].state);
- statestr = str;
- break;
- }
- Tcl_AppendElement(interp, statestr);
-
- sprintf(str, "0x%08lX", flags);
- Tcl_AppendElement(interp, str);
-
- sprintf(str, "%d", sizes[cmDataIn]);
- Tcl_AppendElement(interp, str);
-
- sprintf(str, "%d", sizes[cmDataOut]);
- Tcl_AppendElement(interp, str);
-
- return TCL_OK;
- }
-
- int
- Cmd_CTBSetConfig(clientData, interp, argc, argv)
- char *clientData;
- Tcl_Interp *interp;
- int argc;
- char **argv;
- {
- char buf[64];
- int index, myerr;
-
- # pragma unused (clientData)
-
- if ( ! _ctb_is_available_ )
- {
- Tcl_AppendResult(interp, "CTB is not available on this Macintosh", NULL);
- return TCL_ERROR;
- }
-
- if (argc != 3)
- {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ctbname configstr\"", NULL);
- return TCL_ERROR;
- }
-
- for (index = 0 ; index < _max_ctb_ ; ++index)
- {
- if (strcmp(_ctb_[index].name, argv[1]) == SAMESTR)
- break;
- }
-
- if (index >= _max_ctb_)
- {
- Tcl_AppendResult(interp, "connection \"",
- argv[1], "\" not found", (char *) NULL);
- return TCL_ERROR;
- }
-
- myerr = CMSetConfig(_ctb_[index].connH, (Ptr)argv[2]);
- if (myerr != noErr)
- {
- sprintf(buf, "%d", myerr);
- Tcl_AppendResult(interp, "config string error at character # ",
- buf, NULL);
- return TCL_ERROR;
- }
-
- return TCL_OK;
- }
-
- int
- Cmd_CTBConfigDialog(clientData, interp, argc, argv)
- char *clientData;
- Tcl_Interp *interp;
- int argc;
- char **argv;
- {
- #ifdef TCLAPPL
- short connID;
- int index, myerr;
- Point mypoint;
- ConnHandle connH;
-
- # pragma unused (clientData)
-
- if ( ! _ctb_is_available_ )
- {
- Tcl_AppendResult(interp, "CTB is not available on this Macintosh", NULL);
- return TCL_ERROR;
- }
-
- if (argc != 2)
- {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ctbname\"", NULL);
- return TCL_ERROR;
- }
-
- for (index = 0 ; index < _max_ctb_ ; ++index)
- {
- if (strcmp(_ctb_[index].name, argv[1]) == SAMESTR)
- break;
- }
-
- if (index >= _max_ctb_)
- {
- Tcl_AppendResult(interp, "connection \"",
- argv[1], "\" not found", (char *) NULL);
- return TCL_ERROR;
- }
-
- connH = _ctb_[index].connH;
- mypoint.h = ((scrnrect.right - scrnrect.left) - 480) >> 1;
- mypoint.v = 40;
-
- myerr = CMChoose(&connH, mypoint, NULL);
-
- if (myerr == chooseDisaster)
- {
- Tcl_AppendResult( interp, "error in the Communications ToolBox, ",
- Tcl_MacGetError(interp, myerr), NULL );
- }
- else if (myerr == chooseOKMajor || myerr == chooseOKMinor)
- {
- if (myerr == chooseOKMajor)
- _ctb_[index].connID = (**connH).procID;
-
- _ctb_[index].connH = connH;
- }
-
- return TCL_OK;
- #else
- Tcl_AppendResult(interp, "\"", argv[0],
- "\" is not supported in engine", NULL);
- return TCL_ERROR;
- #endif
- }
-
- int
- Cmd_CTBWrite(clientData, interp, argc, argv)
- char *clientData;
- Tcl_Interp *interp;
- int argc;
- char **argv;
- {
- int index, myerr, bytes, tries, length;
- char *ptr;
-
- # pragma unused (clientData)
-
- if ( ! _ctb_is_available_ )
- {
- Tcl_AppendResult(interp, "CTB is not available on this Macintosh", NULL);
- return TCL_ERROR;
- }
-
- if (argc != 3)
- {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ctbname data\"", NULL);
- return TCL_ERROR;
- }
-
- for (index = 0 ; index < _max_ctb_ ; ++index)
- {
- if (strcmp(_ctb_[index].name, argv[1]) == SAMESTR)
- break;
- }
-
- if (index >= _max_ctb_)
- {
- Tcl_AppendResult(interp, "connection \"",
- argv[1], "\" not found", (char *) NULL);
- return TCL_ERROR;
- }
-
- if (_ctb_[index].state != CONNECTION_OPEN_STATE)
- {
- Tcl_AppendResult(interp, "connection \"", argv[1],
- "\" is not open", NULL);
- return TCL_ERROR;
- }
-
- ptr = argv[2];
- length = strlen(argv[2]);
- for ( tries = 0 ; tries < 5 && length > 0 ; ++tries )
- {
- bytes = length;
- myerr = CMWrite(_ctb_[index].connH, ptr, &bytes,
- cmData, (Boolean)0, NULL, (long)0, (Boolean)0);
-
- if (myerr != noErr)
- {
- Tcl_AppendResult(interp, "error storing data, ",
- Tcl_MacGetError(interp, myerr), NULL);
- return TCL_ERROR;
- }
-
- ptr += bytes;
- length -= bytes;
- }
-
- if (length > 0)
- {
- Tcl_AppendResult(interp, "error could not write all of data", NULL);
- return TCL_ERROR;
- }
-
- return TCL_OK;
- }
-
- int
- Cmd_CTBRead(clientData, interp, argc, argv)
- char *clientData;
- Tcl_Interp *interp;
- int argc;
- char **argv;
- {
- int index, result, myerr;
- long flags, bytes, bufsize;
- CMFlags cmflags;
- CMBufferSizes sizes;
- char buffer[1024];
-
- # pragma unused (clientData)
-
- if ( ! _ctb_is_available_ )
- {
- Tcl_AppendResult(interp, "CTB is not available on this Macintosh", NULL);
- return TCL_ERROR;
- }
-
- if (argc < 2 || argc > 3)
- {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ctbname ?varname?\"", NULL);
- return TCL_ERROR;
- }
-
- for (index = 0 ; index < _max_ctb_ ; ++index)
- {
- if (strcmp(_ctb_[index].name, argv[1]) == SAMESTR)
- break;
- }
-
- if (index >= _max_ctb_)
- {
- Tcl_AppendResult(interp, "connection \"",
- argv[1], "\" not found", (char *) NULL);
- return TCL_ERROR;
- }
-
- if (_ctb_[index].state != CONNECTION_OPEN_STATE)
- {
- Tcl_AppendResult(interp, "connection \"", argv[1],
- "\" is not open", NULL);
- return TCL_ERROR;
- }
-
- myerr = CMStatus(_ctb_[index].connH, sizes, &flags);
- if (myerr != noErr)
- {
- Tcl_AppendResult(interp, "error getting connection status, ",
- Tcl_MacGetError(interp, myerr), NULL);
- return TCL_ERROR;
- }
-
- if ((flags & cmStatusOpen) == 0)
- {
- Tcl_AppendResult(interp, "connection is closed", NULL);
- return TCL_ERROR;
- }
-
- buffer[0] = '\0';
- bufsize = sizeof(buffer);
- Tcl_ResetResult(interp);
-
- if ( (flags & cmStatusDataAvail) != 0 )
- {
- bytes = ( sizes[cmDataIn] < bufsize ) ?
- sizes[cmDataIn] : bufsize - 1;
- myerr = CMRead(_ctb_[index].connH, buffer, &bytes,
- cmData, (Boolean)0, NULL, (long)0, &cmflags);
- if (myerr != noErr)
- {
- Tcl_AppendResult(interp, "error reading data, ",
- Tcl_MacGetError(interp, myerr), NULL);
- return TCL_ERROR;
- }
-
- buffer[bytes] = '\0';
- if (argc == 3)
- {
- if ( Tcl_SetVar(interp, argv[2], buffer, TCL_LEAVE_ERR_MSG) == NULL )
- return TCL_ERROR;
- }
- else
- {
- Tcl_AppendResult(interp, buffer, (char *) NULL);
- }
- }
-
- return TCL_OK;
- }
-
- int
- Cmd_CTBBreak(clientData, interp, argc, argv)
- char *clientData;
- Tcl_Interp *interp;
- int argc;
- char **argv;
- {
- int index, myerr;
- long duration = 30;
- char *ptr;
-
- # pragma unused (clientData)
-
- if ( ! _ctb_is_available_ )
- {
- Tcl_AppendResult(interp, "CTB is not available on this Macintosh", NULL);
- return TCL_ERROR;
- }
-
- if (argc != 2 && argc != 3)
- {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ctbname ?ticks?\"", NULL);
- return TCL_ERROR;
- }
-
- for (index = 0 ; index < _max_ctb_ ; ++index)
- {
- if (strcmp(_ctb_[index].name, argv[1]) == SAMESTR)
- break;
- }
-
- if (index >= _max_ctb_)
- {
- Tcl_AppendResult(interp, "connection \"",
- argv[1], "\" not found", (char *) NULL);
- return TCL_ERROR;
- }
-
- if (_ctb_[index].state != CONNECTION_OPEN_STATE)
- {
- Tcl_AppendResult(interp, "connection \"", argv[1],
- "\" is not open", NULL);
- return TCL_ERROR;
- }
-
- if (argc == 3)
- {
- if ( sscanf(argv[2], "%ld", &duration) != 1 )
- duration = 30;
- }
-
- CMBreak(_ctb_[index].connH, duration, (Boolean)0, NULL);
-
- if (myerr != noErr)
- {
- Tcl_AppendResult(interp, "error storing data, ",
- Tcl_MacGetError(interp, myerr), NULL);
- return TCL_ERROR;
- }
- return TCL_OK;
- }
-
- int
- Cmd_CTBClose(clientData, interp, argc, argv)
- char *clientData;
- Tcl_Interp *interp;
- int argc;
- char **argv;
- {
- int index, result, myerr;
-
- # pragma unused (clientData)
-
- if ( ! _ctb_is_available_ )
- {
- Tcl_AppendResult(interp, "CTB is not available on this Macintosh", NULL);
- return TCL_ERROR;
- }
-
- if (argc != 2)
- {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ctbname\"", (char *) NULL);
- return TCL_ERROR;
- }
-
- for (index = 0 ; index < _max_ctb_ ; ++index)
- {
- if (strcmp(_ctb_[index].name, argv[1]) == SAMESTR)
- break;
- }
-
- if (index >= _max_ctb_)
- {
- Tcl_AppendResult(interp, "connection \"", argv[1], "\" not found", NULL);
- return TCL_ERROR;
- }
-
- if (_ctb_[index].state == CONNECTION_CLOSED_STATE ||
- _ctb_[index].state == CONNECTION_UNUSED_STATE)
- {
- Tcl_AppendResult(interp, "connection \"", argv[1], "\" is not open", NULL);
- return TCL_ERROR;
- }
-
- myerr = CMClose(_ctb_[index].connH, (Boolean)0, NULL, (long)0, (Boolean)1);
-
- _ctb_[index].state = CONNECTION_CLOSED_STATE;
-
- return TCL_OK;
- }
-
- int
- Cmd_CTBDispose(clientData, interp, argc, argv)
- char *clientData;
- Tcl_Interp *interp;
- int argc;
- char **argv;
- {
- int index, result, myerr;
-
- # pragma unused (clientData)
-
- if ( ! _ctb_is_available_ )
- {
- Tcl_AppendResult(interp, "CTB is not available on this Macintosh", NULL);
- return TCL_ERROR;
- }
-
- if (argc != 2)
- {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ctbname\"", (char *) NULL);
- return TCL_ERROR;
- }
-
- for (index = 0 ; index < _max_ctb_ ; ++index)
- {
- if (strcmp(_ctb_[index].name, argv[1]) == SAMESTR)
- break;
- }
-
- if (index >= _max_ctb_)
- {
- Tcl_AppendResult(interp, "connection \"", argv[1], "\" not found", NULL);
- return TCL_ERROR;
- }
-
- if (_ctb_[index].state != CONNECTION_CLOSED_STATE)
- {
- myerr = CMClose(_ctb_[index].connH, (Boolean)0, NULL, (long)0, (Boolean)1);
- }
-
- CMDispose(_ctb_[index].connH);
-
- _ctb_[index].connH = (ConnHandle) 0;
- _ctb_[index].connID = -1;
- _ctb_[index].state = CONNECTION_UNUSED_STATE;
- _ctb_[index].name[0] = '\0';
-
- return TCL_OK;
- }
-
- Tcl_CTBIdleChecks()
- {
- int index;
-
- for (index = 0 ; index < _max_ctb_ ; ++index)
- {
- if (_ctb_[index].state != CONNECTION_UNUSED_STATE)
- if (_ctb_[index].connH != NULL)
- CMIdle(_ctb_[index].connH);
- }
- }
-
- Tcl_InitCTB(interp)
- Tcl_Interp *interp;
- {
- Tcl_CreateCommand(interp, "ctb_create", Cmd_CTBCreate,
- (ClientData)NULL, (void (*)())NULL);
- Tcl_CreateCommand(interp, "ctb_dispose", Cmd_CTBDispose,
- (ClientData)NULL, (void (*)())NULL);
- Tcl_CreateCommand(interp, "ctb_open", Cmd_CTBOpen,
- (ClientData)NULL, (void (*)())NULL);
- Tcl_CreateCommand(interp, "ctb_listen", Cmd_CTBListen,
- (ClientData)NULL, (void (*)())NULL);
- Tcl_CreateCommand(interp, "ctb_accept", Cmd_CTBAccept,
- (ClientData)NULL, (void (*)())NULL);
- Tcl_CreateCommand(interp, "ctb_close", Cmd_CTBClose,
- (ClientData)NULL, (void (*)())NULL);
- Tcl_CreateCommand(interp, "ctb_write", Cmd_CTBWrite,
- (ClientData)NULL, (void (*)())NULL);
- Tcl_CreateCommand(interp, "ctb_break", Cmd_CTBBreak,
- (ClientData)NULL, (void (*)())NULL);
- Tcl_CreateCommand(interp, "ctb_read", Cmd_CTBRead,
- (ClientData)NULL, (void (*)())NULL);
- Tcl_CreateCommand(interp, "ctb_getconfig", Cmd_CTBGetConfig,
- (ClientData)NULL, (void (*)())NULL);
- Tcl_CreateCommand(interp, "ctb_setconfig", Cmd_CTBSetConfig,
- (ClientData)NULL, (void (*)())NULL);
- Tcl_CreateCommand(interp, "ctb_config", Cmd_CTBConfigDialog,
- (ClientData)NULL, (void (*)())NULL);
- Tcl_CreateCommand(interp, "ctb_status", Cmd_CTBGetStatus,
- (ClientData)NULL, (void (*)())NULL);
- }
-
- InitCTBCommunications()
- {
- short myerr;
-
- myerr = InitCRM();
- if (myerr != noErr)
- return 0;
-
- myerr = InitCTBUtilities();
- if (myerr != noErr)
- return 0;
-
- myerr = InitCM();
- if (myerr != noErr)
- return 0;
-
- #ifdef UNDONE
- myerr = InitTM();
- if (myerr != noErr)
- return 0;
-
- myerr = InitFT();
- if (myerr != noErr)
- {
- return 0;
- }
- #endif
-
- return 1;
- }
-
- #define UNIMPTrapNumber 0x9F
- #define CTBTrapNumber 0x8B
-
- CheckForCTB()
- {
- if (NGetTrapAddress(UNIMPTrapNumber, OSTrap)
- == NGetTrapAddress(CTBTrapNumber, OSTrap))
- return 0;
- else
- return 1;
- }
-
-