summaryrefslogtreecommitdiffstats
path: root/mac/tclMacChan.c
diff options
context:
space:
mode:
authorrjohnson <rjohnson>1998-03-26 14:45:59 (GMT)
committerrjohnson <rjohnson>1998-03-26 14:45:59 (GMT)
commit2b5738da524e944cda39e24c0a87b745a43bd8c3 (patch)
tree6e8c9473978f6dab66c601e911721a7bd9d70b1b /mac/tclMacChan.c
parentc6a259aeeca4814a97cf6694814c63e74e4e18fa (diff)
downloadtcl-2b5738da524e944cda39e24c0a87b745a43bd8c3.zip
tcl-2b5738da524e944cda39e24c0a87b745a43bd8c3.tar.gz
tcl-2b5738da524e944cda39e24c0a87b745a43bd8c3.tar.bz2
Initial revision
Diffstat (limited to 'mac/tclMacChan.c')
-rw-r--r--mac/tclMacChan.c1356
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;
+}