This HTML document contains annotated C code for extending Tcl and
implements these Tcl procedures:sbf::intoke open sbf::intoke close sbf::intoke parameters <object_name> advanceToken <object_name> advanceChar <object_name> String <object_name> Token <object_name> NextChar <object_name> LineNumber |
|
A compilable version is found at
Sbfintoke.GCC
Another compilable version automatically generated for the Borland C++ IDE is
available in
Sbfintoke.BOR and
Sbfintoke.DEF.
A third compilable version automatically generated for the Microsoft
Visual C++ command-line compiler is available in
Sbfintoke.MIC and
Sbfintoke.MAK.
Please copy one of these compilable versions for your own use rather than
this annotated
verson. These versions may be copied for commercial purposes without charge.
All rights are reserved for this annotated html version as well as the original source document. Please refer back to this web page whenever you wish to look at them. Usage documentation in available at Sbfintoke_usage.html. All files mentioned above other than the source document were automatically generated by the Metamark translation system. |
| Constant Parameters: <directory where tcl.h is found> |
#include "c:\progra~1\tcl\include\tcl.h";
#include <string.h>
Support Functions:
static int
makeAssignable (Tcl_Obj ** ObP) {
Cause *ObP to point to an object whose ref count is one:
if ((Tcl_Obj*)NULL==*ObP) {
*ObP = Tcl_NewObj();
Tcl_IncrRefCount(*ObP);
} else if (Tcl_IsShared(*ObP)) {
Tcl_DecrRefCount(*ObP);
*ObP = Tcl_DuplicateObj(*ObP);
Tcl_IncrRefCount(*ObP);
}
return TCL_OK;
}
Class Properties:
static int BufSize = 4096; ??1
static int MaxTokeSize = 2; ??2
static int ObjectCount = 0; ??3
static char NoObjMsg [] =
"All input objects must be destroyed before class parameters may be altered.";
static char ClassMsg [] =
" open|parameters|close ...";
static char ObjectMsg [] =
" advanceChar|advanceToken|NextChar|Token|String|LineNumber ...";
static char ParameterMsg [] =
"usage: sbf::intoke parameters MAXBUFSIZE MAXTOKENSIZE";
static char JustOneEOLMsg [] =
"There can be just one token containing an end of line and it may contain nothing else.";
Object Properties:
typedef struct intoke { ??4
Tcl_Obj* String; ??5
Tcl_Obj* Token; ??6
int WantEOL; ??7
int LineNmbr; ??8
Values Controlled by buffer_* functions:
FILE* In; ??9
char * Buffer; ??10
char * CurBuffer; ??11
int CurBufSize; ??12
int LastBuffer; ??13
char * LastPosition;??14
int NumTokePatterns; ??15
char * TokePatterns; ??16
} intoke;
Forward Declarations:
static void buffer_allocate(intoke* S);
static void buffer_deallocate(intoke * S);
static void buffer_close(intoke * S);
Class Support Functions:
static void
class_initialize() { }
static int
class_setProperties(Tcl_Obj * RetVal,
int NewBufSize, int NewMaxTokeSize) {
if (ObjectCount>0) {
Tcl_SetStringObj(RetVal,NoObjMsg,-1);
return TCL_ERROR;
}
if (NewBufSize<=0 || NewMaxTokeSize<=0 || NewBufSize<NewMaxTokeSize ) {
Tcl_SetStringObj(RetVal,ParameterMsg,-1);
return TCL_ERROR;
}
BufSize = NewBufSize;
MaxTokeSize = NewMaxTokeSize;
return TCL_OK;
}
Object Support Functions:
intoke *
object_create(int NumTokePatterns) {
intoke * S = (intoke*)Tcl_Alloc(sizeof(intoke));
S->TokePatterns = Tcl_Alloc( NumTokePatterns*(MaxTokeSize+1) );
S->NumTokePatterns = NumTokePatterns;
S->LineNmbr = S->WantEOL = 0;
buffer_allocate(S);
S->Token = Tcl_NewObj();
Tcl_IncrRefCount(S->Token);
S->String = Tcl_NewObj();
Tcl_IncrRefCount(S->String);
return S;
}
static void
object_destruct(intoke * S) {
buffer_close(S);
Tcl_DecrRefCount(S->Token);
Tcl_DecrRefCount(S->String);
buffer_deallocate(S);
Tcl_Free(S->TokePatterns);
Tcl_Free((char*)S);
}
File Reading: ??17
static void
buffer_allocate(intoke* S) {
S->Buffer = Tcl_Alloc(BufSize+1);
S->In = (FILE*)NULL;
}
int
buffer_open(Tcl_Obj* RetVal, intoke* S, Tcl_Obj* FileName) {
S->In = fopen( Tcl_GetStringFromObj(FileName,(int*)NULL), "r" );
if (S->In==(FILE*)NULL) {
Tcl_AppendStringsToObj(RetVal,
"Cannot open ",
Tcl_GetStringFromObj(FileName,(int*)NULL),
(char*) NULL
);
return 0;
}
S->CurBufSize = fread(S->Buffer,1,BufSize,S->In);
S->CurBuffer = S->Buffer;
S->LastBuffer = S->CurBufSize < BufSize;
if (S->LastBuffer) { ??18
S->LastPosition = S->CurBuffer + S->CurBufSize - 1;
} else {
S->LastPosition = S->CurBuffer + S->CurBufSize - MaxTokeSize;
}
S->CurBuffer[S->CurBufSize] = (char)NULL;
return 1;
}
static void
buffer_deallocate(intoke * S) {
Tcl_Free(S->Buffer);
}
static void
buffer_close(intoke * S) {
if ( S->In != (FILE*)NULL ) {
fclose(S->In);
S->In = (FILE*)NULL;
}
}
static int
buffer_advanceTo(intoke* S, char * Index) { ??19
if (Index > S->LastPosition) { ??20
if (S->LastBuffer) { ??21
S->CurBuffer[0] = (char)NULL;
S->LastPosition = S->CurBuffer - 1;
return 0;
}
strncpy(S->Buffer,S->LastPosition+1,MaxTokeSize-1);
S->CurBufSize = ??22
MaxTokeSize - 1 +
fread( S->Buffer+MaxTokeSize-1,
1, BufSize-MaxTokeSize+1, S->In );
S->CurBuffer = S->Buffer;
S->LastBuffer = S->CurBufSize < BufSize;
if (S->LastBuffer) {
S->LastPosition = S->CurBuffer + S->CurBufSize - 1;
} else {
S->LastPosition = S->CurBuffer + S->CurBufSize - MaxTokeSize;
}
S->CurBuffer[S->CurBufSize] = (char)NULL;
} else {
S->CurBufSize -= Index - S->CurBuffer;
S->CurBuffer = Index;
}
return 1;
}
Object Commands:
int
Sbfintoke_advanceToken (
intoke* S,
Tcl_Interp* Intrp,
int Objc,
Tcl_Obj* CONST Objv[]
) {
int I, TokeLen, FoundEOL, Searching, BufferLeft;
char * TP;
char * Index;
char * TentativeIndex;
Tcl_Obj* RetVal = Tcl_GetObjResult(Intrp);
if (S->LineNmbr==0) {
S->LineNmbr= 1;
} else if (0==strcmp(Tcl_GetStringFromObj(S->Token,(int*)NULL),"\n")) {
S->LineNmbr += 1;
}
makeAssignable(&(S->String));
makeAssignable(&(S->Token));
Tcl_SetStringObj(S->String,"",-1);
Searching = 1; BufferLeft = S->CurBuffer[0]!=(char)NULL;
while (Searching && BufferLeft) {
Index = S->LastPosition+1; ??23
FoundEOL = 0;
Tcl_SetStringObj(S->Token,"",-1);
if ( ((char*)NULL != (TentativeIndex= strstr(S->CurBuffer,"\n")))
&&
(Index > TentativeIndex)
) {
Index = TentativeIndex;
Tcl_SetStringObj(S->Token,"\n",-1);
FoundEOL = 1;
}
for ( I= 0, TP= S->TokePatterns;
I < S->NumTokePatterns;
I+= 1, TP+= MaxTokeSize+1
) {
if ( ((char*)NULL!=(TentativeIndex= strstr(S->CurBuffer,TP)))
&&
(Index > TentativeIndex)
) {
Index = TentativeIndex;
Tcl_SetStringObj(S->Token,TP,-1);
FoundEOL = 0;
}
}
Tcl_AppendToObj(S->String,S->CurBuffer,Index-S->CurBuffer); ??24
if ( Index==S->LastPosition+1 ) { ??25
BufferLeft = buffer_advanceTo(S,Index);
} else if (FoundEOL && !S->WantEOL) { ??26
S->LineNmbr += 1;
Tcl_AppendToObj(S->String,"\n",1);
BufferLeft = buffer_advanceTo(S,Index+1);
} else {
Searching = 0; ??27
Tcl_GetStringFromObj(S->Token,&TokeLen);
BufferLeft = buffer_advanceTo(S,Index+TokeLen);
}
}
Tcl_SetIntObj(RetVal,!Searching);
return TCL_OK;
}
int
Sbfintoke_advanceChar (
intoke* S,
Tcl_Interp* Intrp,
int Objc,
Tcl_Obj* CONST Objv[]
) {
Tcl_Obj* RetVal = Tcl_GetObjResult(Intrp);
if(S->CurBuffer[0]==(char)NULL) {
Tcl_SetIntObj(RetVal,0);
return TCL_OK;
}
if (S->LineNmbr==0) {
S->LineNmbr= 1;
} else if (S->CurBuffer[0]=='\n') {
S->LineNmbr += 1;
}
buffer_advanceTo(S,S->CurBuffer+1);
Tcl_SetIntObj(RetVal,1);
return TCL_OK;
}
int
Sbfintoke_String (
intoke* S,
Tcl_Interp* Intrp,
int Objc,
Tcl_Obj* CONST Objv[]
) {
Tcl_SetObjResult(Intrp,S->String);
return TCL_OK;
}
int
Sbfintoke_Token (
intoke* S,
Tcl_Interp* Intrp,
int Objc,
Tcl_Obj* CONST Objv[]
) {
Tcl_SetObjResult(Intrp,S->Token);
return TCL_OK;
}
int
Sbfintoke_NextChar (
intoke* S,
Tcl_Interp* Intrp,
int Objc,
Tcl_Obj* CONST Objv[]
) {
Tcl_Obj* RetVal = Tcl_GetObjResult(Intrp);
Tcl_SetStringObj(RetVal,S->CurBuffer,1);
return TCL_OK;
}
int
Sbfintoke_LineNumber (
intoke* S,
Tcl_Interp* Intrp,
int Objc,
Tcl_Obj* CONST Objv[]
) {
Tcl_Obj* RetVal = Tcl_GetObjResult(Intrp);
Tcl_SetIntObj(RetVal,S->LineNmbr);
return TCL_OK;
}
int
Sbfintoke_ObjectCmd (
ClientData Cdat,
Tcl_Interp* Intrp,
int Objc,
Tcl_Obj* CONST Objv []
) {
Tcl_Obj* RetVal = Tcl_GetObjResult(Intrp);
intoke* S = (intoke*)Cdat;
static char * Table [] =
{ "advanceToken","advanceChar","String","Token","NextChar","LineNumber",(char*)NULL};
int Action;
enum Actions { ADVANCETOKEN,ADVANCECHAR,STRING,TOKEN,NEXTCHAR,LINENUMBER };
if (Objc<=1) {
Tcl_AppendStringsToObj( RetVal,
"usage: ",
Tcl_GetStringFromObj(Objv[0],(int*)NULL),
ObjectMsg,
(char*)NULL );
return TCL_ERROR;
}
if ( Tcl_GetIndexFromObj( Intrp, Objv[1], Table, "action", 0, &Action )
!= TCL_OK
) {
return TCL_ERROR;
}
switch ( (enum Actions)Action ) {
case ADVANCETOKEN: {
if (Objc!=2) {
Tcl_WrongNumArgs( Intrp, 2, Objv, "" );
return TCL_ERROR;
}
return Sbfintoke_advanceToken
( S, Intrp, Objc-2, (Tcl_Obj * CONST *)(Objv+2) );
}
case ADVANCECHAR: {
if (Objc!=2) {
Tcl_WrongNumArgs( Intrp, 2, Objv, "" );
return TCL_ERROR;
}
return Sbfintoke_advanceChar
( S, Intrp, Objc-2, (Tcl_Obj * CONST *)(Objv+2) );
}
case STRING: {
if (Objc!=2) {
Tcl_WrongNumArgs( Intrp, 2, Objv, "" );
return TCL_ERROR;
}
return Sbfintoke_String
( S, Intrp, Objc-2, (Tcl_Obj * CONST *)(Objv+2) );
}
case TOKEN: {
if (Objc!=2) {
Tcl_WrongNumArgs( Intrp, 2, Objv, "" );
return TCL_ERROR;
}
return Sbfintoke_Token
( S, Intrp, Objc-2, (Tcl_Obj * CONST *)(Objv+2) );
}
case NEXTCHAR: {
if (Objc!=2) {
Tcl_WrongNumArgs( Intrp, 2, Objv, "" );
return TCL_ERROR;
}
return Sbfintoke_NextChar
( S, Intrp, Objc-2, (Tcl_Obj * CONST *)(Objv+2) );
}
case LINENUMBER: {
if (Objc!=2) {
Tcl_WrongNumArgs( Intrp, 2, Objv, "" );
return TCL_ERROR;
}
return Sbfintoke_LineNumber
( S, Intrp, Objc-2, (Tcl_Obj * CONST *)(Objv+2) );
}
default: {
Tcl_AppendStringsToObj( RetVal,
"usage: ",
Tcl_GetStringFromObj(Objv[0],(int*)NULL),
ObjectMsg,
(char*)NULL );
return TCL_ERROR;
}
}
};
Class Commands:
int
Sbfintoke_open ( Tcl_Interp* Intrp,
int Objc,
Tcl_Obj* CONST Objv []
) {
int I,Len;
char * TP;
intoke* S = object_create(Objc-2);
Tcl_Obj* RetVal = Tcl_GetObjResult(Intrp);
Record Token Patterns:
S->WantEOL = 0;
for ( I=1,TP=S->TokePatterns; I<=S->NumTokePatterns; I+=1 ) { ??28
Tcl_GetStringFromObj(Objv[I+1],&Len);
if (Len>MaxTokeSize) {
Tcl_AppendStringsToObj(RetVal,
Tcl_GetStringFromObj(Objv[I+1],(int*)NULL),
" exceeds maximum token size.",
(char*)NULL
);
object_destruct(S);
return TCL_ERROR;
}
strcpy(TP,Tcl_GetStringFromObj(Objv[I+1],&Len));
TP[Len] = (char)NULL; ??29
if ( (char*)NULL != strstr(TP,"\n") ) { ??30
if ( !S->WantEOL && (0==strcmp("\n",TP)) ) {
S->WantEOL = 1;
} else {
Tcl_SetStringObj(RetVal, JustOneEOLMsg, -1 );
object_destruct(S);
return TCL_ERROR;
}
} else {
TP += MaxTokeSize+1;
}
}
if (S->WantEOL) S->NumTokePatterns -= 1; ??31
if (!buffer_open(RetVal,S,Objv[1]) ) {
object_destruct(S);
return TCL_ERROR;
}
ObjectCount += 1;
Tcl_CreateObjCommand(Intrp,
Tcl_GetStringFromObj(Objv[0],(int*)NULL),
Sbfintoke_ObjectCmd,
(ClientData)S,
(Tcl_CmdDeleteProc*)object_destruct
);
return TCL_OK;
}
int
Sbfintoke_close ( Tcl_Interp* Intrp,
int Objc,
Tcl_Obj* CONST Objv []
) {
Tcl_CmdInfo OutInfo;
Tcl_Obj* RetVal = Tcl_GetObjResult(Intrp);
if ( Tcl_GetCommandInfo( Intrp,
Tcl_GetStringFromObj(Objv[0],(int*)NULL),
&OutInfo
)
&& OutInfo.deleteProc==(Tcl_CmdDeleteProc*)object_destruct
) {
Tcl_DeleteCommand(Intrp,Tcl_GetStringFromObj(Objv[0],(int*)NULL));
ObjectCount -= 1;
return TCL_OK;
} else {
Tcl_AppendStringsToObj(RetVal,
Tcl_GetStringFromObj(Objv[0],(int*)NULL),
" is not the name of an intoke object.",
(char*)NULL
);
return TCL_ERROR;
}
}
int
Sbfintoke_parameters ( Tcl_Interp* Intrp,
int Objc,
Tcl_Obj* CONST Objv []
) {
int BS, TS;
Tcl_Obj* RetVal = Tcl_GetObjResult(Intrp);
if ( Objc!=3 ||
Tcl_GetIntFromObj(Intrp,Objv[1],&BS) ||
Tcl_GetIntFromObj(Intrp,Objv[3],&TS)
) {
Tcl_SetStringObj(RetVal,ParameterMsg,-1);
return TCL_ERROR;
}
return class_setProperties(RetVal,BS,TS);
}
int
Sbfintoke_ClassCmd ( ClientData Cdat,
Tcl_Interp* Intrp,
int Objc,
Tcl_Obj* CONST Objv []
) {
Tcl_Obj* RetVal = Tcl_GetObjResult(Intrp);
static char * Table [] =
{ "open","close","parameters",(char*)NULL};
int Action;
enum Actions { OPEN,CLOSE,PARAMETERS };
if (Objc<=1) {
Tcl_AppendStringsToObj( RetVal,
"usage: ",
Tcl_GetStringFromObj(Objv[0],(int*)NULL),
ClassMsg,
(char*)NULL );
return TCL_ERROR;
}
if ( Tcl_GetIndexFromObj( Intrp,Objv[1],Table,"action",0,&Action )
!= TCL_OK
) {
return TCL_ERROR;
}
switch ( (enum Actions)Action ) {
case OPEN: {
if (Objc<5) {
Tcl_WrongNumArgs( Intrp, 2, Objv, "OBJECTNAME FILENAME TOKENs" );
return TCL_ERROR;
}
return Sbfintoke_open
( Intrp, Objc-2, (Tcl_Obj * CONST *)(Objv+2) );
}
case CLOSE: {
if (Objc!=3) {
Tcl_WrongNumArgs( Intrp, 2, Objv, "OBJECTNAME" );
return TCL_ERROR;
}
return Sbfintoke_close
( Intrp, Objc-2, (Tcl_Obj * CONST *)(Objv+2) );
}
case PARAMETERS: {
if (Objc!=4) {
Tcl_WrongNumArgs( Intrp, 2, Objv, "BUFFERSIZE MAXNUMBERTOKENS" );
return TCL_ERROR;
}
return Sbfintoke_parameters
( Intrp, Objc-2, (Tcl_Obj * CONST *)(Objv+2) );
}
default: {
Tcl_AppendStringsToObj( RetVal,
"usage: ",
Tcl_GetStringFromObj(Objv[0], (int*)NULL),
ClassMsg,
(char*)NULL );
return TCL_ERROR;
}
}
};
int
Sbfintoke_Init(Tcl_Interp* Intrp) {
class_initialize();
Tcl_Eval( Intrp, "namespace eval sbf { }" );
Tcl_CreateObjCommand( Intrp,
"sbf::intoke",
Sbfintoke_ClassCmd,
(ClientData)NULL,
(Tcl_CmdDeleteProc*)NULL
);
return TCL_OK;
}