summaryrefslogtreecommitdiff
path: root/tcl/generic/tclIOCmd.c
diff options
context:
space:
mode:
Diffstat (limited to 'tcl/generic/tclIOCmd.c')
-rw-r--r--tcl/generic/tclIOCmd.c125
1 files changed, 69 insertions, 56 deletions
diff --git a/tcl/generic/tclIOCmd.c b/tcl/generic/tclIOCmd.c
index 0e6b7bf81a3..76ca6d1662e 100644
--- a/tcl/generic/tclIOCmd.c
+++ b/tcl/generic/tclIOCmd.c
@@ -63,45 +63,62 @@ Tcl_PutsObjCmd(dummy, interp, objc, objv)
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
Tcl_Channel chan; /* The channel to puts on. */
- int i; /* Counter. */
+ Tcl_Obj *string; /* String to write. */
int newline; /* Add a newline at end? */
char *channelId; /* Name of channel for puts. */
int result; /* Result of puts operation. */
int mode; /* Mode in which channel is opened. */
- char *arg;
- int length;
- i = 1;
- newline = 1;
- if ((objc >= 2) && (strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0)) {
- newline = 0;
- i++;
- }
- if ((i < (objc-3)) || (i >= objc)) {
- Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? ?channelId? string");
- return TCL_ERROR;
- }
+ switch (objc) {
+ case 2: /* puts $x */
+ string = objv[1];
+ newline = 1;
+ channelId = "stdout";
+ break;
- /*
- * The code below provides backwards compatibility with an old
- * form of the command that is no longer recommended or documented.
- */
+ case 3: /* puts -nonewline $x or puts $chan $x */
+ if (strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0) {
+ newline = 0;
+ channelId = "stdout";
+ } else {
+ newline = 1;
+ channelId = Tcl_GetString(objv[1]);
+ }
+ string = objv[2];
+ break;
- if (i == (objc-3)) {
- arg = Tcl_GetStringFromObj(objv[i + 2], &length);
- if (strncmp(arg, "nonewline", (size_t) length) != 0) {
- Tcl_AppendResult(interp, "bad argument \"", arg,
- "\": should be \"nonewline\"", (char *) NULL);
- return TCL_ERROR;
+ case 4: /* puts -nonewline $chan $x or puts $chan $x nonewline */
+ if (strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0) {
+ channelId = Tcl_GetString(objv[2]);
+ string = objv[3];
+ } else {
+ /*
+ * The code below provides backwards compatibility with an
+ * old form of the command that is no longer recommended
+ * or documented.
+ */
+
+ char *arg;
+ int length;
+
+ arg = Tcl_GetStringFromObj(objv[3], &length);
+ if (strncmp(arg, "nonewline", (size_t) length) != 0) {
+ Tcl_AppendResult(interp, "bad argument \"", arg,
+ "\": should be \"nonewline\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ channelId = Tcl_GetString(objv[1]);
+ string = objv[2];
}
newline = 0;
+ break;
+
+ default: /* puts or puts some bad number of arguments... */
+ Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? ?channelId? string");
+ return TCL_ERROR;
}
- if (i == (objc - 1)) {
- channelId = "stdout";
- } else {
- channelId = Tcl_GetString(objv[i]);
- i++;
- }
+
chan = Tcl_GetChannel(interp, channelId, &mode);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
@@ -112,7 +129,7 @@ Tcl_PutsObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- result = Tcl_WriteObj(chan, objv[i]);
+ result = Tcl_WriteObj(chan, string);
if (result < 0) {
goto error;
}
@@ -228,22 +245,12 @@ Tcl_GetsObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- resultPtr = Tcl_GetObjResult(interp);
- linePtr = resultPtr;
- if (objc == 3) {
- /*
- * Variable gets line, interp get bytecount.
- */
-
- linePtr = Tcl_NewObj();
- }
+ linePtr = Tcl_NewObj();
lineLen = Tcl_GetsObj(chan, linePtr);
if (lineLen < 0) {
if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) {
- if (linePtr != resultPtr) {
- Tcl_DecrRefCount(linePtr);
- }
+ Tcl_DecrRefCount(linePtr);
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "error reading \"", name, "\": ",
Tcl_PosixError(interp), (char *) NULL);
@@ -257,8 +264,11 @@ Tcl_GetsObjCmd(dummy, interp, objc, objv)
Tcl_DecrRefCount(linePtr);
return TCL_ERROR;
}
+ resultPtr = Tcl_GetObjResult(interp);
Tcl_SetIntObj(resultPtr, lineLen);
return TCL_OK;
+ } else {
+ Tcl_SetObjResult(interp, linePtr);
}
return TCL_OK;
}
@@ -406,11 +416,14 @@ Tcl_SeekObjCmd(clientData, interp, objc, objv)
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
Tcl_Channel chan; /* The channel to tell on. */
- int offset, mode; /* Where to seek? */
- int result; /* Of calling Tcl_Seek. */
+ Tcl_WideInt offset; /* Where to seek? */
+ int mode; /* How to seek? */
+ Tcl_WideInt result; /* Of calling Tcl_Seek. */
char *chanName;
int optionIndex;
- static char *originOptions[] = {"start", "current", "end", (char *) NULL};
+ static CONST char *originOptions[] = {
+ "start", "current", "end", (char *) NULL
+ };
static int modeArray[] = {SEEK_SET, SEEK_CUR, SEEK_END};
if ((objc != 3) && (objc != 4)) {
@@ -422,7 +435,7 @@ Tcl_SeekObjCmd(clientData, interp, objc, objv)
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
- if (Tcl_GetIntFromObj(interp, objv[2], &offset) != TCL_OK) {
+ if (Tcl_GetWideIntFromObj(interp, objv[2], &offset) != TCL_OK) {
return TCL_ERROR;
}
mode = SEEK_SET;
@@ -435,7 +448,7 @@ Tcl_SeekObjCmd(clientData, interp, objc, objv)
}
result = Tcl_Seek(chan, offset, mode);
- if (result == -1) {
+ if (result == Tcl_LongAsWide(-1)) {
Tcl_AppendResult(interp, "error during seek on \"",
chanName, "\": ", Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
@@ -485,7 +498,7 @@ Tcl_TellObjCmd(clientData, interp, objc, objv)
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
- Tcl_SetIntObj(Tcl_GetObjResult(interp), Tcl_Tell(chan));
+ Tcl_SetWideIntObj(Tcl_GetObjResult(interp), Tcl_Tell(chan));
return TCL_OK;
}
@@ -712,12 +725,12 @@ Tcl_ExecObjCmd(dummy, interp, objc, objv)
#define NUM_ARGS 20
Tcl_Obj *resultPtr;
- char **argv;
+ CONST char **argv;
char *string;
Tcl_Channel chan;
- char *argStorage[NUM_ARGS];
+ CONST char *argStorage[NUM_ARGS];
int argc, background, i, index, keepNewline, result, skip, length;
- static char *options[] = {
+ static CONST char *options[] = {
"-keepnewline", "--", NULL
};
enum options {
@@ -770,7 +783,7 @@ Tcl_ExecObjCmd(dummy, interp, objc, objv)
argv = argStorage;
argc = objc - skip;
if ((argc + 1) > sizeof(argv) / sizeof(argv[0])) {
- argv = (char **) ckalloc((unsigned)(argc + 1) * sizeof(char *));
+ argv = (CONST char **) ckalloc((unsigned)(argc + 1) * sizeof(char *));
}
/*
@@ -953,7 +966,7 @@ Tcl_OpenObjCmd(notUsed, interp, objc, objv)
*/
if (!pipeline) {
- chan = Tcl_OpenFileChannel(interp, what, modeString, prot);
+ chan = Tcl_FSOpenFileChannel(interp, objv[1], modeString, prot);
} else {
#ifdef MAC_TCL
Tcl_AppendResult(interp,
@@ -962,7 +975,7 @@ Tcl_OpenObjCmd(notUsed, interp, objc, objv)
return TCL_ERROR;
#else
int mode, seekFlag, cmdObjc;
- char **cmdArgv;
+ CONST char **cmdArgv;
if (Tcl_SplitList(interp, what+1, &cmdObjc, &cmdArgv) != TCL_OK) {
return TCL_ERROR;
@@ -1286,7 +1299,7 @@ Tcl_SocketObjCmd(notUsed, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- static char *socketOptions[] = {
+ static CONST char *socketOptions[] = {
"-async", "-myaddr", "-myport","-server", (char *) NULL
};
enum socketOptions {
@@ -1481,7 +1494,7 @@ Tcl_FcopyObjCmd(dummy, interp, objc, objv)
int mode, i;
int toRead, index;
Tcl_Obj *cmdPtr;
- static char* switches[] = { "-size", "-command", NULL };
+ static CONST char* switches[] = { "-size", "-command", NULL };
enum { FcopySize, FcopyCommand };
if ((objc < 3) || (objc > 7) || (objc == 4) || (objc == 6)) {
View Lorry Controller Status