Initial revision

FossilOrigin-Name: cacdd0f329872d67973970d74c6978730bc24baa

1 files changed, 1356 insertions, 0 deletions

diff --git a/mac/tclMacChan.c b/mac/tclMacChan.c
new file mode 100644
index 0000000..b05d2f5
--- /dev/null
+++ b/mac/tclMacChan.c
@@ -0,0 +1,1356 @@
+/* 
+ * tclMacChan.c
+ *
+ *	Channel drivers for Macintosh channels for the
+ *	console fds.
+ *
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclMacChan.c 1.43 97/06/20 11:27:48
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+#include "tclMacInt.h"
+#include <Aliases.h>
+#include <Errors.h>
+#include <Files.h>
+#include <Gestalt.h>
+#include <Processes.h>
+#include <Strings.h>
+#include <FSpCompat.h>
+#include <MoreFiles.h>
+#include <MoreFilesExtras.h>
+
+/*
+ * The following variable is used to tell whether this module has been
+ * initialized.
+ */
+
+static int initialized = 0;
+
+/*
+ * 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.
+ */
+
+typedef struct FileState {
+    short fileRef;		/* Macintosh file reference number. */
+    Tcl_Channel fileChan;	/* Pointer to the channel for this file. */
+    int watchMask;		/* OR'ed set of flags indicating which events
+    				 * are being watched. */
+    int appendMode;		/* Flag to tell if in O_APPEND mode or not. */
+    int volumeRef;		/* Flag to tell if in O_APPEND mode or not. */
+    int pending;		/* 1 if message is pending on queue. */
+    struct FileState *nextPtr;	/* Pointer to next registered file. */
+} FileState;
+
+/*
+ * The following pointer refers to the head of the list of files managed
+ * that are being watched for file events.
+ */
+
+static FileState *firstFilePtr;
+
+/*
+ * The following structure is what is added to the Tcl event queue when
+ * file events are generated.
+ */
+
+typedef struct FileEvent {
+    Tcl_Event header;		/* Information that is standard for
+				 * all events. */
+    FileState *infoPtr;		/* Pointer to file info structure.  Note
+				 * that we still have to verify that the
+				 * file exists before dereferencing this
+				 * pointer. */
+} FileEvent;
+
+
+/*
+ * Static routines for this file:
+ */
+
+static int		CommonGetHandle _ANSI_ARGS_((ClientData instanceData,
+		            int direction, ClientData *handlePtr));
+static void		CommonWatch _ANSI_ARGS_((ClientData instanceData,
+		            int mask));
+static int		FileBlockMode _ANSI_ARGS_((ClientData instanceData,
+			    int mode));
+static void		FileChannelExitHandler _ANSI_ARGS_((
+		            ClientData clientData));
+static void		FileCheckProc _ANSI_ARGS_((ClientData clientData,
+			    int flags));
+static int		FileClose _ANSI_ARGS_((ClientData instanceData,
+			    Tcl_Interp *interp));
+static int		FileEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
+			    int flags));
+static void		FileInit _ANSI_ARGS_((void));
+static int		FileInput _ANSI_ARGS_((ClientData instanceData,
+			    char *buf, int toRead, int *errorCode));
+static int		FileOutput _ANSI_ARGS_((ClientData instanceData,
+			    char *buf, int toWrite, int *errorCode));
+static int		FileSeek _ANSI_ARGS_((ClientData instanceData,
+			    long offset, int mode, int *errorCode));
+static void		FileSetupProc _ANSI_ARGS_((ClientData clientData,
+			    int flags));
+static int		GetOpenMode _ANSI_ARGS_((Tcl_Interp *interp,
+        		    char *string));
+static Tcl_Channel	OpenFileChannel _ANSI_ARGS_((char *fileName, int mode, 
+			    int permissions, int *errorCodePtr));
+static int		StdIOBlockMode _ANSI_ARGS_((ClientData instanceData,
+			    int mode));
+static int		StdIOClose _ANSI_ARGS_((ClientData instanceData,
+			    Tcl_Interp *interp));
+static int		StdIOInput _ANSI_ARGS_((ClientData instanceData,
+			    char *buf, int toRead, int *errorCode));
+static int		StdIOOutput _ANSI_ARGS_((ClientData instanceData,
+			    char *buf, int toWrite, int *errorCode));
+static int		StdIOSeek _ANSI_ARGS_((ClientData instanceData,
+			    long offset, int mode, int *errorCode));
+static int		StdReady _ANSI_ARGS_((ClientData instanceData,
+		            int mask));
+
+/*
+ * This structure describes the channel type structure for file based IO:
+ */
+
+static Tcl_ChannelType consoleChannelType = {
+    "file",			/* Type name. */
+    StdIOBlockMode,		/* Set blocking/nonblocking mode.*/
+    StdIOClose,			/* Close proc. */
+    StdIOInput,			/* Input proc. */
+    StdIOOutput,		/* Output proc. */
+    StdIOSeek,			/* Seek proc. */
+    NULL,			/* Set option proc. */
+    NULL,			/* Get option proc. */
+    CommonWatch,		/* Initialize notifier. */
+    CommonGetHandle		/* Get OS handles out of channel. */
+};
+
+/*
+ * This variable describes the channel type structure for file based IO.
+ */
+
+static Tcl_ChannelType fileChannelType = {
+    "file",			/* Type name. */
+    FileBlockMode,		/* Set blocking or
+                                 * non-blocking mode.*/
+    FileClose,			/* Close proc. */
+    FileInput,			/* Input proc. */
+    FileOutput,			/* Output proc. */
+    FileSeek,			/* Seek proc. */
+    NULL,			/* Set option proc. */
+    NULL,			/* Get option proc. */
+    CommonWatch,		/* Initialize notifier. */
+    CommonGetHandle		/* Get OS handles out of channel. */
+};
+
+
+/*
+ * Hack to allow Mac Tk to override the TclGetStdChannels function.
+ */
+ 
+typedef void (*TclGetStdChannelsProc) _ANSI_ARGS_((Tcl_Channel *stdinPtr,
+	Tcl_Channel *stdoutPtr, Tcl_Channel *stderrPtr));
+	
+TclGetStdChannelsProc getStdChannelsProc = NULL;
+
+/*
+ * Static variables to hold channels for stdin, stdout and stderr.
+ */
+
+static Tcl_Channel stdinChannel = NULL;
+static Tcl_Channel stdoutChannel = NULL;
+static Tcl_Channel stderrChannel = NULL;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileInit --
+ *
+ *	This function initializes the file channel event source.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Creates a new event source.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FileInit()
+{
+    initialized = 1;
+    firstFilePtr = NULL;
+    Tcl_CreateEventSource(FileSetupProc, FileCheckProc, NULL);
+    Tcl_CreateExitHandler(FileChannelExitHandler, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileChannelExitHandler --
+ *
+ *	This function is called to cleanup the channel driver before
+ *	Tcl is unloaded.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Destroys the communication window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FileChannelExitHandler(
+    ClientData clientData)	/* Old window proc */
+{
+    Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL);
+    initialized = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileSetupProc --
+ *
+ *	This procedure is invoked before Tcl_DoOneEvent blocks waiting
+ *	for an event.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Adjusts the block time if needed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+FileSetupProc(
+    ClientData data,		/* Not used. */
+    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
+{
+    FileState *infoPtr;
+    Tcl_Time blockTime = { 0, 0 };
+
+    if (!(flags & TCL_FILE_EVENTS)) {
+	return;
+    }
+    
+    /*
+     * Check to see if there is a ready file.  If so, poll.
+     */
+
+    for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+	if (infoPtr->watchMask) {
+	    Tcl_SetMaxBlockTime(&blockTime);
+	    break;
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileCheckProc --
+ *
+ *	This procedure is called by Tcl_DoOneEvent to check the file
+ *	event source for events. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May queue an event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FileCheckProc(
+    ClientData data,		/* Not used. */
+    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
+{
+    FileEvent *evPtr;
+    FileState *infoPtr;
+    int sentMsg = 0;
+    Tcl_Time blockTime = { 0, 0 };
+
+    if (!(flags & TCL_FILE_EVENTS)) {
+	return;
+    }
+    
+    /*
+     * Queue events for any ready files that don't already have events
+     * queued (caused by persistent states that won't generate WinSock
+     * events).
+     */
+
+    for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+	if (infoPtr->watchMask && !infoPtr->pending) {
+	    infoPtr->pending = 1;
+	    evPtr = (FileEvent *) ckalloc(sizeof(FileEvent));
+	    evPtr->header.proc = FileEventProc;
+	    evPtr->infoPtr = infoPtr;
+	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
+	}
+    }
+}
+
+/*----------------------------------------------------------------------
+ *
+ * FileEventProc --
+ *
+ *	This function is invoked by Tcl_ServiceEvent when a file event
+ *	reaches the front of the event queue.  This procedure invokes
+ *	Tcl_NotifyChannel on the file.
+ *
+ * Results:
+ *	Returns 1 if the event was handled, meaning it should be removed
+ *	from the queue.  Returns 0 if the event was not handled, meaning
+ *	it should stay on the queue.  The only time the event isn't
+ *	handled is if the TCL_FILE_EVENTS flag bit isn't set.
+ *
+ * Side effects:
+ *	Whatever the notifier callback does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileEventProc(
+    Tcl_Event *evPtr,		/* Event to service. */
+    int flags)			/* Flags that indicate what events to
+				 * handle, such as TCL_FILE_EVENTS. */
+{
+    FileEvent *fileEvPtr = (FileEvent *)evPtr;
+    FileState *infoPtr;
+
+    if (!(flags & TCL_FILE_EVENTS)) {
+	return 0;
+    }
+
+    /*
+     * Search through the list of watched files for the one whose handle
+     * matches the event.  We do this rather than simply dereferencing
+     * the handle in the event so that files can be deleted while the
+     * event is in the queue.
+     */
+
+    for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+	if (fileEvPtr->infoPtr == infoPtr) {
+	    infoPtr->pending = 0;
+	    Tcl_NotifyChannel(infoPtr->fileChan, infoPtr->watchMask);
+	    break;
+	}
+    }
+    return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StdIOBlockMode --
+ *
+ *	Set blocking or non-blocking mode on channel.
+ *
+ * Results:
+ *	0 if successful, errno when failed.
+ *
+ * Side effects:
+ *	Sets the device into blocking or non-blocking mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StdIOBlockMode(
+    ClientData instanceData,		/* Unused. */
+    int mode)				/* The mode to set. */
+{
+    /*
+     * Do not allow putting stdin, stdout or stderr into nonblocking mode.
+     */
+    
+    if (mode == TCL_MODE_NONBLOCKING) {
+	return EFAULT;
+    }
+    
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StdIOClose --
+ *
+ *	Closes the IO channel.
+ *
+ * Results:
+ *	0 if successful, the value of errno if failed.
+ *
+ * Side effects:
+ *	Closes the physical channel
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StdIOClose(
+    ClientData instanceData,	/* Unused. */
+    Tcl_Interp *interp)		/* Unused. */
+{
+    int fd, errorCode = 0;
+
+    /*
+     * Invalidate the stdio cache if necessary.  Note that we assume that
+     * the stdio file and channel pointers will become invalid at the same
+     * time.
+     */
+
+    fd = (int) ((FileState*)instanceData)->fileRef;
+    if (fd == 0) {
+	fd = 0;
+	stdinChannel = NULL;
+    } else if (fd == 1) {
+	stdoutChannel = NULL;
+    } else if (fd == 2) {
+	stderrChannel = NULL;
+    } else {
+	panic("recieved invalid std file");
+    }
+
+    if (close(fd) < 0) {
+	errorCode = errno;
+    }
+
+    return errorCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CommonGetHandle --
+ *
+ *	Called from Tcl_GetChannelFile to retrieve OS handles from inside
+ *	a file based channel.
+ *
+ * Results:
+ *	The appropriate handle or NULL if not present. 
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CommonGetHandle(
+    ClientData instanceData,		/* The file state. */
+    int direction,			/* Which handle to retrieve? */
+    ClientData *handlePtr)
+{
+    if ((direction == TCL_READABLE) || (direction == TCL_WRITABLE)) {
+	*handlePtr = (ClientData) ((FileState*)instanceData)->fileRef;
+	return TCL_OK;
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StdIOInput --
+ *
+ *	Reads input from the IO channel into the buffer given. Returns
+ *	count of how many bytes were actually read, and an error indication.
+ *
+ * Results:
+ *	A count of how many bytes were read is returned and an error
+ *	indication is returned in an output argument.
+ *
+ * Side effects:
+ *	Reads input from the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+StdIOInput(
+    ClientData instanceData,		/* Unused. */
+    char *buf,				/* Where to store data read. */
+    int bufSize,			/* How much space is available
+                                         * in the buffer? */
+    int *errorCode)			/* Where to store error code. */
+{
+    int fd;
+    int bytesRead;			/* How many bytes were read? */
+
+    *errorCode = 0;
+    errno = 0;
+    fd = (int) ((FileState*)instanceData)->fileRef;
+    bytesRead = read(fd, buf, (size_t) bufSize);
+    if (bytesRead > -1) {
+        return bytesRead;
+    }
+    *errorCode = errno;
+    return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StdIOOutput--
+ *
+ *	Writes the given output on the IO channel. Returns count of how
+ *	many characters were actually written, and an error indication.
+ *
+ * Results:
+ *	A count of how many characters were written is returned and an
+ *	error indication is returned in an output argument.
+ *
+ * Side effects:
+ *	Writes output on the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StdIOOutput(
+    ClientData instanceData,		/* Unused. */
+    char *buf,				/* The data buffer. */
+    int toWrite,			/* How many bytes to write? */
+    int *errorCode)			/* Where to store error code. */
+{
+    int written;
+    int fd;
+
+    *errorCode = 0;
+    errno = 0;
+    fd = (int) ((FileState*)instanceData)->fileRef;
+    written = write(fd, buf, (size_t) toWrite);
+    if (written > -1) {
+        return written;
+    }
+    *errorCode = errno;
+    return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StdIOSeek --
+ *
+ *	Seeks on an IO channel. Returns the new position.
+ *
+ * Results:
+ *	-1 if failed, the new position if successful. If failed, it
+ *	also sets *errorCodePtr to the error code.
+ *
+ * Side effects:
+ *	Moves the location at which the channel will be accessed in
+ *	future operations.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StdIOSeek(
+    ClientData instanceData,			/* Unused. */
+    long offset,				/* Offset to seek to. */
+    int mode,					/* Relative to where
+                                                 * should we seek? */
+    int *errorCodePtr)				/* To store error code. */
+{
+    int newLoc;
+    int fd;
+
+    *errorCodePtr = 0;
+    fd = (int) ((FileState*)instanceData)->fileRef;
+    newLoc = lseek(fd, offset, mode);
+    if (newLoc > -1) {
+        return newLoc;
+    }
+    *errorCodePtr = errno;
+    return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_PidObjCmd --
+ *
+ *      This procedure is invoked to process the "pid" Tcl command.
+ *      See the user documentation for details on what it does.
+ *
+ * Results:
+ *      A standard Tcl result.
+ *
+ * Side effects:
+ *      See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+        /* ARGSUSED */
+int
+Tcl_PidObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;           /* Not used. */
+    Tcl_Interp *interp;         /* Current interpreter. */
+    int objc;                   /* Number of arguments. */
+    Tcl_Obj *CONST *objv;       /* Argument strings. */
+{
+    ProcessSerialNumber psn;
+    char buf[20]; 
+    Tcl_Channel chan;
+    Tcl_Obj *resultPtr;
+
+    if (objc > 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
+        return TCL_ERROR;
+    }
+    if (objc == 1) {
+        resultPtr = Tcl_GetObjResult(interp);
+	GetCurrentProcess(&psn);
+	sprintf(buf, "0x%08x%08x", psn.highLongOfPSN, psn.lowLongOfPSN);
+        Tcl_SetStringObj(resultPtr, buf, -1);
+    } else {
+        chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL),
+                NULL);
+        if (chan == (Tcl_Channel) NULL) {
+            return TCL_ERROR;
+        } 
+	/*
+	 * We can't create pipelines on the Mac so
+	 * this will always return an empty list.
+	 */
+    }
+    
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetDefaultStdChannel --
+ *
+ *	Constructs a channel for the specified standard OS handle.
+ *
+ * Results:
+ *	Returns the specified default standard channel, or NULL.
+ *
+ * Side effects:
+ *	May cause the creation of a standard channel and the underlying
+ *	file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+TclGetDefaultStdChannel(
+    int type)			/* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
+{
+    Tcl_Channel channel = NULL;
+    int fd = 0;			/* Initializations needed to prevent */
+    int mode = 0;		/* compiler warning (used before set). */
+    char *bufMode = NULL;
+    char channelName[20];
+    int channelPermissions;
+    FileState *fileState;
+
+    /*
+     * If the channels were not created yet, create them now and
+     * store them in the static variables.
+     */
+
+    switch (type) {
+	case TCL_STDIN:
+	    fd = 0;
+	    channelPermissions = TCL_READABLE;
+	    bufMode = "line";
+	    break;
+	case TCL_STDOUT:
+	    fd = 1;
+	    channelPermissions = TCL_WRITABLE;
+	    bufMode = "line";
+	    break;
+	case TCL_STDERR:
+	    fd = 2;
+	    channelPermissions = TCL_WRITABLE;
+	    bufMode = "none";
+	    break;
+	default:
+	    panic("TclGetDefaultStdChannel: Unexpected channel type");
+	    break;
+    }
+
+    sprintf(channelName, "console%d", (int) fd);
+    fileState = (FileState *) ckalloc((unsigned) sizeof(FileState));
+    channel = Tcl_CreateChannel(&consoleChannelType, channelName,
+	    (ClientData) fileState, channelPermissions);
+    fileState->fileChan = channel;
+    fileState->fileRef = fd;
+
+    /*
+     * Set up the normal channel options for stdio handles.
+     */
+
+    Tcl_SetChannelOption(NULL, channel, "-translation", "cr");
+    Tcl_SetChannelOption(NULL, channel, "-buffering", bufMode);
+    
+    return channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_OpenFileChannel --
+ *
+ *	Open an File based channel on Unix systems.
+ *
+ * Results:
+ *	The new channel or NULL. If NULL, the output argument
+ *	errorCodePtr is set to a POSIX error.
+ *
+ * Side effects:
+ *	May open the channel and may cause creation of a file on the
+ *	file system.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_OpenFileChannel(
+    Tcl_Interp *interp,			/* Interpreter for error reporting;
+                                         * can be NULL. */
+    char *fileName,			/* Name of file to open. */
+    char *modeString,			/* A list of POSIX open modes or
+                                         * a string such as "rw". */
+    int permissions)			/* If the open involves creating a
+                                         * file, with what modes to create
+                                         * it? */
+{
+    Tcl_Channel chan;
+    int mode;
+    char *nativeName;
+    Tcl_DString buffer;
+    int errorCode;
+    
+    mode = GetOpenMode(interp, modeString);
+    if (mode == -1) {
+	return NULL;
+    }
+
+    nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
+    if (nativeName == NULL) {
+	return NULL;
+    }
+
+    chan = OpenFileChannel(nativeName, mode, permissions, &errorCode);
+    Tcl_DStringFree(&buffer);
+
+    if (chan == NULL) {
+	Tcl_SetErrno(errorCode);
+	if (interp != (Tcl_Interp *) NULL) {
+            Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ",
+                    Tcl_PosixError(interp), (char *) NULL);
+        }
+	return NULL;
+    }
+    
+    return chan;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * OpenFileChannel--
+ *
+ *	Opens a Macintosh file and creates a Tcl channel to control it.
+ *
+ * Results:
+ *	A Tcl channel.
+ *
+ * Side effects:
+ *	Will open a Macintosh file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Channel
+OpenFileChannel(
+    char *fileName,			/* Name of file to open. */
+    int mode,				/* Mode for opening file. */
+    int permissions,			/* If the open involves creating a
+                                         * file, with what modes to create
+                                         * it? */
+    int *errorCodePtr)			/* Where to store error code. */
+{
+    int channelPermissions;
+    Tcl_Channel chan;
+    char macPermision;
+    FSSpec fileSpec;
+    OSErr err;
+    short fileRef;
+    FileState *fileState;
+    char channelName[64];
+    
+    /*
+     * Note we use fsRdWrShPerm instead of fsRdWrPerm which allows shared
+     * writes on a file.  This isn't common on a mac but is common with 
+     * Windows and UNIX and the feature is used by Tcl.
+     */
+
+    switch (mode & (TCL_RDONLY | TCL_WRONLY | TCL_RDWR)) {
+	case TCL_RDWR:
+	    channelPermissions = (TCL_READABLE | TCL_WRITABLE);
+	    macPermision = fsRdWrShPerm;
+	    break;
+	case TCL_WRONLY:
+	    /*
+	     * Mac's fsRdPerm permission actually defaults to fsRdWrPerm because
+	     * the Mac OS doesn't realy support write only access.  We explicitly
+	     * set the permission fsRdWrShPerm so that we can have shared write
+	     * access.
+	     */
+	    channelPermissions = TCL_WRITABLE;
+	    macPermision = fsRdWrShPerm;
+	    break;
+	case TCL_RDONLY:
+	default:
+	    channelPermissions = TCL_READABLE;
+	    macPermision = fsRdPerm;
+	    break;
+    }
+     
+    err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
+    if ((err != noErr) && (err != fnfErr)) {
+	*errorCodePtr = errno = TclMacOSErrorToPosixError(err);
+	Tcl_SetErrno(errno);
+	return NULL;
+    }
+
+    if ((err == fnfErr) && (mode & TCL_CREAT)) {
+	err = HCreate(fileSpec.vRefNum, fileSpec.parID, fileSpec.name, 'MPW ', 'TEXT');
+	if (err != noErr) {
+	    *errorCodePtr = errno = TclMacOSErrorToPosixError(err);
+	    Tcl_SetErrno(errno);
+	    return NULL;
+	}
+    } else if ((mode & TCL_CREAT) && (mode & TCL_EXCL)) {
+        *errorCodePtr = errno = EEXIST;
+	Tcl_SetErrno(errno);
+        return NULL;
+    }
+
+    err = HOpenDF(fileSpec.vRefNum, fileSpec.parID, fileSpec.name, macPermision, &fileRef);
+    if (err != noErr) {
+	*errorCodePtr = errno = TclMacOSErrorToPosixError(err);
+	Tcl_SetErrno(errno);
+	return NULL;
+    }
+
+    if (mode & TCL_TRUNC) {
+	SetEOF(fileRef, 0);
+    }
+    
+    sprintf(channelName, "file%d", (int) fileRef);
+    fileState = (FileState *) ckalloc((unsigned) sizeof(FileState));
+    chan = Tcl_CreateChannel(&fileChannelType, channelName, 
+	(ClientData) fileState, channelPermissions);
+    if (chan == (Tcl_Channel) NULL) {
+	*errorCodePtr = errno = EFAULT;
+	Tcl_SetErrno(errno);
+	FSClose(fileRef);
+	ckfree((char *) fileState);
+        return NULL;
+    }
+
+    fileState->fileChan = chan;
+    fileState->volumeRef = fileSpec.vRefNum;
+    fileState->fileRef = fileRef;
+    fileState->pending = 0;
+    fileState->watchMask = 0;
+    if (mode & TCL_ALWAYS_APPEND) {
+	fileState->appendMode = true;
+    } else {
+	fileState->appendMode = false;
+    }
+        
+    if ((mode & TCL_ALWAYS_APPEND) || (mode & TCL_APPEND)) {
+        if (Tcl_Seek(chan, 0, SEEK_END) < 0) {
+	    *errorCodePtr = errno = EFAULT;
+	    Tcl_SetErrno(errno);
+            Tcl_Close(NULL, chan);
+            FSClose(fileRef);
+            ckfree((char *) fileState);
+            return NULL;
+        }
+    }
+    
+    return chan;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileBlockMode --
+ *
+ *	Set blocking or non-blocking mode on channel.  Macintosh files
+ *	can never really be set to blocking or non-blocking modes.
+ *	However, we don't generate an error - we just return success.
+ *
+ * Results:
+ *	0 if successful, errno when failed.
+ *
+ * Side effects:
+ *	Sets the device into blocking or non-blocking mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileBlockMode(
+    ClientData instanceData,		/* Unused. */
+    int mode)				/* The mode to set. */
+{
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileClose --
+ *
+ *	Closes the IO channel.
+ *
+ * Results:
+ *	0 if successful, the value of errno if failed.
+ *
+ * Side effects:
+ *	Closes the physical channel
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileClose(
+    ClientData instanceData,	/* Unused. */
+    Tcl_Interp *interp)		/* Unused. */
+{
+    FileState *fileState = (FileState *) instanceData;
+    int errorCode = 0;
+    OSErr err;
+
+    err = FSClose(fileState->fileRef);
+    FlushVol(NULL, fileState->volumeRef);
+    if (err != noErr) {
+	errorCode = errno = TclMacOSErrorToPosixError(err);
+	panic("error during file close");
+    }
+
+    ckfree((char *) fileState);
+    Tcl_SetErrno(errorCode);
+    return errorCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileInput --
+ *
+ *	Reads input from the IO channel into the buffer given. Returns
+ *	count of how many bytes were actually read, and an error indication.
+ *
+ * Results:
+ *	A count of how many bytes were read is returned and an error
+ *	indication is returned in an output argument.
+ *
+ * Side effects:
+ *	Reads input from the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+FileInput(
+    ClientData instanceData,	/* Unused. */
+    char *buffer,				/* Where to store data read. */
+    int bufSize,				/* How much space is available
+                                 * in the buffer? */
+    int *errorCodePtr)			/* Where to store error code. */
+{
+    FileState *fileState = (FileState *) instanceData;
+    OSErr err;
+    long length = bufSize;
+
+    *errorCodePtr = 0;
+    errno = 0;
+    err = FSRead(fileState->fileRef, &length, buffer);
+    if ((err == noErr) || (err == eofErr)) {
+	return length;
+    } else {
+	switch (err) {
+	    case ioErr:
+		*errorCodePtr = errno = EIO;
+	    case afpAccessDenied:
+		*errorCodePtr = errno = EACCES;
+	    default:
+		*errorCodePtr = errno = EINVAL;
+	}
+        return -1;	
+    }
+    *errorCodePtr = errno;
+    return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileOutput--
+ *
+ *	Writes the given output on the IO channel. Returns count of how
+ *	many characters were actually written, and an error indication.
+ *
+ * Results:
+ *	A count of how many characters were written is returned and an
+ *	error indication is returned in an output argument.
+ *
+ * Side effects:
+ *	Writes output on the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileOutput(
+    ClientData instanceData,		/* Unused. */
+    char *buffer,			/* The data buffer. */
+    int toWrite,			/* How many bytes to write? */
+    int *errorCodePtr)			/* Where to store error code. */
+{
+    FileState *fileState = (FileState *) instanceData;
+    long length = toWrite;
+    OSErr err;
+
+    *errorCodePtr = 0;
+    errno = 0;
+    
+    if (fileState->appendMode == true) {
+	FileSeek(instanceData, 0, SEEK_END, errorCodePtr);
+	*errorCodePtr = 0;
+    }
+    
+    err = FSWrite(fileState->fileRef, &length, buffer);
+    if (err == noErr) {
+	err = FlushFile(fileState->fileRef);
+    } else {
+	*errorCodePtr = errno = TclMacOSErrorToPosixError(err);
+	return -1;
+    }
+    return length;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileSeek --
+ *
+ *	Seeks on an IO channel. Returns the new position.
+ *
+ * Results:
+ *	-1 if failed, the new position if successful. If failed, it
+ *	also sets *errorCodePtr to the error code.
+ *
+ * Side effects:
+ *	Moves the location at which the channel will be accessed in
+ *	future operations.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileSeek(
+    ClientData instanceData,	/* Unused. */
+    long offset,				/* Offset to seek to. */
+    int mode,					/* Relative to where
+                                 * should we seek? */
+    int *errorCodePtr)			/* To store error code. */
+{
+    FileState *fileState = (FileState *) instanceData;
+    IOParam pb;
+    OSErr err;
+
+    *errorCodePtr = 0;
+    pb.ioCompletion = NULL;
+    pb.ioRefNum = fileState->fileRef;
+    if (mode == SEEK_SET) {
+	pb.ioPosMode = fsFromStart;
+    } else if (mode == SEEK_END) {
+	pb.ioPosMode = fsFromLEOF;
+    } else if (mode == SEEK_CUR) {
+	err = PBGetFPosSync((ParmBlkPtr) &pb);
+	if (pb.ioResult == noErr) {
+	    if (offset == 0) {
+		return pb.ioPosOffset;
+	    }
+	    offset += pb.ioPosOffset;
+	}
+	pb.ioPosMode = fsFromStart;
+    }
+    pb.ioPosOffset = offset;
+    err = PBSetFPosSync((ParmBlkPtr) &pb);
+    if (pb.ioResult == noErr){
+	return pb.ioPosOffset;
+    } else if (pb.ioResult == eofErr) {
+	long currentEOF, newEOF;
+	long buffer, i, length;
+	
+	err = PBGetEOFSync((ParmBlkPtr) &pb);
+	currentEOF = (long) pb.ioMisc;
+	if (mode == SEEK_SET) {
+	    newEOF = offset;
+	} else if (mode == SEEK_END) {
+	    newEOF = offset + currentEOF;
+	} else if (mode == SEEK_CUR) {
+	    err = PBGetFPosSync((ParmBlkPtr) &pb);
+	    newEOF = offset + pb.ioPosOffset;
+	}
+	
+	/*
+	 * Write 0's to the new EOF.
+	 */
+	pb.ioPosOffset = 0;
+	pb.ioPosMode = fsFromLEOF;
+	err = PBGetFPosSync((ParmBlkPtr) &pb);
+	length = 1;
+	buffer = 0;
+	for (i = 0; i < (newEOF - currentEOF); i++) {
+	    err = FSWrite(fileState->fileRef, &length, &buffer);
+	}
+	err = PBGetFPosSync((ParmBlkPtr) &pb);
+	if (pb.ioResult == noErr){
+	    return pb.ioPosOffset;
+	}
+    }
+    *errorCodePtr = errno = TclMacOSErrorToPosixError(err);
+    return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CommonWatch --
+ *
+ *	Initialize the notifier to watch handles from this channel.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CommonWatch(
+    ClientData instanceData,		/* The file state. */
+    int mask)				/* Events of interest; an OR-ed
+                                         * combination of TCL_READABLE,
+                                         * TCL_WRITABLE and TCL_EXCEPTION. */
+{
+    FileState **nextPtrPtr, *ptr;
+    FileState *infoPtr = (FileState *) instanceData;
+    int oldMask = infoPtr->watchMask;
+
+    if (!initialized) {
+	FileInit();
+    }
+
+    infoPtr->watchMask = mask;
+    if (infoPtr->watchMask) {
+	if (!oldMask) {
+	    infoPtr->nextPtr = firstFilePtr;
+	    firstFilePtr = infoPtr;
+	}
+    } else {
+	if (oldMask) {
+	    /*
+	     * Remove the file from the list of watched files.
+	     */
+
+	    for (nextPtrPtr = &firstFilePtr, ptr = *nextPtrPtr;
+		 ptr != NULL;
+		 nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) {
+		if (infoPtr == ptr) {
+		    *nextPtrPtr = ptr->nextPtr;
+		    break;
+		}
+	    }
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 interp->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. */
+    char *string)			/* Mode string, e.g. "r+" or
+					 * "RDONLY CREAT". */
+{
+    int mode, modeArgc, c, i, gotRW;
+    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;
+    if (islower(UCHAR(string[0]))) {
+	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;
+}