summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclIO.c324
-rw-r--r--generic/tclIO.h6
-rw-r--r--generic/tclIOCmd.c130
3 files changed, 344 insertions, 116 deletions
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 5acef55..0e8346d 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIO.c,v 1.132 2007/11/28 16:04:31 dgp Exp $
+ * RCS: @(#) $Id: tclIO.c,v 1.133 2007/12/05 21:47:26 hobbs Exp $
*/
#include "tclInt.h"
@@ -195,6 +195,32 @@ static void CutChannel(Tcl_Channel chan);
#define HaveOpt(minLength, nameString) \
((len > (minLength)) && (optionName[1] == (nameString)[1]) \
&& (strncmp(optionName, (nameString), len) == 0))
+
+/*
+ * The ChannelObjType type. We actually store the ChannelState structure
+ * as that lives longest and we want to return the bottomChanPtr when
+ * requested (consistent with Tcl_GetChannel). The setFromAny and
+ * updateString can be NULL as they should not be called.
+ */
+
+static void DupChannelIntRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
+static int SetChannelFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static void UpdateStringOfChannel(Tcl_Obj *objPtr);
+static void FreeChannelIntRep(Tcl_Obj *objPtr);
+
+Tcl_ObjType tclChannelType = {
+ "channel", /* name for this type */
+ FreeChannelIntRep, /* freeIntRepProc */
+ DupChannelIntRep, /* dupIntRepProc */
+ NULL, /* updateStringProc UpdateStringOfChannel */
+ NULL /* setFromAnyProc SetChannelFromAny */
+};
+
+#define GET_CHANNELSTATE(objPtr) \
+ ((ChannelState *) (objPtr)->internalRep.otherValuePtr)
+#define SET_CHANNELSTATE(objPtr, storePtr) \
+ ((objPtr)->internalRep.otherValuePtr = (void *) (storePtr))
+
/*
*---------------------------------------------------------------------------
@@ -673,6 +699,7 @@ DeleteChannelTable(
*/
Tcl_DeleteHashEntry(hPtr);
+ SetFlag(statePtr, CHANNEL_TAINTED);
statePtr->refCount--;
if (statePtr->refCount <= 0) {
if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
@@ -1021,6 +1048,7 @@ DetachChannel(
return TCL_ERROR;
}
Tcl_DeleteHashEntry(hPtr);
+ SetFlag(statePtr, CHANNEL_TAINTED);
/*
* Remove channel handlers that refer to this interpreter, so that
@@ -1121,6 +1149,54 @@ Tcl_GetChannel(
}
/*
+ *---------------------------------------------------------------------------
+ *
+ * TclGetChannelFromObj --
+ *
+ * Finds an existing Tcl_Channel structure by name in a given
+ * interpreter. This function is public because it is used by
+ * channel-type-specific functions.
+ *
+ * Results:
+ * A Tcl_Channel or NULL on failure. If failed, interp's result object
+ * contains an error message. *modePtr is filled with the modes in which
+ * the channel was opened.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclGetChannelFromObj(
+ Tcl_Interp *interp, /* Interpreter in which to find or create the
+ * channel. */
+ Tcl_Obj *objPtr,
+ Tcl_Channel *channelPtr,
+ int *modePtr, /* Where to store the mode in which the
+ * channel was opened? Will contain an ORed
+ * combination of TCL_READABLE and
+ * TCL_WRITABLE, if non-NULL. */
+ int flags)
+{
+ ChannelState *statePtr;
+
+ if (SetChannelFromAny(interp, objPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ statePtr = GET_CHANNELSTATE(objPtr);
+ *channelPtr = (Tcl_Channel) (statePtr->bottomChanPtr);
+
+ if (modePtr != NULL) {
+ *modePtr = (statePtr->flags & (TCL_READABLE|TCL_WRITABLE));
+ }
+
+ return TCL_OK;
+}
+
+/*
*----------------------------------------------------------------------
*
* Tcl_CreateChannel --
@@ -3337,11 +3413,13 @@ WriteBytes(
/* State info for channel */
ChannelBuffer *bufPtr;
char *dst;
- int dstMax, sawLF, savedLF, total, dstLen, toWrite;
+ int dstMax, sawLF, savedLF, total, dstLen, toWrite, translate;
total = 0;
sawLF = 0;
savedLF = 0;
+ translate = (statePtr->flags & CHANNEL_LINEBUFFERED)
+ || (statePtr->outputTranslation != TCL_TRANSLATE_LF);
/*
* Loop over all bytes in src, storing them in output buffer with proper
@@ -3363,27 +3441,32 @@ WriteBytes(
toWrite = srcLen;
}
- if (savedLF) {
- /*
- * A '\n' was left over from last call to TranslateOutputEOL() and
- * we need to store it in this buffer. If the channel is
- * line-based, we will need to flush it.
- */
+ if (translate) {
+ if (savedLF) {
+ /*
+ * A '\n' was left over from last call to TranslateOutputEOL()
+ * and we need to store it in this buffer. If the channel is
+ * line-based, we will need to flush it.
+ */
- *dst++ = '\n';
- dstLen--;
- sawLF++;
- }
- if (TranslateOutputEOL(statePtr, dst, src, &dstLen, &toWrite)) {
- sawLF++;
+ *dst++ = '\n';
+ dstLen--;
+ sawLF++;
+ }
+ if (TranslateOutputEOL(statePtr, dst, src, &dstLen, &toWrite)) {
+ sawLF++;
+ }
+ dstLen += savedLF;
+ savedLF = 0;
+ if (dstLen > dstMax) {
+ savedLF = 1;
+ dstLen = dstMax;
+ }
+ } else {
+ memcpy(dst, src, toWrite);
+ dstLen = toWrite;
}
- dstLen += savedLF;
- savedLF = 0;
- if (dstLen > dstMax) {
- savedLF = 1;
- dstLen = dstMax;
- }
bufPtr->nextAdded += dstLen;
if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
return -1;
@@ -3429,7 +3512,7 @@ WriteChars(
char *dst, *stage;
int saved, savedLF, sawLF, total, dstLen, stageMax, dstWrote;
int stageLen, toWrite, stageRead, endEncoding, result;
- int consumedSomething;
+ int consumedSomething, translate;
Tcl_Encoding encoding;
char safe[BUFFER_PADDING];
@@ -3445,6 +3528,9 @@ WriteChars(
endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0);
+ translate = (statePtr->flags & CHANNEL_LINEBUFFERED)
+ || (statePtr->outputTranslation != TCL_TRANSLATE_LF);
+
/*
* Loop over all UTF-8 characters in src, storing them in staging buffer
* with proper EOL translation.
@@ -3462,29 +3548,34 @@ WriteChars(
toWrite = srcLen;
}
- if (savedLF) {
- /*
- * A '\n' was left over from last call to TranslateOutputEOL() and
- * we need to store it in the staging buffer. If the channel is
- * line-based, we will need to flush the output buffer (after
- * translating the staging buffer).
- */
+ if (translate) {
+ if (savedLF) {
+ /*
+ * A '\n' was left over from last call to TranslateOutputEOL()
+ * and we need to store it in the staging buffer. If the channel
+ * is line-based, we will need to flush the output buffer (after
+ * translating the staging buffer).
+ */
- *stage++ = '\n';
- stageLen--;
- sawLF++;
- }
- if (TranslateOutputEOL(statePtr, stage, src, &stageLen, &toWrite)) {
- sawLF++;
- }
+ *stage++ = '\n';
+ stageLen--;
+ sawLF++;
+ }
+ if (TranslateOutputEOL(statePtr, stage, src, &stageLen, &toWrite)) {
+ sawLF++;
+ }
- stage -= savedLF;
- stageLen += savedLF;
- savedLF = 0;
+ stage -= savedLF;
+ stageLen += savedLF;
+ savedLF = 0;
- if (stageLen > stageMax) {
- savedLF = 1;
- stageLen = stageMax;
+ if (stageLen > stageMax) {
+ savedLF = 1;
+ stageLen = stageMax;
+ }
+ } else {
+ memcpy(stage, src, toWrite);
+ stageLen = toWrite;
}
src += toWrite;
srcLen -= toWrite;
@@ -10456,6 +10547,157 @@ Tcl_ChannelTruncateProc(
}
}
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupChannelIntRep --
+ *
+ * Initialize the internal representation of a new Tcl_Obj to a copy of
+ * the internal representation of an existing string object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * copyPtr's internal rep is set to a copy of srcPtr's internal
+ * representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupChannelIntRep(
+ register Tcl_Obj *srcPtr, /* Object with internal rep to copy. Must have
+ * an internal rep of type "Channel". */
+ register Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not
+ * currently have an internal rep.*/
+{
+ ChannelState *statePtr = GET_CHANNELSTATE(srcPtr);
+ SET_CHANNELSTATE(copyPtr, statePtr);
+ Tcl_Preserve((ClientData) statePtr);
+ copyPtr->typePtr = &tclChannelType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetChannelFromAny --
+ *
+ * Create an internal representation of type "Channel" for an object.
+ *
+ * Results:
+ * This operation always succeeds and returns TCL_OK.
+ *
+ * Side effects:
+ * Any old internal reputation for objPtr is freed and the internal
+ * representation is set to "Channel".
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetChannelFromAny(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ register Tcl_Obj *objPtr) /* The object to convert. */
+{
+ ChannelState *statePtr;
+
+ if (objPtr->typePtr == &tclChannelType) {
+ /*
+ * The channel is valid until any call to DetachChannel occurs.
+ * Ensure consistency checks are done.
+ */
+ statePtr = GET_CHANNELSTATE(objPtr);
+ if (statePtr->flags & (CHANNEL_TAINTED|CHANNEL_CLOSED)) {
+ ResetFlag(statePtr, CHANNEL_TAINTED);
+ Tcl_Release((ClientData) statePtr);
+ UpdateStringOfChannel(objPtr);
+ objPtr->typePtr = NULL;
+ }
+ }
+ if (objPtr->typePtr != &tclChannelType) {
+ Tcl_Channel chan;
+
+ if (objPtr->typePtr != NULL) {
+ if (objPtr->bytes == NULL) {
+ objPtr->typePtr->updateStringProc(objPtr);
+ }
+ TclFreeIntRep(objPtr);
+ }
+
+ chan = Tcl_GetChannel(interp, objPtr->bytes, NULL);
+ if (chan == NULL) {
+ return TCL_ERROR;
+ }
+
+ statePtr = ((Channel *)chan)->state;
+ Tcl_Preserve((ClientData) statePtr);
+ SET_CHANNELSTATE(objPtr, statePtr);
+ objPtr->typePtr = &tclChannelType;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfChannel --
+ *
+ * Update the string representation for an object whose internal
+ * representation is "Channel".
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The object's string may be set by converting its Unicode represention
+ * to UTF format.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfChannel(
+ Tcl_Obj *objPtr) /* Object with string rep to update. */
+{
+ if (objPtr->bytes == NULL) {
+ ChannelState *statePtr = GET_CHANNELSTATE(objPtr);
+ const char *name = statePtr->channelName;
+ if (name) {
+ size_t len = strlen(name);
+ objPtr->bytes = (char *) ckalloc(len + 1);
+ objPtr->length = len;
+ memcpy(objPtr->bytes, name, len);
+ } else {
+ objPtr->bytes = tclEmptyStringRep;
+ objPtr->length = 0;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeChannelIntRep --
+ *
+ * Release statePtr storage.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May cause state to be freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeChannelIntRep(
+ Tcl_Obj *objPtr) /* Object with internal rep to free. */
+{
+ Tcl_Release((ClientData) GET_CHANNELSTATE(objPtr));
+}
+
#if 0
/*
* For future debugging work, a simple function to print the flags of a
diff --git a/generic/tclIO.h b/generic/tclIO.h
index f7afdc5..2b4fd63 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIO.h,v 1.9 2005/10/13 00:56:59 dkf Exp $
+ * RCS: @(#) $Id: tclIO.h,v 1.10 2007/12/05 21:47:27 hobbs Exp $
*/
/*
@@ -334,6 +334,10 @@ typedef struct ChannelState {
* usable, but it may not be closed
* again from within the close
* handler. */
+#define CHANNEL_TAINTED (1<<20) /* Channel stack structure has changed.
+ * Used by Channel Tcl_Obj type to
+ * determine if we have to revalidate
+ * the channel. */
/*
* For each channel handler registered in a call to Tcl_CreateChannelHandler,
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index ceed522..44b3b1d 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIOCmd.c,v 1.47 2007/11/19 14:50:55 dkf Exp $
+ * RCS: @(#) $Id: tclIOCmd.c,v 1.48 2007/12/05 21:47:27 hobbs Exp $
*/
#include "tclInt.h"
@@ -64,6 +64,7 @@ Tcl_PutsObjCmd(
{
Tcl_Channel chan; /* The channel to puts on. */
Tcl_Obj *string; /* String to write. */
+ Tcl_Obj *chanObjPtr = NULL; /* channel object. */
int newline; /* Add a newline at end? */
const char *channelId; /* Name of channel for puts. */
int result; /* Result of puts operation. */
@@ -83,6 +84,7 @@ Tcl_PutsObjCmd(
} else {
newline = 1;
channelId = TclGetString(objv[1]);
+ chanObjPtr = objv[1];
}
string = objv[2];
break;
@@ -90,6 +92,7 @@ Tcl_PutsObjCmd(
case 4: /* [puts -nonewline $chan $x] or [puts $chan $x nonewline] */
if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
channelId = TclGetString(objv[2]);
+ chanObjPtr = objv[2];
string = objv[3];
} else {
/*
@@ -109,6 +112,7 @@ Tcl_PutsObjCmd(
return TCL_ERROR;
}
channelId = TclGetString(objv[1]);
+ chanObjPtr = objv[1];
string = objv[2];
}
newline = 0;
@@ -120,9 +124,16 @@ Tcl_PutsObjCmd(
return TCL_ERROR;
}
- chan = Tcl_GetChannel(interp, channelId, &mode);
- if (chan == NULL) {
- return TCL_ERROR;
+ if (chanObjPtr != NULL) {
+ if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ chan = Tcl_GetChannel(interp, channelId, &mode);
+ if (chan == NULL) {
+ return TCL_ERROR;
+ }
}
if ((mode & TCL_WRITABLE) == 0) {
Tcl_AppendResult(interp, "channel \"", channelId,
@@ -182,21 +193,20 @@ Tcl_FlushObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
+ Tcl_Obj *chanObjPtr;
Tcl_Channel chan; /* The channel to flush on. */
- char *channelId;
int mode;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId");
return TCL_ERROR;
}
- channelId = TclGetString(objv[1]);
- chan = Tcl_GetChannel(interp, channelId, &mode);
- if (chan == NULL) {
+ chanObjPtr = objv[1];
+ if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
if ((mode & TCL_WRITABLE) == 0) {
- Tcl_AppendResult(interp, "channel \"", channelId,
+ Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
"\" wasn't opened for writing", NULL);
return TCL_ERROR;
}
@@ -210,7 +220,8 @@ Tcl_FlushObjCmd(
*/
if (!TclChanCaughtErrorBypass(interp, chan)) {
- Tcl_AppendResult(interp, "error flushing \"", channelId, "\": ",
+ Tcl_AppendResult(interp, "error flushing \"",
+ TclGetString(chanObjPtr), "\": ",
Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;
@@ -246,20 +257,18 @@ Tcl_GetsObjCmd(
Tcl_Channel chan; /* The channel to read from. */
int lineLen; /* Length of line just read. */
int mode; /* Mode in which channel is opened. */
- char *name;
- Tcl_Obj *linePtr;
+ Tcl_Obj *linePtr, *chanObjPtr;
if ((objc != 2) && (objc != 3)) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?");
return TCL_ERROR;
}
- name = TclGetString(objv[1]);
- chan = Tcl_GetChannel(interp, name, &mode);
- if (chan == NULL) {
+ chanObjPtr = objv[1];
+ if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
if ((mode & TCL_READABLE) == 0) {
- Tcl_AppendResult(interp, "channel \"", name,
+ Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
"\" wasn't opened for reading", NULL);
return TCL_ERROR;
}
@@ -279,7 +288,8 @@ Tcl_GetsObjCmd(
if (!TclChanCaughtErrorBypass(interp, chan)) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "error reading \"", name, "\": ",
+ Tcl_AppendResult(interp, "error reading \"",
+ TclGetString(chanObjPtr), "\": ",
Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;
@@ -329,8 +339,7 @@ Tcl_ReadObjCmd(
int toRead; /* How many bytes to read? */
int charactersRead; /* How many characters were read? */
int mode; /* Mode in which channel is opened. */
- char *name;
- Tcl_Obj *resultPtr;
+ Tcl_Obj *resultPtr, *chanObjPtr;
if ((objc != 2) && (objc != 3)) {
Interp *iPtr;
@@ -361,13 +370,12 @@ Tcl_ReadObjCmd(
goto argerror;
}
- name = TclGetString(objv[i]);
- chan = Tcl_GetChannel(interp, name, &mode);
- if (chan == NULL) {
+ chanObjPtr = objv[i];
+ if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
if ((mode & TCL_READABLE) == 0) {
- Tcl_AppendResult(interp, "channel \"", name,
+ Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
"\" wasn't opened for reading", NULL);
return TCL_ERROR;
}
@@ -409,7 +417,8 @@ Tcl_ReadObjCmd(
if (!TclChanCaughtErrorBypass(interp, chan)) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "error reading \"", name, "\": ",
+ Tcl_AppendResult(interp, "error reading \"",
+ TclGetString(chanObjPtr), "\": ",
Tcl_PosixError(interp), NULL);
}
Tcl_DecrRefCount(resultPtr);
@@ -464,7 +473,6 @@ Tcl_SeekObjCmd(
Tcl_WideInt offset; /* Where to seek? */
int mode; /* How to seek? */
Tcl_WideInt result; /* Of calling Tcl_Seek. */
- char *chanName;
int optionIndex;
static const char *originOptions[] = {
"start", "current", "end", NULL
@@ -475,9 +483,7 @@ Tcl_SeekObjCmd(
Tcl_WrongNumArgs(interp, 1, objv, "channelId offset ?origin?");
return TCL_ERROR;
}
- chanName = TclGetString(objv[1]);
- chan = Tcl_GetChannel(interp, chanName, NULL);
- if (chan == NULL) {
+ if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
return TCL_ERROR;
}
if (Tcl_GetWideIntFromObj(interp, objv[2], &offset) != TCL_OK) {
@@ -501,8 +507,9 @@ Tcl_SeekObjCmd(
* regular message if nothing was found in the bypass.
*/
if (!TclChanCaughtErrorBypass(interp, chan)) {
- Tcl_AppendResult(interp, "error during seek on \"", chanName,
- "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_AppendResult(interp, "error during seek on \"",
+ TclGetString(objv[1]), "\": ",
+ Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;
}
@@ -535,7 +542,6 @@ Tcl_TellObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan; /* The channel to tell on. */
- char *chanName;
Tcl_WideInt newLoc;
if (objc != 2) {
@@ -548,9 +554,7 @@ Tcl_TellObjCmd(
* channel table of this interpreter.
*/
- chanName = TclGetString(objv[1]);
- chan = Tcl_GetChannel(interp, chanName, NULL);
- if (chan == NULL) {
+ if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
return TCL_ERROR;
}
@@ -596,16 +600,13 @@ Tcl_CloseObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan; /* The channel to close. */
- char *arg;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId");
return TCL_ERROR;
}
- arg = TclGetString(objv[1]);
- chan = Tcl_GetChannel(interp, arg, NULL);
- if (chan == NULL) {
+ if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
return TCL_ERROR;
}
@@ -664,7 +665,7 @@ Tcl_FconfigureObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- char *chanName, *optionName, *valueName;
+ char *optionName, *valueName;
Tcl_Channel chan; /* The channel to set a mode on. */
int i; /* Iterate over arg-value pairs. */
@@ -674,9 +675,7 @@ Tcl_FconfigureObjCmd(
return TCL_ERROR;
}
- chanName = TclGetString(objv[1]);
- chan = Tcl_GetChannel(interp, chanName, NULL);
- if (chan == NULL) {
+ if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
return TCL_ERROR;
}
@@ -744,17 +743,13 @@ Tcl_EofObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan;
- int dummy;
- char *arg;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId");
return TCL_ERROR;
}
- arg = TclGetString(objv[1]);
- chan = Tcl_GetChannel(interp, arg, &dummy);
- if (chan == NULL) {
+ if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
return TCL_ERROR;
}
@@ -963,20 +958,17 @@ Tcl_FblockedObjCmd(
{
Tcl_Channel chan;
int mode;
- char *arg;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId");
return TCL_ERROR;
}
- arg = TclGetString(objv[1]);
- chan = Tcl_GetChannel(interp, arg, &mode);
- if (chan == NULL) {
+ if (TclGetChannelFromObj(interp, objv[1], &chan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
if ((mode & TCL_READABLE) == 0) {
- Tcl_AppendResult(interp, "channel \"", arg,
+ Tcl_AppendResult(interp, "channel \"", TclGetString(objv[1]),
"\" wasn't opened for reading", NULL);
return TCL_ERROR;
}
@@ -1559,7 +1551,6 @@ Tcl_FcopyObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel inChan, outChan;
- const char *arg;
int mode, i, toRead, index;
Tcl_Obj *cmdPtr;
static const char* switches[] = { "-size", "-command", NULL };
@@ -1576,23 +1567,19 @@ Tcl_FcopyObjCmd(
* writable, as appropriate.
*/
- arg = TclGetString(objv[1]);
- inChan = Tcl_GetChannel(interp, arg, &mode);
- if (inChan == NULL) {
+ if (TclGetChannelFromObj(interp, objv[1], &inChan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
if ((mode & TCL_READABLE) == 0) {
- Tcl_AppendResult(interp, "channel \"", arg,
+ Tcl_AppendResult(interp, "channel \"", TclGetString(objv[1]),
"\" wasn't opened for reading", NULL);
return TCL_ERROR;
}
- arg = TclGetString(objv[2]);
- outChan = Tcl_GetChannel(interp, arg, &mode);
- if (outChan == NULL) {
+ if (TclGetChannelFromObj(interp, objv[2], &outChan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
if ((mode & TCL_WRITABLE) == 0) {
- Tcl_AppendResult(interp, "channel \"", arg,
+ Tcl_AppendResult(interp, "channel \"", TclGetString(objv[2]),
"\" wasn't opened for writing", NULL);
return TCL_ERROR;
}
@@ -1648,7 +1635,6 @@ TclChanPendingObjCmd(
{
Tcl_Channel chan;
int index, mode;
- char *arg;
static const char *options[] = {"input", "output", NULL};
enum options {PENDING_INPUT, PENDING_OUTPUT};
@@ -1662,9 +1648,7 @@ TclChanPendingObjCmd(
return TCL_ERROR;
}
- arg = TclGetString(objv[2]);
- chan = Tcl_GetChannel(interp, arg, &mode);
- if (chan == NULL) {
+ if (TclGetChannelFromObj(interp, objv[2], &chan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
@@ -1712,17 +1696,13 @@ TclChanTruncateObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan;
- int mode;
Tcl_WideInt length;
- char *chanName;
if ((objc < 2) || (objc > 3)) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId ?length?");
return TCL_ERROR;
}
- chanName = TclGetString(objv[1]);
- chan = Tcl_GetChannel(interp, chanName, &mode);
- if (chan == NULL) {
+ if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
return TCL_ERROR;
}
@@ -1747,15 +1727,17 @@ TclChanTruncateObjCmd(
length = Tcl_Tell(chan);
if (length == Tcl_WideAsLong(-1)) {
Tcl_AppendResult(interp,
- "could not determine current location in \"", chanName,
- "\": ", Tcl_PosixError(interp), NULL);
+ "could not determine current location in \"",
+ TclGetString(objv[1]), "\": ",
+ Tcl_PosixError(interp), NULL);
return TCL_ERROR;
}
}
if (Tcl_TruncateChannel(chan, length) != TCL_OK) {
- Tcl_AppendResult(interp, "error during truncate on \"", chanName,
- "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_AppendResult(interp, "error during truncate on \"",
+ TclGetString(objv[1]), "\": ",
+ Tcl_PosixError(interp), NULL);
return TCL_ERROR;
}
generated by cgit v0.12 at 2024-11-05 16:58:01 (GMT)