Attachment "tip17-tip17mac.diff" to
ticket [408840ffff]
added by
das
2001-06-23 07:29:52.
# This is a diff between a tcl tree with tip17.patch applied and one with
# the new tip17-mac.patch applied.
diff -r -u3 tcl-tip17/generic/tclDate.c tcl-tip17-mac/generic/tclDate.c
--- tcl-tip17/generic/tclDate.c Fri May 19 08:29:56 2000
+++ tcl-tip17-mac/generic/tclDate.c Fri Jun 22 17:51:10 2001
@@ -16,7 +16,7 @@
#include "tclInt.h"
#include "tclPort.h"
-#ifdef MAC_TCL
+#if defined(MAC_TCL) && !defined(TCL_MAC_USE_MSL_EPOCH)
# define EPOCH 1904
# define START_OF_TIME 1904
# define END_OF_TIME 2039
diff -r -u3 tcl-tip17/generic/tclFileName.c tcl-tip17-mac/generic/tclFileName.c
--- tcl-tip17/generic/tclFileName.c Fri Jun 22 17:24:18 2001
+++ tcl-tip17-mac/generic/tclFileName.c Fri Jun 22 17:51:10 2001
@@ -2250,7 +2250,11 @@
Tcl_ListObjIndex(interp, resultPtr, i, &elt);
Tcl_DStringInit(&ds);
Tcl_DStringAppend(&ds, Tcl_GetString(elt), -1);
+ if(tclPlatform == TCL_PLATFORM_MAC) {
+ Tcl_DStringAppend(&ds, ":",1);
+ } else {
Tcl_DStringAppend(&ds, "/",1);
+ }
ret = TclDoGlob(interp, separators, &ds, p+1, types);
Tcl_DStringFree(&ds);
if (ret != TCL_OK) {
diff -r -u3 tcl-tip17/generic/tclGetDate.y tcl-tip17-mac/generic/tclGetDate.y
--- tcl-tip17/generic/tclGetDate.y Fri May 19 08:29:56 2000
+++ tcl-tip17-mac/generic/tclGetDate.y Fri Jun 22 17:51:10 2001
@@ -33,7 +33,7 @@
#include "tclInt.h"
#include "tclPort.h"
-#ifdef MAC_TCL
+#if defined(MAC_TCL) && !defined(TCL_MAC_USE_MSL_EPOCH)
# define EPOCH 1904
# define START_OF_TIME 1904
# define END_OF_TIME 2039
diff -r -u3 tcl-tip17/generic/tclIOUtil.c tcl-tip17-mac/generic/tclIOUtil.c
--- tcl-tip17/generic/tclIOUtil.c Fri Jun 22 17:24:18 2001
+++ tcl-tip17-mac/generic/tclIOUtil.c Fri Jun 22 17:51:10 2001
@@ -40,7 +40,7 @@
_ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr));
static int SetFsPathFromAbsoluteNormalized
_ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr));
-static int FindSplitPos _ANSI_ARGS_((char *path));
+static int FindSplitPos _ANSI_ARGS_((char *path, char *separator));
static Tcl_Filesystem* Tcl_FSGetFileSystemForPath
_ANSI_ARGS_((Tcl_Obj* pathObjPtr));
@@ -2657,32 +2657,25 @@
* directory delimiter in the path.
*/
static int
-FindSplitPos(path)
+FindSplitPos(path, separator)
char *path;
+ char *separator;
{
int count = 0;
switch (tclPlatform) {
case TCL_PLATFORM_UNIX:
+ case TCL_PLATFORM_MAC:
while (path[count] != 0) {
- if (path[count] == '/') {
+ if (path[count] == *separator) {
return count;
}
count++;
}
break;
- case TCL_PLATFORM_MAC:
- while (path[count] != 0) {
- if (path[count] == ':') {
- return count;
- }
- count++;
- }
- break;
-
case TCL_PLATFORM_WINDOWS:
while (path[count] != 0) {
- if (path[count] == '/' || path[count] == '\\') {
+ if (path[count] == *separator || path[count] == '\\') {
return count;
}
count++;
@@ -2813,7 +2806,14 @@
if (name[0] == '~') {
char *expandedUser;
Tcl_DString temp;
- int split = FindSplitPos(name);
+ int split;
+ char separator='/';
+
+ if (tclPlatform==TCL_PLATFORM_MAC) {
+ if (strchr(name, ':') != NULL) separator = ':';
+ }
+
+ split = FindSplitPos(name, &separator);
if (split != len) {
/* We have multiple pieces '~user/foo/bar...' */
name[split] = '\0';
@@ -2823,7 +2823,7 @@
/* We have just '~' */
char *dir;
Tcl_DString dirString;
- if (split != len) { name[split] = '/'; }
+ if (split != len) { name[split] = separator; }
dir = TclGetEnv("HOME", &dirString);
if (dir == NULL) {
@@ -2847,10 +2847,10 @@
"\" doesn't exist", (char *) NULL);
}
Tcl_DStringFree(&temp);
- if (split != len) { name[split] = '/'; }
+ if (split != len) { name[split] = separator; }
return TCL_ERROR;
}
- if (split != len) { name[split] = '/'; }
+ if (split != len) { name[split] = separator; }
}
expandedUser = Tcl_DStringValue(&temp);
@@ -3813,7 +3813,15 @@
Tcl_Obj *pathPtr;
struct utimbuf *tval;
{
+ #ifdef MAC_TCL
+ long gmt_offset=TclpGetGMTOffset();
+ struct utimbuf local_tval;
+ local_tval.actime=tval->actime+gmt_offset;
+ local_tval.modtime=tval->modtime+gmt_offset;
+ return utime(Tcl_GetString(Tcl_FSGetNormalizedPath(NULL,pathPtr)),&local_tval);
+ #else
return utime(Tcl_GetString(Tcl_FSGetNormalizedPath(NULL,pathPtr)),tval);
+ #endif
}
int
diff -r -u3 tcl-tip17/generic/tclInt.h tcl-tip17-mac/generic/tclInt.h
--- tcl-tip17/generic/tclInt.h Fri Jun 22 17:24:18 2001
+++ tcl-tip17-mac/generic/tclInt.h Fri Jun 22 17:51:10 2001
@@ -1793,6 +1793,7 @@
EXTERN void TclpFree _ANSI_ARGS_((char *ptr));
EXTERN unsigned long TclpGetClicks _ANSI_ARGS_((void));
EXTERN Tcl_Channel TclpGetDefaultStdChannel _ANSI_ARGS_((int type));
+EXTERN long TclpGetGMTOffset _ANSI_ARGS_((void));
EXTERN unsigned long TclpGetSeconds _ANSI_ARGS_((void));
EXTERN void TclpGetTime _ANSI_ARGS_((Tcl_Time *time));
EXTERN int TclpGetTimeZone _ANSI_ARGS_((unsigned long time));
@@ -1811,6 +1812,23 @@
char *pattern, char *tail));
EXTERN int TclpObjNormalizePath _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Obj *pathPtr, int nextCheckpoint));
+EXTERN int TclpObjCreateDirectory _ANSI_ARGS_((Tcl_Obj *pathPtr));
+EXTERN int TclpObjDeleteFile _ANSI_ARGS_((Tcl_Obj *pathPtr));
+EXTERN int TclpObjCopyDirectory _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
+ Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr));
+EXTERN int TclpObjCopyFile _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
+ Tcl_Obj *destPathPtr));
+EXTERN int TclpObjRemoveDirectory _ANSI_ARGS_((Tcl_Obj *pathPtr,
+ int recursive, Tcl_Obj **errorPtr));
+EXTERN int TclpObjRenameFile _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
+ Tcl_Obj *destPathPtr));
+EXTERN int TclpMatchInDirectory _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *resultPtr, Tcl_Obj *pathPtr, char *pattern, Tcl_GlobTypeData *types));
+EXTERN int TclpChdir _ANSI_ARGS_((CONST char *dirName));
+EXTERN char * TclpGetCwd _ANSI_ARGS_((Tcl_Interp *interp, Tcl_DString *bufferPtr));
+EXTERN Tcl_Obj* TclpObjGetCwd _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN Tcl_Obj* TclpObjReadlink _ANSI_ARGS_((Tcl_Obj *pathPtr));
+EXTERN int TclpObjChdir _ANSI_ARGS_((Tcl_Obj *pathPtr));
+EXTERN int TclpObjStat _ANSI_ARGS_((Tcl_Obj *pathPtr, struct stat *buf));
EXTERN Tcl_Channel TclpOpenFileChannel _ANSI_ARGS_((Tcl_Interp *interp,
char *fileName, char *modeString,
int permissions));
diff -r -u3 tcl-tip17/generic/tclLoadNone.c tcl-tip17-mac/generic/tclLoadNone.c
--- tcl-tip17/generic/tclLoadNone.c 2001/06/22 07:49:44
+++ tcl-tip17-mac/generic/tclLoadNone.c 1999/05/07 20:07:40
@@ -109,5 +109,4 @@
* a token that represents the loaded
* file. */
{
- return TCL_OK;
}
diff -r -u3 tcl-tip17/generic/tclTest.c tcl-tip17-mac/generic/tclTest.c
--- tcl-tip17/generic/tclTest.c Fri Jun 22 17:24:18 2001
+++ tcl-tip17-mac/generic/tclTest.c Fri Jun 22 17:51:10 2001
@@ -307,6 +307,8 @@
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
+static void TestReport _ANSI_ARGS_((CONST char* cmd, Tcl_Obj* arg1, Tcl_Obj* arg2));
+
static Tcl_FSStatProc TestReportStat;
static Tcl_FSAccessProc TestReportAccess;
static Tcl_FSOpenFileChannelProc TestReportOpenFileChannel;
@@ -4335,10 +4337,18 @@
* file, with what modes to create
* it? */
{
- if (!strcmp("testOpenFileChannel1%.fil", fileName)) {
+ char *expectname="testOpenFileChannel1%.fil";
+ Tcl_DString ds;
+
+ Tcl_DStringInit(&ds);
+ Tcl_JoinPath(1, &expectname, &ds);
+
+ if (!strcmp(Tcl_DStringValue(&ds), fileName)) {
+ Tcl_DStringFree(&ds);
return (TclpOpenFileChannel(interp, "__testOpenFileChannel1%__.fil",
modeString, permissions));
} else {
+ Tcl_DStringFree(&ds);
return (NULL);
}
}
@@ -4355,10 +4365,18 @@
* file, with what modes to create
* it? */
{
- if (!strcmp("testOpenFileChannel2%.fil", fileName)) {
+ char *expectname="testOpenFileChannel2%.fil";
+ Tcl_DString ds;
+
+ Tcl_DStringInit(&ds);
+ Tcl_JoinPath(1, &expectname, &ds);
+
+ if (!strcmp(Tcl_DStringValue(&ds), fileName)) {
+ Tcl_DStringFree(&ds);
return (TclpOpenFileChannel(interp, "__testOpenFileChannel2%__.fil",
modeString, permissions));
} else {
+ Tcl_DStringFree(&ds);
return (NULL);
}
}
@@ -4375,10 +4393,18 @@
* file, with what modes to create
* it? */
{
- if (!strcmp("testOpenFileChannel3%.fil", fileName)) {
+ char *expectname="testOpenFileChannel3%.fil";
+ Tcl_DString ds;
+
+ Tcl_DStringInit(&ds);
+ Tcl_JoinPath(1, &expectname, &ds);
+
+ if (!strcmp(Tcl_DStringValue(&ds), fileName)) {
+ Tcl_DStringFree(&ds);
return (TclpOpenFileChannel(interp, "__testOpenFileChannel3%__.fil",
modeString, permissions));
} else {
+ Tcl_DStringFree(&ds);
return (NULL);
}
}
diff -r -u3 tcl-tip17/mac/tclMacFCmd.c tcl-tip17-mac/mac/tclMacFCmd.c
--- tcl-tip17/mac/tclMacFCmd.c Fri Jun 22 17:24:18 2001
+++ tcl-tip17-mac/mac/tclMacFCmd.c Fri Jun 22 17:51:10 2001
@@ -25,6 +25,7 @@
#include <Script.h>
#include <string.h>
#include <Finder.h>
+#include <Aliases.h>
/*
* Callback for the file attributes code.
@@ -105,7 +106,7 @@
}
int
-TclpObjDeleteFile(Tcl_Obj *pathPtr)
+TclpObjDeleteFile(pathPtr)
Tcl_Obj *pathPtr;
{
return TclpDeleteFile(Tcl_FSGetTranslatedPath(NULL, pathPtr));
@@ -1622,10 +1623,10 @@
* TclpObjNormalizePath --
*
* This function scans through a path specification and replaces
- * it, in place, with a normalized version. On MacOS, this simply
- * ascertains where the valid path ends, and makes no change in
- * place. It should convert the current path to a normalized,
- * case-sensitive path.
+ * it, in place, with a normalized version. On MacOS, this means
+ * resolving all aliases present in the path and replacing the head of
+ * pathPtr with the absolute case-sensitive path to the last file or
+ * directory that could be validated in the path.
*
* Results:
* The new 'nextCheckpoint' value, giving as far as we could
@@ -1633,8 +1634,7 @@
*
* Side effects:
* The pathPtr string, which must contain a valid path, is
- * not modified, but should be. See the Windows implementation
- * for more detail.
+ * possibly modified in place.
*
*---------------------------------------------------------------------------
*/
@@ -1645,25 +1645,145 @@
Tcl_Obj *pathPtr;
int nextCheckpoint;
{
- char *path = Tcl_GetString(pathPtr);
+ #define MAXMACFILENAMELEN 31 /* assumed to be < sizeof(StrFileName) */
+
+ StrFileName fileName;
+ StringPtr fileNamePtr;
+ int fileNameLen,newPathLen;
+ Handle newPathHandle;
+ OSErr err;
+ short vRefNum;
+ long dirID;
+ Boolean isDirectory;
+ Boolean wasAlias;
+ FSSpec fileSpec;
+
+ Tcl_DString nativeds;
+
+ char cur;
+ int firstCheckpoint=nextCheckpoint, lastCheckpoint;
+ int origPathLen;
+ char *path = Tcl_GetStringFromObj(pathPtr,&origPathLen);
+
+ {
+ int currDirValid=0;
+ /*
+ * check if substring to first ':' after initial
+ * nextCheckpoint is a valid relative or absolute
+ * path to a directory, if not we return without
+ * normalizing anything
+ */
while (1) {
- char cur = path[nextCheckpoint];
- if (cur == 0) {
- break;
- }
- if (cur == '/') {
- int access;
- path[nextCheckpoint] = 0;
- access = TclpAccess(path, F_OK);
- path[nextCheckpoint] = '/';
- if (access != 0) {
- /* File doesn't exist */
+ cur = path[nextCheckpoint];
+ if (cur == ':' || cur == 0) {
+ if (cur == ':') { nextCheckpoint++; cur = path[nextCheckpoint]; } /* jump over separator */
+ Tcl_UtfToExternalDString(NULL,path,nextCheckpoint,&nativeds);
+ err = FSpLocationFromPath(Tcl_DStringLength(&nativeds), Tcl_DStringValue(&nativeds), &fileSpec);
+ Tcl_DStringFree(&nativeds);
+ if (err == noErr) {
+ err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
+ currDirValid = ((err == noErr) && isDirectory);
+ vRefNum = fileSpec.vRefNum;
+ }
break;
- }
}
nextCheckpoint++;
}
- return nextCheckpoint;
+
+ if(!currDirValid) return firstCheckpoint; /* can't determine root dir, bail out */
+ }
+
+ /*
+ * Now vRefNum and dirID point to a valid
+ * directory, so walk the rest of the path
+ * ( code adapted from FSpLocationFromPath() )
+ */
+
+ lastCheckpoint=nextCheckpoint;
+ while (1) {
+ cur = path[nextCheckpoint];
+ if (cur == ':' || cur == 0) {
+ fileNameLen=nextCheckpoint-lastCheckpoint;
+ fileNamePtr=fileName;
+ if(fileNameLen==0) {
+ if (cur == ':') {
+ /*
+ * special case for empty dirname i.e. encountered
+ * a '::' path component: get parent dir of currDir
+ */
+ fileName[0]=2;
+ strcpy((char *) fileName + 1, "::");
+ lastCheckpoint--;
+ } else {
+ /*
+ * empty filename, i.e. want FSSpec for currDir
+ */
+ fileNamePtr=NULL;
+ }
+ } else {
+ Tcl_UtfToExternalDString(NULL,&path[lastCheckpoint],fileNameLen,&nativeds);
+ fileNameLen=Tcl_DStringLength(&nativeds);
+ if(fileNameLen > MAXMACFILENAMELEN) fileNameLen=MAXMACFILENAMELEN;
+ fileName[0]=fileNameLen;
+ strncpy((char *) fileName + 1, Tcl_DStringValue(&nativeds), fileNameLen);
+ Tcl_DStringFree(&nativeds);
+ }
+ err=FSMakeFSSpecCompat(vRefNum, dirID, fileNamePtr, &fileSpec);
+ if(err != noErr) {
+ if(err != fnfErr) {
+ /*
+ * this can if trying to get parent of a root volume via '::'
+ * or when using an illegal filename
+ * revert to last checkpoint and stop processing path further
+ */
+ err=FSMakeFSSpecCompat(vRefNum, dirID, NULL, &fileSpec);
+ if(err != noErr) return firstCheckpoint; /* should never happen, bail out */
+ nextCheckpoint=lastCheckpoint;
+ cur = path[lastCheckpoint];
+ }
+ break; /* arrived at nonexistent file or dir */
+ } else {
+ /* fileSpec could point to an alias, resolve it */
+ err = ResolveAliasFile(&fileSpec, true, &isDirectory, &wasAlias);
+ if (err != noErr || !isDirectory) break; /* fileSpec doesn't point to a dir */
+ }
+ if (cur == 0) break; /* arrived at end of path */
+
+ /* fileSpec points to possibly nonexisting subdirectory; validate */
+ err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
+ if (err != noErr || !isDirectory) break; /* fileSpec doesn't point to existing dir */
+ vRefNum = fileSpec.vRefNum;
+
+ /* found a new valid subdir in path, continue processing path */
+ lastCheckpoint=nextCheckpoint+1;
+ }
+ nextCheckpoint++;
+ }
+
+ /*
+ * fileSpec now points to a possibly nonexisting file or dir
+ * inside a valid dir; get full path name to it
+ */
+
+ err=FSpPathFromLocation(&fileSpec, &newPathLen, &newPathHandle);
+ if(err != noErr) return firstCheckpoint; /* should not see any errors here, bail out */
+
+ HLock(newPathHandle);
+ Tcl_ExternalToUtfDString(NULL,*newPathHandle,newPathLen,&nativeds);
+ if (cur != 0) {
+ /* not at end, append remaining path */
+ if ( newPathLen==0 || *(*newPathHandle+(newPathLen-1))!=':') {
+ Tcl_DStringAppend(&nativeds, ":" , 1);
+ }
+ Tcl_DStringAppend(&nativeds, &path[nextCheckpoint+1], strlen(&path[nextCheckpoint+1]));
+ }
+ DisposeHandle(newPathHandle);
+
+ fileNameLen=Tcl_DStringLength(&nativeds);
+ Tcl_SetStringObj(pathPtr,Tcl_DStringValue(&nativeds),fileNameLen);
+ Tcl_DStringFree(&nativeds);
+
+ return nextCheckpoint+(fileNameLen-origPathLen);
}
diff -r -u3 tcl-tip17/mac/tclMacFile.c tcl-tip17-mac/mac/tclMacFile.c
--- tcl-tip17/mac/tclMacFile.c Fri Jun 22 17:24:18 2001
+++ tcl-tip17-mac/mac/tclMacFile.c Fri Jun 22 17:51:10 2001
@@ -31,12 +31,7 @@
#include <MoreFilesExtras.h>
#include <FSpCompat.h>
-/*
- * Static variables used by the TclpStat function.
- */
-static int initialized = false;
-static long gmt_offset;
-TCL_DECLARE_MUTEX(gmtMutex)
+static OSErr FspLocationFromFsPath _ANSI_ARGS_((Tcl_Obj *pathPtr, FSSpec* specPtr));
OSErr
FspLocationFromFsPath(pathPtr, specPtr)
@@ -44,7 +39,7 @@
FSSpec* specPtr;
{
char *native = Tcl_FSGetNativePath(pathPtr);
- return FSpLocationFromPath(strlen(native), native, &dirSpec);
+ return FSpLocationFromPath(strlen(native), native, specPtr);
}
@@ -151,14 +146,14 @@
OSType okType = 0;
OSType okCreator = 0;
Tcl_DString dsOrig;
- char *fileName;
+ char *fileName2;
- fileName = Tcl_FSGetTranslatedPath(interp, pathPtr);
- if (fileName == NULL) {
+ fileName2 = Tcl_FSGetTranslatedPath(interp, pathPtr);
+ if (fileName2 == NULL) {
return TCL_ERROR;
}
Tcl_DStringInit(&dsOrig);
- Tcl_DStringAppend(&dsOrig, fileName, -1);
+ Tcl_DStringAppend(&dsOrig, fileName2, -1);
baseLength = Tcl_DStringLength(&dsOrig);
/*
@@ -169,13 +164,30 @@
Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&dsOrig),
Tcl_DStringLength(&dsOrig), &fileString);
- FSpLocationFromPath(fileString.length, fileString.string, &dirSpec);
+ err = FSpLocationFromPath(Tcl_DStringLength(&fileString), Tcl_DStringValue(&fileString), &dirSpec);
Tcl_DStringFree(&fileString);
-
+ if (err == noErr)
err = FSpGetDirectoryID(&dirSpec, &dirID, &isDirectory);
if ((err != noErr) || !isDirectory) {
+ /*
+ * Check if we had a relative path (unix style rel path compatibility for glob)
+ */
Tcl_DStringFree(&dsOrig);
- return TCL_OK;
+ Tcl_DStringAppend(&dsOrig, ":", 1);
+ Tcl_DStringAppend(&dsOrig, fileName2, -1);
+ baseLength = Tcl_DStringLength(&dsOrig);
+
+ Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&dsOrig),
+ Tcl_DStringLength(&dsOrig), &fileString);
+
+ err = FSpLocationFromPath(Tcl_DStringLength(&fileString), Tcl_DStringValue(&fileString), &dirSpec);
+ Tcl_DStringFree(&fileString);
+ if (err == noErr)
+ err = FSpGetDirectoryID(&dirSpec, &dirID, &isDirectory);
+ if ((err != noErr) || !isDirectory) {
+ Tcl_DStringFree(&dsOrig);
+ return TCL_OK;
+ }
}
/* Make sure we have a trailing directory delimiter */
@@ -370,7 +382,7 @@
int ret;
Tcl_Obj *obj = Tcl_NewStringObj(dirName,-1);
Tcl_IncrRefCount(obj);
- ret = TclpObjChdir(obj,mode);
+ ret = TclpObjChdir(obj);
Tcl_DecrRefCount(obj);
return ret;
}
@@ -802,9 +814,9 @@
}
int
-TclpObjStat(pathPtr, buf)
+TclpObjStat(pathPtr, bufPtr)
Tcl_Obj *pathPtr;
- struct stat *buf;
+ struct stat *bufPtr;
{
HFileInfo fpb;
HVolumeParam vpb;
@@ -890,21 +902,8 @@
* what is returned from "clock seconds".
*/
- Tcl_MutexLock(&gmtMutex);
- if (initialized == false) {
- MachineLocation loc;
-
- ReadLocation(&loc);
- gmt_offset = loc.u.gmtDelta & 0x00ffffff;
- if (gmt_offset & 0x00800000) {
- gmt_offset = gmt_offset | 0xff000000;
- }
- initialized = true;
- }
- Tcl_MutexUnlock(&gmtMutex);
-
- bufPtr->st_atime = bufPtr->st_mtime = fpb.ioFlMdDat - gmt_offset;
- bufPtr->st_ctime = fpb.ioFlCrDat - gmt_offset;
+ bufPtr->st_atime = bufPtr->st_mtime = fpb.ioFlMdDat - TclpGetGMTOffset() + tcl_mac_epoch_offset;
+ bufPtr->st_ctime = fpb.ioFlCrDat - TclpGetGMTOffset() + tcl_mac_epoch_offset;
}
}
@@ -1052,7 +1051,7 @@
}
int
-TclpObjLstat(pathPtr, buf) {
+TclpObjLstat(pathPtr, buf)
Tcl_Obj *pathPtr;
struct stat *buf;
{
@@ -1091,7 +1090,7 @@
#ifdef S_IFLNK
Tcl_Obj*
-TclpObjReadlink(pathPtr) {
+TclpObjReadlink(pathPtr)
Tcl_Obj *pathPtr;
{
Tcl_DString ds;
diff -r -u3 tcl-tip17/mac/tclMacInit.c tcl-tip17-mac/mac/tclMacInit.c
--- tcl-tip17/mac/tclMacInit.c Fri Jun 22 17:24:18 2001
+++ tcl-tip17-mac/mac/tclMacInit.c Fri Jun 22 17:51:10 2001
@@ -423,57 +423,56 @@
fontId = 0;
GetFinderFont(&fontId);
-
encoding = TclMacGetFontEncoding(fontId);
if (encoding == NULL) {
- encoding = "macRoman";
+ encoding = "macRoman";
}
Tcl_SetSystemEncoding(NULL, encoding);
if (libraryPathEncodingFixed == 0) {
- /*
- * Until the system encoding was actually set, the library path was
- * actually in the native multi-byte encoding, and not really UTF-8
- * as advertised. We cheated as follows:
- *
- * 1. It was safe to allow the Tcl_SetSystemEncoding() call to
- * append the ASCII chars that make up the encoding's filename to
- * the names (in the native encoding) of directories in the library
- * path, since all Unix multi-byte encodings have ASCII in the
- * beginning.
- *
- * 2. To open the encoding file, the native bytes in the file name
- * were passed to the OS, without translating from UTF-8 to native,
- * because the name was already in the native encoding.
- *
- * Now that the system encoding was actually successfully set,
- * translate all the names in the library path to UTF-8. That way,
- * next time we search the library path, we'll translate the names
- * from UTF-8 to the system encoding which will be the native
- * encoding.
- */
+ /*
+ * Until the system encoding was actually set, the library path was
+ * actually in the native multi-byte encoding, and not really UTF-8
+ * as advertised. We cheated as follows:
+ *
+ * 1. It was safe to allow the Tcl_SetSystemEncoding() call to
+ * append the ASCII chars that make up the encoding's filename to
+ * the names (in the native encoding) of directories in the library
+ * path, since all Unix multi-byte encodings have ASCII in the
+ * beginning.
+ *
+ * 2. To open the encoding file, the native bytes in the file name
+ * were passed to the OS, without translating from UTF-8 to native,
+ * because the name was already in the native encoding.
+ *
+ * Now that the system encoding was actually successfully set,
+ * translate all the names in the library path to UTF-8. That way,
+ * next time we search the library path, we'll translate the names
+ * from UTF-8 to the system encoding which will be the native
+ * encoding.
+ */
- pathPtr = TclGetLibraryPath();
- if (pathPtr != NULL) {
- int i, objc;
- Tcl_Obj **objv;
-
- objc = 0;
- Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
- for (i = 0; i < objc; i++) {
- int length;
- char *string;
- Tcl_DString ds;
+ pathPtr = TclGetLibraryPath();
+ if (pathPtr != NULL) {
+ int i, objc;
+ Tcl_Obj **objv;
+
+ objc = 0;
+ Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
+ for (i = 0; i < objc; i++) {
+ int length;
+ char *string;
+ Tcl_DString ds;
- string = Tcl_GetStringFromObj(objv[i], &length);
- Tcl_ExternalToUtfDString(NULL, string, length, &ds);
- Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds),
- Tcl_DStringLength(&ds));
- Tcl_DStringFree(&ds);
- }
+ string = Tcl_GetStringFromObj(objv[i], &length);
+ Tcl_ExternalToUtfDString(NULL, string, length, &ds);
+ Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
}
+ }
libraryPathEncodingFixed = 1;
}
@@ -486,35 +485,6 @@
binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1");
}
}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclpVerifyInitialEncodings --
- *
- * Part way through startup, we verify that the initial encodings
- * were correctly setup. Depending on Tcl's environment, there
- * may not have been enough information first time through (above).
- *
- * Called at process initialization time.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Encodings may change.
- *
- *---------------------------------------------------------------------------
- */
-void TclpVerifyInitialEncodings()
-{
-
- /* This is only ever called from the startup thread */
- if (binaryEncoding == NULL) {
- encoding = "iso8859-1";
- binaryEncoding = Tcl_GetEncoding(NULL, encoding);
- }
-}
/*
*---------------------------------------------------------------------------
diff -r -u3 tcl-tip17/mac/tclMacPort.h tcl-tip17-mac/mac/tclMacPort.h
--- tcl-tip17/mac/tclMacPort.h Wed Jul 26 11:28:24 2000
+++ tcl-tip17-mac/mac/tclMacPort.h Fri Jun 22 17:51:10 2001
@@ -219,6 +219,26 @@
#define HAVE_TM_ZONE
+
+/*
+ * If we're using the Metrowerks MSL, we need to convert time_t values from
+ * the mac epoch to the msl epoch (== unix epoch) by adding the offset from
+ * <time.mac.h> to mac time_t values, as MSL is using its epoch for file
+ * access routines such as stat or utime
+ */
+
+#ifdef __MSL__
+#include <time.mac.h>
+#ifdef _mac_msl_epoch_offset_
+#define tcl_mac_epoch_offset _mac_msl_epoch_offset_
+#define TCL_MAC_USE_MSL_EPOCH /* flag for TclDate.c */
+#else
+#define tcl_mac_epoch_offset 0L
+#endif
+#else
+#define tcl_mac_epoch_offset 0L
+#endif
+
/*
* The following macros have trivial definitions, allowing generic code to
* address platform-specific issues.
diff -r -u3 tcl-tip17/mac/tclMacTime.c tcl-tip17-mac/mac/tclMacTime.c
--- tcl-tip17/mac/tclMacTime.c Wed Mar 10 16:52:51 1999
+++ tcl-tip17-mac/mac/tclMacTime.c Fri Jun 22 17:51:10 2001
@@ -26,6 +26,13 @@
static unsigned long baseSeconds;
static UnsignedWide microOffset;
+static int gmt_initialized = false;
+static long gmt_offset;
+static int gmt_isdst;
+TCL_DECLARE_MUTEX(gmtMutex)
+
+static int gmt_lastGetDateUseGMT = 0;
+
/*
* Prototypes for procedures that are private to this file:
*/
@@ -36,6 +43,43 @@
/*
*-----------------------------------------------------------------------------
*
+ * TclpGetGMTOffset --
+ *
+ * This procedure gets the offset seconds that needs to be _added_ to tcl time
+ * in seconds (i.e. GMT time) to get local time needed as input to various
+ * Mac OS APIs, to convert Mac OS API output to tcl time, _subtract_ this value.
+ *
+ * Results:
+ * Number of seconds separating GMT time and mac.
+ *
+ * Side effects:
+ * None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+long
+TclpGetGMTOffset()
+{
+ if (gmt_initialized == false) {
+ MachineLocation loc;
+
+ Tcl_MutexLock(&gmtMutex);
+ ReadLocation(&loc);
+ gmt_offset = loc.u.gmtDelta & 0x00ffffff;
+ if (gmt_offset & 0x00800000) {
+ gmt_offset = gmt_offset | 0xff000000;
+ }
+ gmt_isdst=(loc.u.dlsDelta < 0);
+ gmt_initialized = true;
+ Tcl_MutexUnlock(&gmtMutex);
+ }
+ return (gmt_offset);
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
* TclpGetSeconds --
*
* This procedure returns the number of seconds from the epoch. On
@@ -57,21 +101,9 @@
TclpGetSeconds()
{
unsigned long seconds;
- MachineLocation loc;
- long int offset;
-
- ReadLocation(&loc);
- offset = loc.u.gmtDelta & 0x00ffffff;
- if (offset & 0x00800000) {
- offset = offset | 0xff000000;
- }
- if (ReadDateTime(&seconds) == noErr) {
- return (seconds - offset);
- } else {
- panic("Can't get time.");
- return 0;
- }
+ GetDateTime(&seconds);
+ return (seconds - TclpGetGMTOffset() + tcl_mac_epoch_offset);
}
/*
@@ -123,22 +155,15 @@
TclpGetTimeZone (
unsigned long currentTime) /* Ignored on Mac. */
{
- MachineLocation loc;
- long int offset;
-
- ReadLocation(&loc);
- offset = loc.u.gmtDelta & 0x00ffffff;
- if (offset & 0x00700000) {
- offset |= 0xff000000;
- }
+ long offset;
/*
* Convert the Mac offset from seconds to minutes and
* add an hour if we have daylight savings time.
*/
- offset = -offset;
+ offset = -TclpGetGMTOffset();
offset /= 60;
- if (loc.u.dlsDelta < 0) {
+ if (gmt_isdst) {
offset += 60;
}
@@ -172,24 +197,11 @@
#endif
if (initalized == false) {
- MachineLocation loc;
- long int offset;
-
- ReadLocation(&loc);
- offset = loc.u.gmtDelta & 0x00ffffff;
- if (offset & 0x00800000) {
- offset = offset | 0xff000000;
- }
- if (ReadDateTime(&baseSeconds) != noErr) {
- /*
- * This should never happen!
- */
- return;
- }
+ GetDateTime(&baseSeconds);
/*
* Remove the local offset that ReadDateTime() adds.
*/
- baseSeconds -= offset;
+ baseSeconds -= TclpGetGMTOffset() - tcl_mac_epoch_offset;
Microseconds(µOffset);
initalized = true;
}
@@ -246,25 +258,16 @@
{
const time_t *tp = (const time_t *)time;
DateTimeRec dtr;
- MachineLocation loc;
- long int offset;
+ unsigned long offset=0L;
static struct tm statictime;
static const short monthday[12] =
{0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334};
-
- ReadLocation(&loc);
+
+ if(useGMT)
+ SecondsToDate(*tp - tcl_mac_epoch_offset, &dtr);
+ else
+ SecondsToDate(*tp + TclpGetGMTOffset() - tcl_mac_epoch_offset, &dtr);
- if (useGMT) {
- SecondsToDate(*tp, &dtr);
- } else {
- offset = loc.u.gmtDelta & 0x00ffffff;
- if (offset & 0x00700000) {
- offset |= 0xff000000;
- }
-
- SecondsToDate(*tp + offset, &dtr);
- }
-
statictime.tm_sec = dtr.second;
statictime.tm_min = dtr.minute;
statictime.tm_hour = dtr.hour;
@@ -277,7 +280,11 @@
if (1 < statictime.tm_mon && !(statictime.tm_year & 3)) {
++statictime.tm_yday;
}
- statictime.tm_isdst = loc.u.dlsDelta;
+ if(useGMT)
+ statictime.tm_isdst = 0;
+ else
+ statictime.tm_isdst = gmt_isdst;
+ gmt_lastGetDateUseGMT=useGMT; /* hack to make TclpGetTZName below work */
return(&statictime);
}
diff -r -u3 tcl-tip17/tests/event.test tcl-tip17-mac/tests/event.test
--- tcl-tip17/tests/event.test Tue Apr 11 03:18:58 2000
+++ tcl-tip17-mac/tests/event.test Fri Jun 22 17:51:10 2001
@@ -170,6 +170,7 @@
set x {}
update idletasks
rename bgerror {}
+ regsub -all [file join {} non_existent] $x "non_existent" x
set x
} {{{a simple error} {a simple error
while executing
diff -r -u3 tcl-tip17/tests/fCmd.test tcl-tip17-mac/tests/fCmd.test
--- tcl-tip17/tests/fCmd.test Fri Jun 22 17:24:18 2001
+++ tcl-tip17-mac/tests/fCmd.test Fri Jun 22 17:51:10 2001
@@ -69,7 +69,12 @@
}
proc cleanup {args} {
- foreach p [concat [list .] $args] {
+ if {$::tcl_platform(platform) == "macintosh"} {
+ set wd [list :]
+ } else {
+ set wd [list .]
+ }
+ foreach p [concat $wd $args] {
set x ""
catch {
set x [glob -directory $p tf* td*]
diff -r -u3 tcl-tip17/tests/io.test tcl-tip17-mac/tests/io.test
--- tcl-tip17/tests/io.test Fri Jun 22 17:24:18 2001
+++ tcl-tip17-mac/tests/io.test Fri Jun 22 17:51:10 2001
@@ -5088,6 +5088,7 @@
close $f
set msg [list [catch {open test3 {WRONLY CREAT EXCL}} msg] $msg]
regsub " already " $msg " " msg
+ regsub [file join {} test3] $msg "test3" msg
string tolower $msg
} {1 {couldn't open "test3": file exists}}
test io-40.7 {POSIX open access modes: EXCL} {
@@ -5135,11 +5136,15 @@
} 0
test io-40.11 {POSIX open access modes: RDONLY} {
removeFile test3
- string tolower [list [catch {open test3 RDONLY} msg] $msg]
+ set msg [list [catch {open test3 RDONLY} msg] $msg]
+ regsub [file join {} test3] $msg "test3" msg
+ string tolower $msg
} {1 {couldn't open "test3": no such file or directory}}
test io-40.12 {POSIX open access modes: WRONLY} {
removeFile test3
- string tolower [list [catch {open test3 WRONLY} msg] $msg]
+ set msg [list [catch {open test3 WRONLY} msg] $msg]
+ regsub [file join {} test3] $msg "test3" msg
+ string tolower $msg
} {1 {couldn't open "test3": no such file or directory}}
test io-40.13 {POSIX open access modes: WRONLY} {
makeFile xyzzy test3
@@ -5155,7 +5160,9 @@
} 0
test io-40.14 {POSIX open access modes: RDWR} {
removeFile test3
- string tolower [list [catch {open test3 RDWR} msg] $msg]
+ set msg [list [catch {open test3 RDWR} msg] $msg]
+ regsub [file join {} test3] $msg "test3" msg
+ string tolower $msg
} {1 {couldn't open "test3": no such file or directory}}
test io-40.15 {POSIX open access modes: RDWR} {
makeFile xyzzy test3
diff -r -u3 tcl-tip17/tests/ioCmd.test tcl-tip17-mac/tests/ioCmd.test
--- tcl-tip17/tests/ioCmd.test Tue Apr 11 03:19:01 2000
+++ tcl-tip17-mac/tests/ioCmd.test Fri Jun 22 17:51:10 2001
@@ -361,11 +361,15 @@
} 0
test iocmd-12.2 {POSIX open access modes: RDONLY} {
removeFile test3
- string tolower [list [catch {open test3 RDONLY} msg] $msg]
+ set msg [list [catch {open test3 RDONLY} msg] $msg]
+ regsub [file join {} test3] $msg "test3" msg
+ string tolower $msg
} {1 {couldn't open "test3": no such file or directory}}
test iocmd-12.3 {POSIX open access modes: WRONLY} {
removeFile test3
- string tolower [list [catch {open test3 WRONLY} msg] $msg]
+ set msg [list [catch {open test3 WRONLY} msg] $msg]
+ regsub [file join {} test3] $msg "test3" msg
+ string tolower $msg
} {1 {couldn't open "test3": no such file or directory}}
#
# Test 13.4 relies on assigning the same channel name twice.
@@ -391,7 +395,9 @@
} 0
test iocmd-12.5 {POSIX open access modes: RDWR} {
removeFile test3
- string tolower [list [catch {open test3 RDWR} msg] $msg]
+ set msg [list [catch {open test3 RDWR} msg] $msg]
+ regsub [file join {} test3] $msg "test3" msg
+ string tolower $msg
} {1 {couldn't open "test3": no such file or directory}}
test iocmd-12.6 {POSIX open access modes: errors} {
concat [catch {open test3 "FOO \{BAR BAZ"} msg] $msg\n$errorInfo
@@ -423,7 +429,9 @@
list [catch {open test1 r+1} msg] $msg
} {1 {illegal access mode "r+1"}}
test iocmd-13.6 {errors in open command} {
- string tolower [list [catch {open _non_existent_} msg] $msg $errorCode]
+ set msg [list [catch {open _non_existent_} msg] $msg $errorCode]
+ regsub [file join {} _non_existent_] $msg "_non_existent_" msg
+ string tolower $msg
} {1 {couldn't open "_non_existent_": no such file or directory} {posix enoent {no such file or directory}}}
test iocmd-14.1 {file id parsing errors} {
diff -r -u3 tcl-tip17/tests/proc-old.test tcl-tip17-mac/tests/proc-old.test
--- tcl-tip17/tests/proc-old.test Wed May 3 10:14:36 2000
+++ tcl-tip17-mac/tests/proc-old.test Fri Jun 22 17:51:10 2001
@@ -433,7 +433,9 @@
catch {open _bad_file_name r} msg
return -code error -errorinfo $errorInfo -errorcode $errorCode $msg
}
- normalizeMsg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
+ set msg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
+ regsub -all [file join {} _bad_file_name] $msg "_bad_file_name" msg
+ normalizeMsg $msg
} {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory
while executing
"open _bad_file_name r"
@@ -445,7 +447,9 @@
catch {open _bad_file_name r} msg
return -code error -errorcode $errorCode $msg
}
- normalizeMsg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
+ set msg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
+ regsub -all [file join {} _bad_file_name] $msg "_bad_file_name" msg
+ normalizeMsg $msg
} {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory
while executing
"tproc2"} {posix enoent {no such file or directory}}}
@@ -455,7 +459,9 @@
catch {open _bad_file_name r} msg
return -code error -errorinfo $errorInfo $msg
}
- normalizeMsg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
+ set msg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
+ regsub -all [file join {} _bad_file_name] $msg "_bad_file_name" msg
+ normalizeMsg $msg
} {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory
while executing
"open _bad_file_name r"
@@ -467,7 +473,9 @@
catch {open _bad_file_name r} msg
return -code error $msg
}
- normalizeMsg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
+ set msg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
+ regsub -all [file join {} _bad_file_name] $msg "_bad_file_name" msg
+ normalizeMsg $msg
} {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory
while executing
"tproc2"} none}
