Attachment "tcl8.4-mac.patch" to
ticket [607005ffff]
added by
das
2002-10-09 19:03:16.
Index: generic/tclCompile.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.h,v
retrieving revision 1.32
diff -u -3 -r1.32 tclCompile.h
--- generic/tclCompile.h 24 Sep 2002 12:53:33 -0000 1.32
+++ generic/tclCompile.h 9 Oct 2002 07:43:19 -0000
@@ -819,6 +819,8 @@
EXTERN void TclVerifyLocalLiteralTable _ANSI_ARGS_((
CompileEnv *envPtr));
#endif
+EXTERN int TclCompileVariableCmd _ANSI_ARGS_((
+ Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr));
/*
*----------------------------------------------------------------
Index: generic/tclInt.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.decls,v
retrieving revision 1.55
diff -u -3 -r1.55 tclInt.decls
--- generic/tclInt.decls 6 Aug 2002 01:49:27 -0000 1.55
+++ generic/tclInt.decls 9 Oct 2002 07:43:20 -0000
@@ -399,7 +399,7 @@
# Tcl_Obj * TclSetIndexedScalar(Tcl_Interp *interp, int localIndex,
# Tcl_Obj *objPtr, int flags)
#}
-declare 101 {unix win} {
+declare 101 generic {
char * TclSetPreInitScript(char *string)
}
declare 102 generic {
Index: generic/tclIntDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIntDecls.h,v
retrieving revision 1.45
diff -u -3 -r1.45 tclIntDecls.h
--- generic/tclIntDecls.h 5 Aug 2002 03:24:41 -0000 1.45
+++ generic/tclIntDecls.h 9 Oct 2002 07:43:21 -0000
@@ -285,14 +285,8 @@
EXTERN int TclServiceIdle _ANSI_ARGS_((void));
/* Slot 99 is reserved */
/* Slot 100 is reserved */
-#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
/* 101 */
EXTERN char * TclSetPreInitScript _ANSI_ARGS_((char * string));
-#endif /* UNIX */
-#ifdef __WIN32__
-/* 101 */
-EXTERN char * TclSetPreInitScript _ANSI_ARGS_((char * string));
-#endif /* __WIN32__ */
/* 102 */
EXTERN void TclSetupEnv _ANSI_ARGS_((Tcl_Interp * interp));
/* 103 */
@@ -1045,18 +1039,10 @@
#endif
/* Slot 99 is reserved */
/* Slot 100 is reserved */
-#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
#ifndef TclSetPreInitScript
#define TclSetPreInitScript \
(tclIntStubsPtr->tclSetPreInitScript) /* 101 */
#endif
-#endif /* UNIX */
-#ifdef __WIN32__
-#ifndef TclSetPreInitScript
-#define TclSetPreInitScript \
- (tclIntStubsPtr->tclSetPreInitScript) /* 101 */
-#endif
-#endif /* __WIN32__ */
#ifndef TclSetupEnv
#define TclSetupEnv \
(tclIntStubsPtr->tclSetupEnv) /* 102 */
Index: generic/tclStubInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStubInit.c,v
retrieving revision 1.75
diff -u -3 -r1.75 tclStubInit.c
--- generic/tclStubInit.c 31 Aug 2002 06:09:45 -0000 1.75
+++ generic/tclStubInit.c 9 Oct 2002 07:43:22 -0000
@@ -164,15 +164,7 @@
TclServiceIdle, /* 98 */
NULL, /* 99 */
NULL, /* 100 */
-#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
TclSetPreInitScript, /* 101 */
-#endif /* UNIX */
-#ifdef __WIN32__
- TclSetPreInitScript, /* 101 */
-#endif /* __WIN32__ */
-#ifdef MAC_TCL
- NULL, /* 101 */
-#endif /* MAC_TCL */
TclSetupEnv, /* 102 */
TclSockGetPort, /* 103 */
#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
Index: mac/AppleScript.html
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/AppleScript.html,v
retrieving revision 1.1
diff -u -3 -r1.1 AppleScript.html
--- mac/AppleScript.html 26 Mar 1998 14:55:45 -0000 1.1
+++ mac/AppleScript.html 9 Oct 2002 07:43:24 -0000
@@ -23,7 +23,7 @@
<BR>
<B>AppleScript <A NAME="decompile">decompile</A></B> <I>scriptName</I>
<BR>
-<B>AppleScript delete </B><I>scriptName</I>
+<B>AppleScript <A NAME="delete">delete</A> </B><I>what scriptName</I>
<BR>
<B>AppleScript <A NAME="execute">execute</A> </B><I>?flags value?</I> <I>scriptData1
?scriptData2 ...?</I>
@@ -153,11 +153,25 @@
and returns the source code.
<P>
<DT>
- <I>AppleScript</I> <B>delete </B><I>scriptName</I>
+ <I>AppleScript</I> <B><A NAME="delete">delete</A> </B><I>what scriptName</I>
<BR>
<DD>
- This deletes the script data compiled into the script scriptName,
- and frees up all the resources associated with it.
+ This deletes contexts or script data. The allowed values for "what" are:
+ <P>
+ <DL>
+ <DT>
+ <P>
+ <B>context</B>
+ <DD>
+ This deletes the context scriptName,
+ and frees up all the resources associated with it.
+ <DT>
+ <P>
+ <B>script</B>
+ <DD>
+ This deletes the script data compiled into the script scriptName,
+ and frees up all the resources associated with it.
+ </DL>
<P>
<DT>
<I>AppleScript</I> <B><A NAME="execute">execute</A> </B><I>?flags value?</I> <I>scriptData1
Index: mac/tclMacChan.c
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/tclMacChan.c,v
retrieving revision 1.17
diff -u -3 -r1.17 tclMacChan.c
--- mac/tclMacChan.c 8 Jul 2002 10:08:58 -0000 1.17
+++ mac/tclMacChan.c 9 Oct 2002 07:43:25 -0000
@@ -33,24 +33,6 @@
#endif
/*
- * The following are flags returned by GetOpenMode. They
- * are or'd together to determine how opening and handling
- * a file should occur.
- */
-
-#define TCL_RDONLY (1<<0)
-#define TCL_WRONLY (1<<1)
-#define TCL_RDWR (1<<2)
-#define TCL_CREAT (1<<3)
-#define TCL_TRUNC (1<<4)
-#define TCL_APPEND (1<<5)
-#define TCL_ALWAYS_APPEND (1<<6)
-#define TCL_EXCL (1<<7)
-#define TCL_NOCTTY (1<<8)
-#define TCL_NONBLOCK (1<<9)
-#define TCL_RW_MODES (TCL_RDONLY|TCL_WRONLY|TCL_RDWR)
-
-/*
* This structure describes per-instance state of a
* macintosh file based channel.
*/
@@ -119,8 +101,6 @@
long offset, int mode, int *errorCode));
static void FileSetupProc _ANSI_ARGS_((ClientData clientData,
int flags));
-static int GetOpenMode _ANSI_ARGS_((Tcl_Interp *interp,
- CONST char *string));
static Tcl_Channel OpenFileChannel _ANSI_ARGS_((CONST char *fileName,
int mode, int permissions, int *errorCodePtr));
static int StdIOBlockMode _ANSI_ARGS_((ClientData instanceData,
@@ -827,12 +807,12 @@
* Windows and UNIX and the feature is used by Tcl.
*/
- switch (mode & (TCL_RDONLY | TCL_WRONLY | TCL_RDWR)) {
- case TCL_RDWR:
+ switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
+ case O_RDWR:
channelPermissions = (TCL_READABLE | TCL_WRITABLE);
macPermision = fsRdWrShPerm;
break;
- case TCL_WRONLY:
+ case O_WRONLY:
/*
* Mac's fsRdPerm permission actually defaults to fsRdWrPerm because
* the Mac OS doesn't realy support write only access. We explicitly
@@ -842,7 +822,7 @@
channelPermissions = TCL_WRITABLE;
macPermision = fsRdWrShPerm;
break;
- case TCL_RDONLY:
+ case O_RDONLY:
default:
channelPermissions = TCL_READABLE;
macPermision = fsRdPerm;
@@ -856,14 +836,14 @@
return NULL;
}
- if ((err == fnfErr) && (mode & TCL_CREAT)) {
+ if ((err == fnfErr) && (mode & O_CREAT)) {
err = HCreate(fileSpec.vRefNum, fileSpec.parID, fileSpec.name, TCL_FILE_CREATOR, 'TEXT');
if (err != noErr) {
*errorCodePtr = errno = TclMacOSErrorToPosixError(err);
Tcl_SetErrno(errno);
return NULL;
}
- } else if ((mode & TCL_CREAT) && (mode & TCL_EXCL)) {
+ } else if ((mode & O_CREAT) && (mode & O_EXCL)) {
*errorCodePtr = errno = EEXIST;
Tcl_SetErrno(errno);
return NULL;
@@ -876,7 +856,7 @@
return NULL;
}
- if (mode & TCL_TRUNC) {
+ if (mode & O_TRUNC) {
SetEOF(fileRef, 0);
}
@@ -897,13 +877,13 @@
fileState->fileRef = fileRef;
fileState->pending = 0;
fileState->watchMask = 0;
- if (mode & TCL_ALWAYS_APPEND) {
+ if (mode & O_APPEND) {
fileState->appendMode = true;
} else {
fileState->appendMode = false;
}
- if ((mode & TCL_ALWAYS_APPEND) || (mode & TCL_APPEND)) {
+ if ((mode & O_APPEND) || (mode & O_APPEND)) {
if (Tcl_Seek(chan, 0, SEEK_END) < 0) {
*errorCodePtr = errno = EFAULT;
Tcl_SetErrno(errno);
@@ -1243,146 +1223,4 @@
}
}
}
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * GetOpenMode --
- *
- * Description:
- * Computes a POSIX mode mask from a given string and also sets
- * a flag to indicate whether the caller should seek to EOF during
- * opening of the file.
- *
- * Results:
- * On success, returns mode to pass to "open". If an error occurs, the
- * returns -1 and if interp is not NULL, sets the interp's result to an
- * error message.
- *
- * Side effects:
- * Sets the integer referenced by seekFlagPtr to 1 if the caller
- * should seek to EOF during opening the file.
- *
- * Special note:
- * This code is based on a prototype implementation contributed
- * by Mark Diekhans.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-GetOpenMode(
- Tcl_Interp *interp, /* Interpreter to use for error
- * reporting - may be NULL. */
- CONST char *string) /* Mode string, e.g. "r+" or
- * "RDONLY CREAT". */
-{
- int mode, modeArgc, c, i, gotRW;
- CONST char **modeArgv, *flag;
-
- /*
- * Check for the simpler fopen-like access modes (e.g. "r"). They
- * are distinguished from the POSIX access modes by the presence
- * of a lower-case first letter.
- */
-
- mode = 0;
- /*
- * Guard against international characters before using byte oriented
- * routines.
- */
-
- if (!(string[0] & 0x80)
- && islower(UCHAR(string[0]))) { /* INTL: ISO only. */
- switch (string[0]) {
- case 'r':
- mode = TCL_RDONLY;
- break;
- case 'w':
- mode = TCL_WRONLY|TCL_CREAT|TCL_TRUNC;
- break;
- case 'a':
- mode = TCL_WRONLY|TCL_CREAT|TCL_APPEND;
- break;
- default:
- error:
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp,
- "illegal access mode \"", string, "\"",
- (char *) NULL);
- }
- return -1;
- }
- if (string[1] == '+') {
- mode &= ~(TCL_RDONLY|TCL_WRONLY);
- mode |= TCL_RDWR;
- if (string[2] != 0) {
- goto error;
- }
- } else if (string[1] != 0) {
- goto error;
- }
- return mode;
- }
-
- /*
- * The access modes are specified using a list of POSIX modes
- * such as TCL_CREAT.
- */
-
- if (Tcl_SplitList(interp, string, &modeArgc, &modeArgv) != TCL_OK) {
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AddErrorInfo(interp,
- "\n while processing open access modes \"");
- Tcl_AddErrorInfo(interp, string);
- Tcl_AddErrorInfo(interp, "\"");
- }
- return -1;
- }
-
- gotRW = 0;
- for (i = 0; i < modeArgc; i++) {
- flag = modeArgv[i];
- c = flag[0];
- if ((c == 'R') && (strcmp(flag, "RDONLY") == 0)) {
- mode = (mode & ~TCL_RW_MODES) | TCL_RDONLY;
- gotRW = 1;
- } else if ((c == 'W') && (strcmp(flag, "WRONLY") == 0)) {
- mode = (mode & ~TCL_RW_MODES) | TCL_WRONLY;
- gotRW = 1;
- } else if ((c == 'R') && (strcmp(flag, "RDWR") == 0)) {
- mode = (mode & ~TCL_RW_MODES) | TCL_RDWR;
- gotRW = 1;
- } else if ((c == 'A') && (strcmp(flag, "APPEND") == 0)) {
- mode |= TCL_ALWAYS_APPEND;
- } else if ((c == 'C') && (strcmp(flag, "CREAT") == 0)) {
- mode |= TCL_CREAT;
- } else if ((c == 'E') && (strcmp(flag, "EXCL") == 0)) {
- mode |= TCL_EXCL;
- } else if ((c == 'N') && (strcmp(flag, "NOCTTY") == 0)) {
- mode |= TCL_NOCTTY;
- } else if ((c == 'N') && (strcmp(flag, "NONBLOCK") == 0)) {
- mode |= TCL_NONBLOCK;
- } else if ((c == 'T') && (strcmp(flag, "TRUNC") == 0)) {
- mode |= TCL_TRUNC;
- } else {
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "invalid access mode \"", flag,
- "\": must be RDONLY, WRONLY, RDWR, APPEND, CREAT",
- " EXCL, NOCTTY, NONBLOCK, or TRUNC", (char *) NULL);
- }
- ckfree((char *) modeArgv);
- return -1;
- }
- }
- ckfree((char *) modeArgv);
- if (!gotRW) {
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "access mode must include either",
- " RDONLY, WRONLY, or RDWR", (char *) NULL);
- }
- return -1;
- }
- return mode;
}
Index: mac/tclMacFCmd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/tclMacFCmd.c,v
retrieving revision 1.17
diff -u -3 -r1.17 tclMacFCmd.c
--- mac/tclMacFCmd.c 19 Apr 2002 14:18:45 -0000 1.17
+++ mac/tclMacFCmd.c 9 Oct 2002 07:43:26 -0000
@@ -65,6 +65,11 @@
{GetFileReadOnly, SetFileReadOnly},
{GetFileFinderAttributes, SetFileFinderAttributes}};
+/*
+ * File specific static data
+ */
+
+static long startSeed = 248923489;
/*
* Prototypes for procedure only used in this file
@@ -87,8 +92,6 @@
CONST char *dst));
OSErr FSpGetFLockCompat _ANSI_ARGS_((const FSSpec *specPtr,
Boolean *lockedPtr));
-static OSErr GenerateUniqueName _ANSI_ARGS_((short vRefNum,
- long dirID1, long dirID2, Str31 uniqueName));
static OSErr GetFileSpecs _ANSI_ARGS_((CONST char *path,
FSSpec *pathSpecPtr, FSSpec *dirSpecPtr,
Boolean *pathExistsPtr,
@@ -218,7 +221,7 @@
Str31 tmpName;
FSSpec tmpFileSpec;
- err = GenerateUniqueName(dstFileSpec.vRefNum,
+ err = GenerateUniqueName(dstFileSpec.vRefNum, &startSeed,
dstFileSpec.parID, dstFileSpec.parID, tmpName);
if (err == noErr) {
err = FSpRenameCompat(&dstFileSpec, tmpName);
@@ -334,7 +337,7 @@
* dest directory, and rename temp to target.
*/
- err = GenerateUniqueName(srcFileSpecPtr->vRefNum,
+ err = GenerateUniqueName(srcFileSpecPtr->vRefNum, &startSeed,
srcFileSpecPtr->parID, dstID, tmpName);
FSMakeFSSpecCompat(srcFileSpecPtr->vRefNum, srcFileSpecPtr->parID,
tmpName, &tmpSrcFileSpec);
@@ -436,7 +439,7 @@
* Backup dest file.
*/
- dstErr = GenerateUniqueName(dstFileSpec.vRefNum, dstFileSpec.parID,
+ dstErr = GenerateUniqueName(dstFileSpec.vRefNum, &startSeed, dstFileSpec.parID,
dstFileSpec.parID, tmpName);
if (dstErr == noErr) {
dstErr = FSpRenameCompat(&dstFileSpec, tmpName);
@@ -707,7 +710,7 @@
FSpRstFLockCompat(&srcFileSpec);
}
if (err == noErr) {
- err = GenerateUniqueName(dstFileSpec.vRefNum, dstFileSpec.parID,
+ err = GenerateUniqueName(dstFileSpec.vRefNum, &startSeed, dstFileSpec.parID,
dstFileSpec.parID, tmpName);
}
if (err == noErr) {
@@ -931,69 +934,6 @@
return TCL_OK;
}
-/*
- *---------------------------------------------------------------------------
- *
- * GenerateUniqueName --
- *
- * Generate a filename that is not in either of the two specified
- * directories (on the same volume).
- *
- * Results:
- * Standard macintosh error. On success, uniqueName is filled with
- * the name of the temporary file.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-
-static OSErr
-GenerateUniqueName(
- short vRefNum, /* Volume on which the following directories
- * are located. */
- long dirID1, /* ID of first directory. */
- long dirID2, /* ID of second directory. May be the same
- * as the first. */
- Str31 uniqueName) /* Filled with filename for a file that is
- * not located in either of the above two
- * directories. */
-{
- OSErr err;
- long i;
- CInfoPBRec pb;
- static unsigned char hexStr[16] = "0123456789ABCDEF";
- static long startSeed = 248923489;
-
- pb.hFileInfo.ioVRefNum = vRefNum;
- pb.hFileInfo.ioFDirIndex = 0;
- pb.hFileInfo.ioNamePtr = uniqueName;
-
- while (1) {
- startSeed++;
- pb.hFileInfo.ioNamePtr[0] = 8;
- for (i = 1; i <= 8; i++) {
- pb.hFileInfo.ioNamePtr[i] = hexStr[((startSeed >> ((8-i)*4)) & 0xf)];
- }
- pb.hFileInfo.ioDirID = dirID1;
- err = PBGetCatInfoSync(&pb);
- if (err == fnfErr) {
- if (dirID1 != dirID2) {
- pb.hFileInfo.ioDirID = dirID2;
- err = PBGetCatInfoSync(&pb);
- }
- if (err == fnfErr) {
- return noErr;
- }
- }
- if (err == noErr) {
- continue;
- }
- return err;
- }
-}
-
/*
*---------------------------------------------------------------------------
*
Index: mac/tclMacFile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/tclMacFile.c,v
retrieving revision 1.24
diff -u -3 -r1.24 tclMacFile.c
--- mac/tclMacFile.c 15 Jul 2002 10:28:18 -0000 1.24
+++ mac/tclMacFile.c 9 Oct 2002 07:43:26 -0000
@@ -1172,7 +1172,7 @@
FSSpec spec;
FSSpec linkSpec;
OSErr err;
- char *path;
+ CONST char *path;
AliasHandle alias;
err = FspLocationFromFsPath(toPtr, &spec);
Index: mac/tclMacLoad.c
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/tclMacLoad.c,v
retrieving revision 1.15
diff -u -3 -r1.15 tclMacLoad.c
--- mac/tclMacLoad.c 18 Jul 2002 16:26:04 -0000 1.15
+++ mac/tclMacLoad.c 9 Oct 2002 07:43:26 -0000
@@ -92,8 +92,8 @@
FSSpec fileSpec;
} TclMacLoadInfo;
-static int TryToLoad(Tcl_Interp *interp, TclMacLoadInfo *loadInfo,
- CONST char *sym /* native */)
+static int TryToLoad(Tcl_Interp *interp, TclMacLoadInfo *loadInfo, Tcl_Obj *pathPtr,
+ CONST char *sym /* native */);
/*
@@ -123,14 +123,13 @@
Tcl_LoadHandle *loadHandle; /* Filled with token for dynamically loaded
* file which will be passed back to
* (*unloadProcPtr)() to unload the file. */
- Tcl_FSUnloadFileProc **unloadProcPtr)
+ Tcl_FSUnloadFileProc **unloadProcPtr;
/* Filled with address of Tcl_FSUnloadFileProc
* function which should be used for
* this file. */
{
OSErr err;
FSSpec fileSpec;
- Tcl_DString ds;
CONST char *native;
TclMacLoadInfo *loadInfo;
@@ -147,8 +146,8 @@
loadInfo->fileSpec = fileSpec;
loadInfo->connID = NULL;
- if (TryToLoad(interp, loadInfo, NULL) != TCL_OK) {
- ckfree(loadInfo);
+ if (TryToLoad(interp, loadInfo, pathPtr, NULL) != TCL_OK) {
+ ckfree((char*) loadInfo);
return TCL_ERROR;
}
@@ -163,9 +162,10 @@
* loaded.
*/
static int
-TryToLoad(Tcl_Interp *interp, TclMacLoadInfo *loadInfo,
+TryToLoad(Tcl_Interp *interp, TclMacLoadInfo *loadInfo, Tcl_Obj *pathPtr,
CONST char *sym /* native */)
{
+ OSErr err;
CFragConnectionID connID;
Ptr dummy;
short fragFileRef, saveFileRef;
@@ -189,7 +189,7 @@
saveFileRef = CurResFile();
SetResLoad(false);
- fragFileRef = FSpOpenResFile(&fileSpec, fsRdPerm);
+ fragFileRef = FSpOpenResFile(&loadInfo->fileSpec, fsRdPerm);
SetResLoad(true);
if (fragFileRef != -1) {
if (sym != NULL) {
@@ -237,14 +237,20 @@
* as we are going to search for specific entry points passed to us.
*/
- err = GetDiskFragment(&fileSpec, offset, length, fragName,
+ err = GetDiskFragment(&loadInfo->fileSpec, offset, length, fragName,
kLoadCFrag, &connID, &dummy, errName);
if (err != fragNoErr) {
p2cstr(errName);
+ if(pathPtr) {
Tcl_AppendResult(interp, "couldn't load file \"",
Tcl_GetString(pathPtr),
"\": ", errName, (char *) NULL);
+ } else if(sym) {
+ Tcl_AppendResult(interp, "couldn't load library \"",
+ sym,
+ "\": ", errName, (char *) NULL);
+ }
return TCL_ERROR;
}
@@ -290,7 +296,7 @@
*/
Tcl_UtfToExternalDString(NULL, symbol, -1, &ds);
Tcl_DStringSetLength(&ds, Tcl_DStringLength(&ds) - 5);
- res = TryToLoad(interp, loadInfo, Tcl_DStringValue(&ds));
+ res = TryToLoad(interp, loadInfo, NULL, Tcl_DStringValue(&ds));
Tcl_DStringFree(&ds);
if (res != TCL_OK) {
return NULL;
@@ -340,7 +346,7 @@
if (loadInfo->loaded) {
CloseConnection((CFragConnectionID*) &(loadInfo->connID));
}
- ckfree(loadInfo);
+ ckfree((char*)loadInfo);
}
/*
Index: mac/tclMacOSA.c
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/tclMacOSA.c,v
retrieving revision 1.9
diff -u -3 -r1.9 tclMacOSA.c
--- mac/tclMacOSA.c 8 Apr 2002 09:02:48 -0000 1.9
+++ mac/tclMacOSA.c 9 Oct 2002 07:43:28 -0000
@@ -78,74 +78,74 @@
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 @@
ClientData clientData,
Tcl_Interp *interp,
int argc,
- char **argv)
+ CONST char **argv)
{
static unsigned short componentCmdIndex = 0;
char autoName[32];
@@ -581,7 +581,7 @@
ClientData clientData,
Tcl_Interp *interp,
int argc,
- char **argv)
+ CONST char **argv)
{
int length;
char c;
@@ -648,7 +648,7 @@
Tcl_Interp *interp,
tclOSAComponent *OSAComponent,
int argc,
- char **argv)
+ CONST char **argv)
{
int tclError = TCL_OK;
int augment = 1;
@@ -736,7 +736,9 @@
}
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 @@
makeNewContext = true;
} else if (tclOSAGetContextID(OSAComponent,
resultName, &resultID) == TCL_OK) {
- makeNewContext = false;
} else {
makeNewContext = true;
- resultID = kOSANullScript;
}
/*
@@ -802,6 +802,8 @@
if (augment && !makeNewContext) {
modeFlags |= kOSAModeAugmentContext;
}
+ } else if (resultName == NULL) {
+ resultName = autoName; /* Auto name the script */
}
/*
@@ -876,7 +878,7 @@
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 @@
Tcl_Interp * interp,
tclOSAComponent *OSAComponent,
int argc,
- char **argv)
+ CONST char **argv)
{
AEDesc resultingSourceData = { typeChar, NULL };
OSAID scriptID;
@@ -986,7 +988,7 @@
Tcl_Interp *interp,
tclOSAComponent *OSAComponent,
int argc,
- char **argv)
+ CONST char **argv)
{
char c,*errMsg = NULL;
int length;
@@ -1049,7 +1051,7 @@
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 @@
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 @@
Tcl_Interp *interp,
tclOSAComponent *OSAComponent,
int argc,
- char **argv)
+ CONST char **argv)
{
char c;
int length;
@@ -1293,11 +1295,12 @@
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 @@
Tcl_Interp *interp,
tclOSAComponent *OSAComponent,
int argc,
- char **argv)
+ CONST char **argv)
{
int tclError = TCL_OK,
resID = 128;
@@ -1445,7 +1448,7 @@
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 @@
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 @@
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 @@
/* TODO -- clean up here... */
}
- myActiveProcUPP = NewOSAActiveProc(TclOSAActiveProc);
+ myActiveProcUPP = NewOSAActiveUPP(TclOSAActiveProc);
OSASetActiveProc(newComponent->theComponent,
myActiveProcUPP, (long) newComponent);
return newComponent;
@@ -1886,7 +1890,7 @@
static int
tclOSAGetContextID(
tclOSAComponent *theComponent,
- char *contextName,
+ CONST char *contextName,
OSAID *theContext)
{
Tcl_HashEntry *hashEntry;
@@ -1968,7 +1972,7 @@
static int
tclOSADeleteContext(
tclOSAComponent *theComponent,
- char *contextName)
+ CONST char *contextName)
{
Tcl_HashEntry *hashEntry;
tclOSAContext *contextStruct;
@@ -2010,7 +2014,7 @@
static int
tclOSAMakeContext(
tclOSAComponent *theComponent,
- char *contextName,
+ CONST char *contextName,
OSAID *theContext)
{
AEDesc contextNameDesc = {typeNull, NULL};
@@ -2023,7 +2027,10 @@
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 @@
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 @@
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 @@
static int
tclOSAGetScriptID(
tclOSAComponent *theComponent,
- char *scriptName,
+ CONST char *scriptName,
OSAID *scriptID)
{
tclOSAScript *theScript;
@@ -2484,7 +2491,7 @@
static tclOSAScript *
tclOSAGetScript(
tclOSAComponent *theComponent,
- char *scriptName)
+ CONST char *scriptName)
{
Tcl_HashEntry *hashEntry;
@@ -2518,7 +2525,7 @@
static int
tclOSADeleteScript(
tclOSAComponent *theComponent,
- char *scriptName,
+ CONST char *scriptName,
char *errMsg)
{
Tcl_HashEntry *hashEntry;
@@ -2565,7 +2572,7 @@
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 @@
static void
getSortedHashKeys(
Tcl_HashTable *theTable,
- char *pattern,
+ CONST char *pattern,
Tcl_DString *theResult)
{
Tcl_HashSearch search;
@@ -2689,7 +2696,7 @@
static int
prepareScriptData(
int argc,
- char **argv,
+ CONST char **argv,
Tcl_DString *scrptData,
AEDesc *scrptDesc)
{
Index: mac/tclMacPort.h
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/tclMacPort.h,v
retrieving revision 1.15
diff -u -3 -r1.15 tclMacPort.h
--- mac/tclMacPort.h 5 Jun 2002 11:59:44 -0000 1.15
+++ mac/tclMacPort.h 9 Oct 2002 07:43:28 -0000
@@ -58,54 +58,8 @@
# include <time.h>
# include <unistd.h>
# include <utime.h>
-
-/*
- * The following definitions are usually found if fcntl.h.
- * However, MetroWerks has screwed that file up a couple of times
- * and all we need are the defines.
- */
-#ifndef _FCNTL
-# define O_RDWR 0x0 /* open the file in read/write mode */
-# define O_RDONLY 0x1 /* open the file in read only mode */
-# define O_WRONLY 0x2 /* open the file in write only mode */
-# define O_APPEND 0x0100 /* open the file in append mode */
-# define O_CREAT 0x0200 /* create the file if it doesn't exist */
-# define O_EXCL 0x0400 /* if the file exists don't create it again */
-# define O_TRUNC 0x0800 /* truncate the file after opening it */
-#endif
-/*
- * MetroWerks stat.h file is rather weak. The defines
- * after the include are needed to fill in the missing
- * defines.
- */
-
+# include <fcntl.h>
# include <stat.h>
-# ifndef S_IFIFO
-# define S_IFIFO 0x0100
-# endif
-# ifndef S_IFBLK
-# define S_IFBLK 0x0600
-# endif
-# ifndef S_ISLNK
-# define S_ISLNK(m) (((m)&(S_IFMT)) == (S_IFLNK))
-# endif
-# ifndef S_ISSOCK
-# define S_ISSOCK(m) (((m)&(S_IFMT)) == (S_IFSOCK))
-# endif
-# ifndef S_IRWXU
-# define S_IRWXU 00007 /* read, write, execute: owner */
-# define S_IRUSR 00004 /* read permission: owner */
-# define S_IWUSR 00002 /* write permission: owner */
-# define S_IXUSR 00001 /* execute permission: owner */
-# define S_IRWXG 00007 /* read, write, execute: group */
-# define S_IRGRP 00004 /* read permission: group */
-# define S_IWGRP 00002 /* write permission: group */
-# define S_IXGRP 00001 /* execute permission: group */
-# define S_IRWXO 00007 /* read, write, execute: other */
-# define S_IROTH 00004 /* read permission: other */
-# define S_IWOTH 00002 /* write permission: other */
-# define S_IXOTH 00001 /* execute permission: other */
-# endif
#if __MSL__ < 0x6000
# define isatty(arg) 1
Index: mac/tclMacTest.c
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/tclMacTest.c,v
retrieving revision 1.5
diff -u -3 -r1.5 tclMacTest.c
--- mac/tclMacTest.c 5 Aug 2002 03:24:41 -0000 1.5
+++ mac/tclMacTest.c 9 Oct 2002 07:43:28 -0000
@@ -30,9 +30,9 @@
int TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
static int DebuggerCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int WriteTextResource _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
/*
@@ -89,7 +89,7 @@
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Not used. */
int argc, /* Not used. */
- char **argv) /* Not used. */
+ CONST char **argv) /* Not used. */
{
Debugger();
return TCL_OK;
@@ -118,13 +118,13 @@
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
- char **argv) /* Argument strings. */
+ CONST char **argv) /* Argument strings. */
{
char *errNum = "wrong # args: ";
char *errBad = "bad argument: ";
char *errStr;
- char *fileName = NULL, *rsrcName = NULL;
- char *data = NULL;
+ CONST char *fileName = NULL, *rsrcName = NULL;
+ CONST char *data = NULL;
int rsrcID = -1, i, protectIt = 0;
short fileRef = -1;
OSErr err;
Index: mac/tclMacUnix.c
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/tclMacUnix.c,v
retrieving revision 1.4
diff -u -3 -r1.4 tclMacUnix.c
--- mac/tclMacUnix.c 23 Nov 2001 01:28:46 -0000 1.4
+++ mac/tclMacUnix.c 9 Oct 2002 07:43:28 -0000
@@ -74,7 +74,7 @@
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
- char **argv) /* Argument strings. */
+ CONST char **argv) /* Argument strings. */
{
Tcl_Channel chan;
int mode, result, i;
