summaryrefslogtreecommitdiffstats
path: root/generic/tclIO.c
diff options
context:
space:
mode:
authorwelch <welch>1999-08-10 02:42:12 (GMT)
committerwelch <welch>1999-08-10 02:42:12 (GMT)
commit3a26c6d4498ad6fad866d54c7b23cb221fe21898 (patch)
tree17f7359546123767d03dd5cbd27b6934f1879b10 /generic/tclIO.c
parent26903290462f20550bb1d7e596008b2e8f1f723e (diff)
downloadtcl-3a26c6d4498ad6fad866d54c7b23cb221fe21898.zip
tcl-3a26c6d4498ad6fad866d54c7b23cb221fe21898.tar.gz
tcl-3a26c6d4498ad6fad866d54c7b23cb221fe21898.tar.bz2
1 Added use of Tcl_GetAllocMutex to tclAlloc.c and tclCkalloc.c so they
can be linked against alternate thread packages. 2 Added Tcl_GetChannelNames to tclIO.c 3 Added TclVarTraceExists hook so "info exists" triggers read traces exactly like it did in Tcl 7.6 4 Stubs table changes to reflect new internal and external APIs
Diffstat (limited to 'generic/tclIO.c')
-rw-r--r--generic/tclIO.c75
1 files changed, 74 insertions, 1 deletions
diff --git a/generic/tclIO.c b/generic/tclIO.c
index c0a33b0..245c7f7 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.12 1999/07/30 21:46:47 hobbs Exp $
+ * RCS: @(#) $Id: tclIO.c,v 1.13 1999/08/10 02:42:13 welch Exp $
*/
#include "tclInt.h"
@@ -593,6 +593,39 @@ TclFinalizeIOSubsystem()
}
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CloseChannels --
+ *
+ * Close all open channels in this interp, except for the
+ * standard input/output channels. This is useful for cleanup.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * May closes one or more channels.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_CloseChannels(Tcl_Interp *interp)
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ Channel *chanPtr, *nextChanPtr;
+
+ for (chanPtr = tsdPtr->firstChanPtr; chanPtr != NULL; chanPtr = nextChanPtr) {
+ nextChanPtr = chanPtr->nextChanPtr;
+ if (chanPtr != (Channel *) tsdPtr->stdinChannel
+ && chanPtr != (Channel *) tsdPtr->stdoutChannel
+ && chanPtr != (Channel *) tsdPtr->stderrChannel) {
+ (void) Tcl_UnregisterChannel(interp, (Tcl_Channel) chanPtr);
+ }
+ }
+}
/*
@@ -8159,4 +8192,44 @@ SetBlockMode(interp, chanPtr, mode)
return TCL_OK;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetChannelNames --
+ *
+ * Return the names of all open channels in the interp.
+ *
+ * Results:
+ * TCL_OK or TCL_ERROR.
+ *
+ * Side effects:
+ * Interp result modified with list of channel names.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+Tcl_GetChannelNames(Tcl_Interp *interp)
+{
+ Channel *chanPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ char *name;
+
+ Tcl_ResetResult(interp);
+ chanPtr = tsdPtr->firstChanPtr;
+ while (chanPtr != NULL) {
+ if (chanPtr == (Channel *) tsdPtr->stdinChannel) {
+ name = "stdin";
+ } else if (chanPtr == (Channel *) tsdPtr->stdoutChannel) {
+ name = "stdout";
+ } else if (chanPtr == (Channel *) tsdPtr->stderrChannel) {
+ name = "stderr";
+ } else {
+ name = chanPtr->channelName;
+ }
+ Tcl_AppendElement(interp, name);
+ chanPtr = chanPtr->nextChanPtr;
+ }
+ return TCL_OK;
+}