1999-08-18 Jeff Hobbs <hobbs@scriptics.com>

	* doc/OpenFileChnl.3:
	* doc/file.n:
	* tests/cmdAH.test:
	* tclIO.c:
	* tclCmdAH.c: added "file channels ?pattern?" tcl command, with
	associated Tcl_GetChannelNames and Tcl_GetChannelNamesEx public
	C APIs (added to tcl.decls as well), with docs and tests.

	* generic/tclCompile.c: add TCL_TOKEN_VARIABLE to the part types
	that cause differed compilation for exprs, to correct the expr
	double-evaluation problem for vars.  Added test cases.

11 files changed, 81 insertions, 33 deletions

diff --git a/generic/tcl.decls b/generic/tcl.decls
index 6999f10..315d279 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -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: tcl.decls,v 1.27 1999/08/10 22:45:10 redman Exp $
+# RCS: @(#) $Id: tcl.decls,v 1.28 1999/08/19 02:59:08 hobbs Exp $
 
 library tcl
 
@@ -1340,6 +1340,9 @@ declare 387 generic {
 declare 388 generic {
     int Tcl_GetChannelNames(Tcl_Interp *interp)
 }
+declare 389 generic {
+    int Tcl_GetChannelNamesEx(Tcl_Interp *interp, char *pattern)
+}
 
 
 
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 8dc8c54..14ac7f6 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdAH.c,v 1.7 1999/07/01 23:21:06 redman Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.8 1999/08/19 02:59:08 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -793,7 +793,8 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
  */
 
     static char *fileOptions[] = {
-	"atime",	"attributes",	"copy",		"delete",
+	"atime",	"attributes",	"channels",	"copy",
+	"delete",
 	"dirname",	"executable",	"exists",	"extension",
 	"isdirectory",	"isfile",	"join",		"lstat",
 	"mtime",	"mkdir",	"nativename",	"owned",
@@ -803,7 +804,8 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
 	(char *) NULL
     };
     enum options {
-	FILE_ATIME,	FILE_ATTRIBUTES, FILE_COPY,	FILE_DELETE,
+	FILE_ATIME,	FILE_ATTRIBUTES, FILE_CHANNELS,	FILE_COPY,
+	FILE_DELETE,
 	FILE_DIRNAME,	FILE_EXECUTABLE, FILE_EXISTS,	FILE_EXTENSION,
 	FILE_ISDIRECTORY, FILE_ISFILE,	FILE_JOIN,	FILE_LSTAT,
 	FILE_MTIME,	FILE_MKDIR,	FILE_NATIVENAME, FILE_OWNED,
@@ -838,6 +840,14 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
 	case FILE_ATTRIBUTES: {
             return TclFileAttrsCmd(interp, objc, objv);
 	}
+	case FILE_CHANNELS: {
+	    if ((objc < 2) || (objc > 3)) {
+		Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
+		return TCL_ERROR;
+	    }
+	    return Tcl_GetChannelNamesEx(interp,
+		    ((objc == 2) ? NULL : Tcl_GetString(objv[2])));
+	}
 	case FILE_COPY: {
 	    int result;
 	    char **argv;
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 09c3dd0..9566a2f 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompCmds.c,v 1.2 1999/04/16 00:46:43 stanton Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.3 1999/08/19 02:59:08 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -1446,7 +1446,7 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
 
 	    word[numBytes] = '\0';
 	    if (TclLooksLikeInt(word, numBytes)
-		     && (TclGetLong((Tcl_Interp *) NULL, word, &n) == TCL_OK)) {
+		    && (TclGetLong((Tcl_Interp *) NULL, word, &n) == TCL_OK)) {
 		if ((-127 <= n) && (n <= 127)) {
 		    haveImmValue = 1;
 		    immValue = n;
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 42342b1..0b8fabf 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.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: tclCompExpr.c,v 1.3 1999/04/16 00:46:44 stanton Exp $
+ * RCS: @(#) $Id: tclCompExpr.c,v 1.4 1999/08/19 02:59:08 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -494,7 +494,7 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
 	    hPtr = Tcl_FindHashEntry(&opHashTable, operator);
 	    if (hPtr == NULL) {
 		code = CompileMathFuncCall(exprTokenPtr, operator, infoPtr,
-		        envPtr, &endPtr);
+			envPtr, &endPtr);
 		operator[tokenPtr->size] = (char) savedChar;
 		if (code != TCL_OK) {
 		    goto done;
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 25803a0..d83a9c1 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.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: tclCompile.c,v 1.15 1999/04/22 22:57:06 stanton Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.16 1999/08/19 02:59:09 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -1348,7 +1348,7 @@ TclCompileExprWords(interp, tokenPtr, numWords, envPtr)
     JumpFixup jumpFixup;
     int maxDepth, doExprInline, range, numBytes, i, j, code;
     char *script;
-    char saveChar;
+    char savedChar;
     int saveExprIsJustVarRef = envPtr->exprIsJustVarRef;
     int saveExprIsComparison = envPtr->exprIsComparison;
 
@@ -1370,10 +1370,10 @@ TclCompileExprWords(interp, tokenPtr, numWords, envPtr)
 
 	script = tokenPtr[1].start;
 	numBytes = tokenPtr[1].size;
-	saveChar = script[numBytes];
+	savedChar = script[numBytes];
 	script[numBytes] = 0;
 	code = TclCompileExpr(interp, script, numBytes, envPtr);
-	script[numBytes] = saveChar;
+	script[numBytes] = savedChar;
 	return code;
     }
 	
@@ -1393,7 +1393,8 @@ TclCompileExprWords(interp, tokenPtr, numWords, envPtr)
 	    for (j = 0, partPtr = wordPtr+1;  j < wordPtr->numComponents;
 		    j++, partPtr++) {
 		if ((partPtr->type == TCL_TOKEN_BS)
-		        || (partPtr->type == TCL_TOKEN_COMMAND)) {
+		        || (partPtr->type == TCL_TOKEN_COMMAND)
+			|| (partPtr->type == TCL_TOKEN_VARIABLE)) {
 		    doExprInline = 0;
 		    break;
 		}
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 6b49c94..6507b61 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -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: tclDecls.h,v 1.28 1999/08/10 22:45:11 redman Exp $
+ * RCS: @(#) $Id: tclDecls.h,v 1.29 1999/08/19 02:59:09 hobbs Exp $
  */
 
 #ifndef _TCLDECLS
@@ -1212,6 +1212,9 @@ EXTERN void		Tcl_SetNotifier _ANSI_ARGS_((
 EXTERN Tcl_Mutex *	Tcl_GetAllocMutex _ANSI_ARGS_((void));
 /* 388 */
 EXTERN int		Tcl_GetChannelNames _ANSI_ARGS_((Tcl_Interp * interp));
+/* 389 */
+EXTERN int		Tcl_GetChannelNamesEx _ANSI_ARGS_((
+				Tcl_Interp * interp, char * pattern));
 
 typedef struct TclStubHooks {
     struct TclPlatStubs *tclPlatStubs;
@@ -1668,6 +1671,7 @@ typedef struct TclStubs {
     void (*tcl_SetNotifier) _ANSI_ARGS_((Tcl_NotifierProcs * notifierProcPtr)); /* 386 */
     Tcl_Mutex * (*tcl_GetAllocMutex) _ANSI_ARGS_((void)); /* 387 */
     int (*tcl_GetChannelNames) _ANSI_ARGS_((Tcl_Interp * interp)); /* 388 */
+    int (*tcl_GetChannelNamesEx) _ANSI_ARGS_((Tcl_Interp * interp, char * pattern)); /* 389 */
 } TclStubs;
 
 #ifdef __cplusplus
@@ -3269,6 +3273,10 @@ extern TclStubs *tclStubsPtr;
 #define Tcl_GetChannelNames \
 	(tclStubsPtr->tcl_GetChannelNames) /* 388 */
 #endif
+#ifndef Tcl_GetChannelNamesEx
+#define Tcl_GetChannelNamesEx \
+	(tclStubsPtr->tcl_GetChannelNamesEx) /* 389 */
+#endif
 
 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
 
diff --git a/generic/tclGet.c b/generic/tclGet.c
index 27e49cc..4e6f184 100644
--- a/generic/tclGet.c
+++ b/generic/tclGet.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclGet.c,v 1.3 1999/04/16 00:46:46 stanton Exp $
+ * RCS: @(#) $Id: tclGet.c,v 1.4 1999/08/19 02:59:09 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -69,8 +69,8 @@ Tcl_GetInt(interp, string, intPtr)
     if (end == p) {
 	badInteger:
         if (interp != (Tcl_Interp *) NULL) {
-            Tcl_AppendResult(interp, "expected integer but got \"", string,
-                    "\"", (char *) NULL);
+	    Tcl_AppendResult(interp, "expected integer but got \"", string,
+		    "\"", (char *) NULL);
         }
 	return TCL_ERROR;
     }
@@ -155,8 +155,8 @@ TclGetLong(interp, string, longPtr)
     if (end == p) {
 	badInteger:
         if (interp != (Tcl_Interp *) NULL) {
-            Tcl_AppendResult(interp, "expected integer but got \"", string,
-                    "\"", (char *) NULL);
+	    Tcl_AppendResult(interp, "expected integer but got \"", string,
+		    "\"", (char *) NULL);
         }
 	return TCL_ERROR;
     }
diff --git a/generic/tclIO.c b/generic/tclIO.c
index c35147d..ea281a4 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.14 1999/08/10 17:35:18 redman Exp $
+ * RCS: @(#) $Id: tclIO.c,v 1.15 1999/08/19 02:59:10 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -8157,7 +8157,6 @@ SetBlockMode(interp, chanPtr, mode)
     }
     return TCL_OK;
 }
-
 
 /*
  *----------------------------------------------------------------------
@@ -8178,13 +8177,39 @@ SetBlockMode(interp, chanPtr, mode)
 int
 Tcl_GetChannelNames(Tcl_Interp *interp)
 {
+    return Tcl_GetChannelNamesEx(interp, (char *) NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetChannelNamesEx --
+ *
+ *	Return the names of open channels in the interp filtered
+ *	filtered through a pattern.  If pattern is NULL, it returns
+ *	all the open channels.
+ *
+ * Results:
+ *	TCL_OK or TCL_ERROR.
+ *
+ * Side effects:
+ *	Interp result modified with list of channel names.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetChannelNamesEx(Tcl_Interp *interp, char *pattern)
+{
     Channel *chanPtr;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
     char *name;
+    Tcl_Obj *resultPtr;
 
-    Tcl_ResetResult(interp);
-    chanPtr = tsdPtr->firstChanPtr;
-    while (chanPtr != NULL) {
+    resultPtr = Tcl_GetObjResult(interp);
+    for (chanPtr = tsdPtr->firstChanPtr;
+	 chanPtr != NULL;
+	 chanPtr = chanPtr->nextChanPtr) {
         if (chanPtr == (Channel *) tsdPtr->stdinChannel) {
 	    name = "stdin";
 	} else if (chanPtr == (Channel *) tsdPtr->stdoutChannel) {
@@ -8194,8 +8219,11 @@ Tcl_GetChannelNames(Tcl_Interp *interp)
 	} else {
 	    name = chanPtr->channelName;
 	}
-	Tcl_AppendElement(interp, name);
-	chanPtr = chanPtr->nextChanPtr;
+	if (((pattern == NULL) || Tcl_StringMatch(name, pattern)) &&
+		(Tcl_ListObjAppendElement(interp, resultPtr,
+			Tcl_NewStringObj(name, -1)) != TCL_OK)) {
+	    return TCL_ERROR;
+	}
     }
     return TCL_OK;
 }
diff --git a/generic/tclInitScript.h b/generic/tclInitScript.h
index 751fba1..1d8ffe0 100644
--- a/generic/tclInitScript.h
+++ b/generic/tclInitScript.h
@@ -8,7 +8,7 @@
  * Copyright (c) 1999 by Scriptics Corporation.
  * All rights reserved.
  *
- * RCS: @(#) $Id: tclInitScript.h,v 1.11 1999/07/21 17:43:21 hershey Exp $
+ * RCS: @(#) $Id: tclInitScript.h,v 1.12 1999/08/19 02:59:10 hobbs Exp $
  */
 
 /*
@@ -58,7 +58,7 @@ static char initScript[] = "if {[info proc tclInit]==\"\"} {\n\
 	set tclfile [file join $i init.tcl]\n\
 	if {[file exists $tclfile]} {\n\
 	    if {![catch {uplevel #0 [list source $tclfile]} msg]} {\n\
-	        return\n\
+		return\n\
 	    } else {\n\
 		append errors \"$tclfile: $msg\n$errorInfo\n\"\n\
 	    }\n\
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c
index 2a7fe5b..37ef1db 100644
--- a/generic/tclLiteral.c
+++ b/generic/tclLiteral.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclLiteral.c,v 1.7 1999/08/05 16:56:45 hobbs Exp $
+ * RCS: @(#) $Id: tclLiteral.c,v 1.8 1999/08/19 02:59:10 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -188,7 +188,6 @@ TclRegisterLiteral(envPtr, bytes, length, onHeap)
     long n;
     char buf[TCL_INTEGER_SPACE];
 
- 
     if (length < 0) {
 	length = (bytes? strlen(bytes) : 0);
     }
@@ -303,7 +302,6 @@ TclRegisterLiteral(envPtr, bytes, length, onHeap)
     if (globalTablePtr->numEntries >= globalTablePtr->rebuildSize) {
 	RebuildLiteralTable(globalTablePtr);
     }
-    
     objIndex = AddLocalLiteralEntry(envPtr, globalPtr, localHash);
 
 #ifdef TCL_COMPILE_DEBUG
@@ -752,7 +750,6 @@ TclReleaseLiteral(interp, objPtr)
      * Remove the reference corresponding to the local literal table
      * entry.
      */
-
     Tcl_DecrRefCount(objPtr);
 }
 
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index c433c97..ad790d9 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.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: tclStubInit.c,v 1.27 1999/08/10 02:42:14 welch Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.28 1999/08/19 02:59:10 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -783,6 +783,7 @@ TclStubs tclStubs = {
     Tcl_SetNotifier, /* 386 */
     Tcl_GetAllocMutex, /* 387 */
     Tcl_GetChannelNames, /* 388 */
+    Tcl_GetChannelNamesEx, /* 389 */
 };
 
 /* !END!: Do not edit above this line. */