summaryrefslogtreecommitdiffstats
path: root/mac/tclMacOSA.c
diff options
context:
space:
mode:
authordas <das>2002-10-09 11:54:02 (GMT)
committerdas <das>2002-10-09 11:54:02 (GMT)
commit5451c5041622ded8cdbc5b63e4b5a1ed14a31de6 (patch)
treefcd14750217863bb89fa52d2ccf756a933b9a514 /mac/tclMacOSA.c
parent22cf6ccfd778871f2ac0415b10e303a0af281e06 (diff)
downloadtcl-5451c5041622ded8cdbc5b63e4b5a1ed14a31de6.zip
tcl-5451c5041622ded8cdbc5b63e4b5a1ed14a31de6.tar.gz
tcl-5451c5041622ded8cdbc5b63e4b5a1ed14a31de6.tar.bz2
* generic/tclInt.decls: made TclSetPreInitScript() declaration
generic as it is used on mac & aqua as well. * generic/tclIntDecls.h: * generic/tclStubInit.c: regen. * generic/tclCompile.h: added prototype for TclCompileVariableCmd. * mac/tclMacPort.h: removed incorrect <fcntl.h> definitions and obsolete <stat.h> definitions. * mac/tclMacChan.c: removed obsolete GetOpenMode() and replaced associated constants with the <fcntl.h> analogues (they existing defs were inconsistent with <fcntl.h> which was causing havoc when Tcl_GetOpenMode was used instead of private GetOpenMode). * mac/tclMacFCmd.c: removed GenerateUniqueName(), use equivalent (and identiaclly named) routine from MoreFiles instead. * mac/tclMacLoad.c: CONSTification, fixes to Vince's last changes. * mac/tclMacFile.c: * mac/tclMacTest.c: * mac/tclMacUnix.c: CONSTification. * mac/tclMacOSA.c: CONSTificcation, sprintf fixes, UH 3.4.x changes; fix for missing autoname token from TclOSACompileCmd. (bdesgraupes) * mac/AppleScript.html(AppleScript delete): doc fix. (bdesgraupes) * mac/tcltkMacBuildSupport.sea.hqx: updated MoreFiles to 1.5.3, updated build instructions for 8.4. * mac/tclMacProjects.sea.hqx: rebuilt archive.
Diffstat (limited to 'mac/tclMacOSA.c')
-rw-r--r--mac/tclMacOSA.c127
1 files changed, 67 insertions, 60 deletions
diff --git a/mac/tclMacOSA.c b/mac/tclMacOSA.c
index 67275c6..0a38396 100644
--- a/mac/tclMacOSA.c
+++ b/mac/tclMacOSA.c
@@ -12,7 +12,7 @@
* See the file "License Terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclMacOSA.c,v 1.9 2002/04/08 09:02:48 das Exp $
+ * RCS: @(#) $Id: tclMacOSA.c,v 1.10 2002/10/09 11:54:30 das Exp $
*/
#define MAC_TCL
@@ -78,74 +78,74 @@ typedef struct tclOSAComponent {
static pascal OSErr TclOSAActiveProc _ANSI_ARGS_((long refCon));
static int TclOSACompileCmd _ANSI_ARGS_((Tcl_Interp *interp,
tclOSAComponent *OSAComponent, int argc,
- char **argv));
+ CONST char **argv));
static int tclOSADecompileCmd _ANSI_ARGS_((Tcl_Interp * Interp,
tclOSAComponent *OSAComponent, int argc,
- char **argv));
+ CONST char **argv));
static int tclOSADeleteCmd _ANSI_ARGS_((Tcl_Interp *interp,
tclOSAComponent *OSAComponent, int argc,
- char **argv));
+ CONST char **argv));
static int tclOSAExecuteCmd _ANSI_ARGS_((Tcl_Interp *interp,
tclOSAComponent *OSAComponent, int argc,
- char **argv));
+ CONST char **argv));
static int tclOSAInfoCmd _ANSI_ARGS_((Tcl_Interp *interp,
tclOSAComponent *OSAComponent, int argc,
- char **argv));
+ CONST char **argv));
static int tclOSALoadCmd _ANSI_ARGS_((Tcl_Interp *interp,
tclOSAComponent *OSAComponent, int argc,
- char **argv));
+ CONST char **argv));
static int tclOSARunCmd _ANSI_ARGS_((Tcl_Interp *interp,
tclOSAComponent *OSAComponent, int argc,
- char **argv));
+ CONST char **argv));
static int tclOSAStoreCmd _ANSI_ARGS_((Tcl_Interp *interp,
- tclOSAComponent *OSAComponent, int argc, char
- **argv));
+ tclOSAComponent *OSAComponent, int argc,
+ CONST char **argv));
static void GetRawDataFromDescriptor _ANSI_ARGS_((AEDesc *theDesc,
Ptr destPtr, Size destMaxSize, Size *actSize));
static OSErr GetCStringFromDescriptor _ANSI_ARGS_((
AEDesc *sourceDesc, char *resultStr,
Size resultMaxSize,Size *resultSize));
static int Tcl_OSAComponentCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static void getSortedHashKeys _ANSI_ARGS_((Tcl_HashTable *theTable,
- char *pattern, Tcl_DString *theResult));
+ CONST char *pattern, Tcl_DString *theResult));
static int ASCIICompareProc _ANSI_ARGS_((const void *first,
const void *second));
static int Tcl_OSACmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static void tclOSAClose _ANSI_ARGS_((ClientData clientData));
-static void tclOSACloseAll _ANSI_ARGS_((ClientData clientData));
+/*static void tclOSACloseAll _ANSI_ARGS_((ClientData clientData));*/
static tclOSAComponent *tclOSAMakeNewComponent _ANSI_ARGS_((Tcl_Interp *interp,
char *cmdName, char *languageName,
OSType scriptSubtype, long componentFlags));
-static int prepareScriptData _ANSI_ARGS_((int argc, char **argv,
+static int prepareScriptData _ANSI_ARGS_((int argc, CONST char **argv,
Tcl_DString *scrptData ,AEDesc *scrptDesc));
static void tclOSAResultFromID _ANSI_ARGS_((Tcl_Interp *interp,
ComponentInstance theComponent, OSAID resultID));
static void tclOSAASError _ANSI_ARGS_((Tcl_Interp * interp,
ComponentInstance theComponent, char *scriptSource));
static int tclOSAGetContextID _ANSI_ARGS_((tclOSAComponent *theComponent,
- char *contextName, OSAID *theContext));
+ CONST char *contextName, OSAID *theContext));
static void tclOSAAddContext _ANSI_ARGS_((tclOSAComponent *theComponent,
char *contextName, const OSAID theContext));
static int tclOSAMakeContext _ANSI_ARGS_((tclOSAComponent *theComponent,
- char *contextName, OSAID *theContext));
+ CONST char *contextName, OSAID *theContext));
static int tclOSADeleteContext _ANSI_ARGS_((tclOSAComponent *theComponent,
- char *contextName));
+ CONST char *contextName));
static int tclOSALoad _ANSI_ARGS_((Tcl_Interp *interp,
- tclOSAComponent *theComponent, char *resourceName,
- int resourceNumber, char *fileName,OSAID *resultID));
+ tclOSAComponent *theComponent, CONST char *resourceName,
+ int resourceNumber, CONST char *fileName,OSAID *resultID));
static int tclOSAStore _ANSI_ARGS_((Tcl_Interp *interp,
- tclOSAComponent *theComponent, char *resourceName,
- int resourceNumber, char *fileName,char *scriptName));
+ tclOSAComponent *theComponent, CONST char *resourceName,
+ int resourceNumber, CONST char *scriptName, CONST char *fileName));
static int tclOSAAddScript _ANSI_ARGS_((tclOSAComponent *theComponent,
char *scriptName, long modeFlags, OSAID scriptID));
static int tclOSAGetScriptID _ANSI_ARGS_((tclOSAComponent *theComponent,
- char *scriptName, OSAID *scriptID));
+ CONST char *scriptName, OSAID *scriptID));
static tclOSAScript * tclOSAGetScript _ANSI_ARGS_((tclOSAComponent *theComponent,
- char *scriptName));
+ CONST char *scriptName));
static int tclOSADeleteScript _ANSI_ARGS_((tclOSAComponent *theComponent,
- char *scriptName,char *errMsg));
+ CONST char *scriptName,char *errMsg));
/*
* "export" is a MetroWerks specific pragma. It flags the linker that
@@ -357,7 +357,7 @@ Tcl_OSACmd(
ClientData clientData,
Tcl_Interp *interp,
int argc,
- char **argv)
+ CONST char **argv)
{
static unsigned short componentCmdIndex = 0;
char autoName[32];
@@ -581,7 +581,7 @@ Tcl_OSAComponentCmd(
ClientData clientData,
Tcl_Interp *interp,
int argc,
- char **argv)
+ CONST char **argv)
{
int length;
char c;
@@ -648,7 +648,7 @@ TclOSACompileCmd(
Tcl_Interp *interp,
tclOSAComponent *OSAComponent,
int argc,
- char **argv)
+ CONST char **argv)
{
int tclError = TCL_OK;
int augment = 1;
@@ -736,7 +736,9 @@ TclOSACompileCmd(
}
makeContext = 1;
} else if (c == 'n' && strcmp(argv[0] + 1, "name") == 0) {
- resultName = argv[1];
+ strncpy(autoName, argv[1], 15);
+ autoName[15] = '\0';
+ resultName = autoName;
} else if (c == 'p' && strcmp(argv[0] + 1,"parent") == 0) {
/*
* Since this implies we are compiling into a context,
@@ -790,10 +792,8 @@ TclOSACompileCmd(
makeNewContext = true;
} else if (tclOSAGetContextID(OSAComponent,
resultName, &resultID) == TCL_OK) {
- makeNewContext = false;
} else {
makeNewContext = true;
- resultID = kOSANullScript;
}
/*
@@ -802,6 +802,8 @@ TclOSACompileCmd(
if (augment && !makeNewContext) {
modeFlags |= kOSAModeAugmentContext;
}
+ } else if (resultName == NULL) {
+ resultName = autoName; /* Auto name the script */
}
/*
@@ -876,7 +878,7 @@ TclOSACompileCmd(
Tcl_DStringValue(&scrptData));
tclError = TCL_ERROR;
} else if (osaErr != noErr) {
- sprintf(buffer, "Error #%-6d compiling script", osaErr);
+ sprintf(buffer, "Error #%-6ld compiling script", osaErr);
Tcl_AppendResult(interp, buffer, (char *) NULL);
tclError = TCL_ERROR;
}
@@ -909,7 +911,7 @@ tclOSADecompileCmd(
Tcl_Interp * interp,
tclOSAComponent *OSAComponent,
int argc,
- char **argv)
+ CONST char **argv)
{
AEDesc resultingSourceData = { typeChar, NULL };
OSAID scriptID;
@@ -986,7 +988,7 @@ tclOSADeleteCmd(
Tcl_Interp *interp,
tclOSAComponent *OSAComponent,
int argc,
- char **argv)
+ CONST char **argv)
{
char c,*errMsg = NULL;
int length;
@@ -1049,7 +1051,7 @@ tclOSAExecuteCmd(
Tcl_Interp *interp,
tclOSAComponent *OSAComponent,
int argc,
- char **argv)
+ CONST char **argv)
{
int tclError = TCL_OK, resID = 128;
char c,buffer[32],
@@ -1178,7 +1180,7 @@ tclOSAExecuteCmd(
Tcl_DStringValue(&scrptData));
tclError = TCL_ERROR;
} else if (osaErr != noErr) {
- sprintf(buffer, "Error #%-6d compiling script", osaErr);
+ sprintf(buffer, "Error #%-6ld compiling script", osaErr);
Tcl_AppendResult(interp, buffer, (char *) NULL);
tclError = TCL_ERROR;
} else {
@@ -1213,7 +1215,7 @@ tclOSAInfoCmd(
Tcl_Interp *interp,
tclOSAComponent *OSAComponent,
int argc,
- char **argv)
+ CONST char **argv)
{
char c;
int length;
@@ -1293,11 +1295,12 @@ tclOSALoadCmd(
Tcl_Interp *interp,
tclOSAComponent *OSAComponent,
int argc,
- char **argv)
+ CONST char **argv)
{
int tclError = TCL_OK, resID = 128;
char c, autoName[24],
- *contextName = NULL, *scriptName = NULL, *resName = NULL;
+ *contextName = NULL, *scriptName = NULL;
+ CONST char *resName = NULL;
Boolean makeNewContext = false, makeContext = false;
AEDesc scrptDesc = { typeNull, NULL };
long modeFlags = kOSAModeCanInteract;
@@ -1431,7 +1434,7 @@ tclOSARunCmd(
Tcl_Interp *interp,
tclOSAComponent *OSAComponent,
int argc,
- char **argv)
+ CONST char **argv)
{
int tclError = TCL_OK,
resID = 128;
@@ -1445,7 +1448,7 @@ tclOSARunCmd(
parentID = kOSANullScript;
OSAError osaErr = noErr;
OSErr sysErr = noErr;
- char *componentName = argv[0];
+ CONST char *componentName = argv[0];
OSAID scriptID;
if (argc == 2) {
@@ -1567,10 +1570,11 @@ tclOSAStoreCmd(
Tcl_Interp *interp,
tclOSAComponent *OSAComponent,
int argc,
- char **argv)
+ CONST char **argv)
{
int tclError = TCL_OK, resID = 128;
- char c, *contextName = NULL, *scriptName = NULL, *resName = NULL;
+ char c, *contextName = NULL, *scriptName = NULL;
+ CONST char *resName = NULL;
Boolean makeNewContext = false, makeContext = false;
AEDesc scrptDesc = { typeNull, NULL };
long modeFlags = kOSAModeCanInteract;
@@ -1741,7 +1745,7 @@ tclOSAMakeNewComponent(
Tcl_InitHashTable(&newComponent->scriptTable, TCL_STRING_KEYS);
if (tclOSAMakeContext(newComponent, global, &globalContext) != TCL_OK) {
- sprintf(buffer, "%-6.6d", globalContext);
+ sprintf(buffer, "%-6.6ld", globalContext);
Tcl_AppendResult(interp, "Error ", buffer, " making ", global,
" context.", (char *) NULL);
goto CleanUp;
@@ -1780,7 +1784,7 @@ tclOSAMakeNewComponent(
/* TODO -- clean up here... */
}
- myActiveProcUPP = NewOSAActiveProc(TclOSAActiveProc);
+ myActiveProcUPP = NewOSAActiveUPP(TclOSAActiveProc);
OSASetActiveProc(newComponent->theComponent,
myActiveProcUPP, (long) newComponent);
return newComponent;
@@ -1886,7 +1890,7 @@ tclOSAClose(
static int
tclOSAGetContextID(
tclOSAComponent *theComponent,
- char *contextName,
+ CONST char *contextName,
OSAID *theContext)
{
Tcl_HashEntry *hashEntry;
@@ -1968,7 +1972,7 @@ tclOSAAddContext(
static int
tclOSADeleteContext(
tclOSAComponent *theComponent,
- char *contextName)
+ CONST char *contextName)
{
Tcl_HashEntry *hashEntry;
tclOSAContext *contextStruct;
@@ -2010,7 +2014,7 @@ tclOSADeleteContext(
static int
tclOSAMakeContext(
tclOSAComponent *theComponent,
- char *contextName,
+ CONST char *contextName,
OSAID *theContext)
{
AEDesc contextNameDesc = {typeNull, NULL};
@@ -2023,7 +2027,10 @@ tclOSAMakeContext(
AEDisposeDesc(&contextNameDesc);
if (osaErr == noErr) {
- tclOSAAddContext(theComponent, contextName, *theContext);
+ char name[24];
+ strncpy(name, contextName, 23);
+ name[23] = '\0';
+ tclOSAAddContext(theComponent, name, *theContext);
} else {
*theContext = (OSAID) osaErr;
return TCL_ERROR;
@@ -2056,10 +2063,10 @@ int
tclOSAStore(
Tcl_Interp *interp,
tclOSAComponent *theComponent,
- char *resourceName,
+ CONST char *resourceName,
int resourceNumber,
- char *scriptName,
- char *fileName)
+ CONST char *scriptName,
+ CONST char *fileName)
{
Handle resHandle;
Str255 rezName;
@@ -2276,9 +2283,9 @@ int
tclOSALoad(
Tcl_Interp *interp,
tclOSAComponent *theComponent,
- char *resourceName,
+ CONST char *resourceName,
int resourceNumber,
- char *fileName,
+ CONST char *fileName,
OSAID *resultID)
{
Handle sourceData;
@@ -2397,7 +2404,7 @@ tclOSALoad(
static int
tclOSAGetScriptID(
tclOSAComponent *theComponent,
- char *scriptName,
+ CONST char *scriptName,
OSAID *scriptID)
{
tclOSAScript *theScript;
@@ -2484,7 +2491,7 @@ tclOSAAddScript(
static tclOSAScript *
tclOSAGetScript(
tclOSAComponent *theComponent,
- char *scriptName)
+ CONST char *scriptName)
{
Tcl_HashEntry *hashEntry;
@@ -2518,7 +2525,7 @@ tclOSAGetScript(
static int
tclOSADeleteScript(
tclOSAComponent *theComponent,
- char *scriptName,
+ CONST char *scriptName,
char *errMsg)
{
Tcl_HashEntry *hashEntry;
@@ -2565,7 +2572,7 @@ TclOSAActiveProc(
tclOSAComponent *theComponent = (tclOSAComponent *) refCon;
Tcl_DoOneEvent(TCL_DONT_WAIT);
- CallOSAActiveProc(theComponent->defActiveProc, theComponent->defRefCon);
+ InvokeOSAActiveUPP(theComponent->defRefCon, theComponent->defActiveProc);
return noErr;
}
@@ -2621,7 +2628,7 @@ ASCIICompareProc(const void *first,const void *second)
static void
getSortedHashKeys(
Tcl_HashTable *theTable,
- char *pattern,
+ CONST char *pattern,
Tcl_DString *theResult)
{
Tcl_HashSearch search;
@@ -2689,7 +2696,7 @@ getSortedHashKeys(
static int
prepareScriptData(
int argc,
- char **argv,
+ CONST char **argv,
Tcl_DString *scrptData,
AEDesc *scrptDesc)
{