Make 'clock' and 'encoding' into proper compilable ensembles

5 files changed, 261 insertions, 83 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index d6a460d..c14c15b 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -265,7 +265,6 @@ static const CmdInfo builtInCmds[] = {
     {"cd",		Tcl_CdObjCmd,		NULL,			NULL,	0},
     {"close",		Tcl_CloseObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
     {"eof",		Tcl_EofObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
-    {"encoding",	Tcl_EncodingObjCmd,	NULL,			NULL,	0},
     {"exec",		Tcl_ExecObjCmd,		NULL,			NULL,	0},
     {"exit",		Tcl_ExitObjCmd,		NULL,			NULL,	0},
     {"fblocked",	Tcl_FblockedObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
@@ -789,16 +788,17 @@ Tcl_CreateInterp(void)
     }
 
     /*
-     * Create the "array", "binary", "chan", "dict", "file", "info",
-     * "namespace" and "string" ensembles. Note that all these commands (and
-     * their subcommands that are not present in the global namespace) are
-     * wholly safe *except* for "file".
+     * Create the "array", "binary", "chan", "clock", "dict", "encoding",
+     * "file", "info", "namespace" and "string" ensembles. Note that all these
+     * commands (and their subcommands that are not present in the global
+     * namespace) are wholly safe *except* for "clock", "encoding" and "file".
      */
 
     TclInitArrayCmd(interp);
     TclInitBinaryCmd(interp);
     TclInitChanCmd(interp);
     TclInitDictCmd(interp);
+    TclInitEncodingCmd(interp);
     TclInitFileCmd(interp);
     TclInitInfoCmd(interp);
     TclInitNamespaceCmd(interp);
diff --git a/generic/tclClock.c b/generic/tclClock.c
index c3b29e9..bb9fbeb 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -253,6 +253,19 @@ TclClockInit(
     ClockClientData *data;
     int i;
 
+    /* Structure of the 'clock' ensemble */
+
+    static const EnsembleImplMap clockImplMap[] = {
+	{"add",          NULL, TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
+	{"clicks",       NULL, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
+	{"format",       NULL, TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
+	{"microseconds", NULL, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
+	{"milliseconds", NULL, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
+	{"scan",         NULL, TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
+	{"seconds",      NULL, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
+	{NULL,           NULL, NULL,                      NULL, NULL, 0}
+    };
+
     /*
      * Safe interps get [::clock] as alias to a master, so do not need their
      * own copies of the support routines.
@@ -276,6 +289,7 @@ TclClockInit(
 
     /*
      * Install the commands.
+     * TODO - Let Tcl_MakeEnsemble do this?
      */
 
 #define TCL_CLOCK_PREFIX_LEN 14 /* == strlen("::tcl::clock::") */
@@ -286,6 +300,10 @@ TclClockInit(
 	Tcl_CreateObjCommand(interp, cmdName, clockCmdPtr->objCmdProc, data,
 		ClockDeleteCmdProc);
     }
+
+    /* Make the clock ensemble */
+
+    TclMakeEnsemble(interp, "clock", clockImplMap);
 }
 
 /*
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 4c299f8..61de353 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -46,9 +46,21 @@ struct ForeachState {
 
 static int		CheckAccess(Tcl_Interp *interp, Tcl_Obj *pathPtr,
 			    int mode);
+static int		EncodingConvertfromObjCmd(ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static int		EncodingConverttoObjCmd(ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
 static int		EncodingDirsObjCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
+static int		EncodingNamesObjCmd(ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static int		EncodingSystemObjCmd(ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
 static inline int	ForeachAssignments(Tcl_Interp *interp,
 			    struct ForeachState *statePtr);
 static inline void	ForeachCleanup(Tcl_Interp *interp,
@@ -541,79 +553,173 @@ Tcl_EncodingObjCmd(
 
     switch ((enum options) index) {
     case ENC_CONVERTTO:
-    case ENC_CONVERTFROM: {
-	Tcl_Obj *data;
-	Tcl_DString ds;
-	Tcl_Encoding encoding;
-	int length;
-	const char *stringPtr;
-
-	if (objc == 3) {
-	    encoding = Tcl_GetEncoding(interp, NULL);
-	    data = objv[2];
-	} else if (objc == 4) {
-	    if (Tcl_GetEncodingFromObj(interp, objv[2], &encoding) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    data = objv[3];
-	} else {
-	    Tcl_WrongNumArgs(interp, 2, objv, "?encoding? data");
+	return EncodingConverttoObjCmd(dummy, interp, objc, objv);
+    case ENC_CONVERTFROM:
+	return EncodingConvertfromObjCmd(dummy, interp, objc, objv);
+    case ENC_DIRS:
+	return EncodingDirsObjCmd(dummy, interp, objc, objv);
+    case ENC_NAMES:
+	return EncodingNamesObjCmd(dummy, interp, objc, objv);
+    case ENC_SYSTEM:
+	return EncodingSystemObjCmd(dummy, interp, objc, objv);
+    }
+    return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * TclInitEncodingCmd --
+ *
+ *	This function creates the 'encoding' ensemble.
+ *
+ * Results:
+ *	Returns the Tcl_Command so created.
+ *
+ * Side effects:
+ *	The ensemble is initialized.
+ *
+ * This command is not installed in a safe interpreter.
+ */
+
+Tcl_Command
+TclInitEncodingCmd(
+    Tcl_Interp* interp)		/* Tcl interpreter */
+{
+    static const EnsembleImplMap encodingImplMap[] = {
+	{"convertfrom", EncodingConvertfromObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+	{"convertto",   EncodingConverttoObjCmd,   TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+	{"dirs",        EncodingDirsObjCmd,        TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+	{"names",       EncodingNamesObjCmd,       TclCompileBasic0ArgCmd,    NULL, NULL, 0},
+	{"system",      EncodingSystemObjCmd,      TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+	{NULL,          NULL,                      NULL,                      NULL, NULL, 0}
+    };
+
+    return TclMakeEnsemble(interp, "encoding", encodingImplMap);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EncodingConvertfromObjCmd --
+ *
+ *	This command converts a byte array in an external encoding into a
+ *	Tcl string
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+EncodingConvertfromObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    Tcl_Obj *data;		/* Byte array to convert */
+    Tcl_DString ds;		/* Buffer to hold the string */
+    Tcl_Encoding encoding;	/* Encoding to use */
+    int length;			/* Length of the byte array being converted */
+    const char *bytesPtr;	/* Pointer to the first byte of the array */
+
+    if (objc == 2) {
+	encoding = Tcl_GetEncoding(interp, NULL);
+	data = objv[1];
+    } else if (objc == 3) {
+	if (Tcl_GetEncodingFromObj(interp, objv[1], &encoding) != TCL_OK) {
 	    return TCL_ERROR;
 	}
+	data = objv[2];
+    } else {
+	Tcl_WrongNumArgs(interp, 1, objv, "?encoding? data");
+	return TCL_ERROR;
+    }
 
-	if ((enum options) index == ENC_CONVERTFROM) {
-	    /*
-	     * Treat the string as binary data.
-	     */
+    /* 
+     * Convert the string into a byte array in 'ds' 
+     */
+    bytesPtr = (char *) Tcl_GetByteArrayFromObj(data, &length);
+    Tcl_ExternalToUtfDString(encoding, bytesPtr, length, &ds);
 
-	    stringPtr = (char *) Tcl_GetByteArrayFromObj(data, &length);
-	    Tcl_ExternalToUtfDString(encoding, stringPtr, length, &ds);
+    /*
+     * Note that we cannot use Tcl_DStringResult here because it will
+     * truncate the string at the first null byte.
+     */
 
-	    /*
-	     * Note that we cannot use Tcl_DStringResult here because it will
-	     * truncate the string at the first null byte.
-	     */
+    Tcl_SetObjResult(interp, TclDStringToObj(&ds));
 
-	    Tcl_SetObjResult(interp, TclDStringToObj(&ds));
-	} else {
-	    /*
-	     * Store the result as binary data.
-	     */
-
-	    stringPtr = TclGetStringFromObj(data, &length);
-	    Tcl_UtfToExternalDString(encoding, stringPtr, length, &ds);
-	    Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(
-		    (unsigned char *) Tcl_DStringValue(&ds),
-		    Tcl_DStringLength(&ds)));
-	    Tcl_DStringFree(&ds);
-	}
+    /*
+     * We're done with the encoding
+     */
 
-	Tcl_FreeEncoding(encoding);
-	break;
-    }
-    case ENC_DIRS:
-	return EncodingDirsObjCmd(dummy, interp, objc, objv);
-    case ENC_NAMES:
-	if (objc > 2) {
-	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
-	    return TCL_ERROR;
-	}
-	Tcl_GetEncodingNames(interp);
-	break;
-    case ENC_SYSTEM:
-	if (objc > 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "?encoding?");
+    Tcl_FreeEncoding(encoding);
+    return TCL_OK;
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EncodingConverttoObjCmd --
+ *
+ *	This command converts a Tcl string into a byte array that
+ *	encodes the string according to some encoding.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+EncodingConverttoObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    Tcl_Obj *data;		/* String to convert */
+    Tcl_DString ds;		/* Buffer to hold the byte array */
+    Tcl_Encoding encoding;	/* Encoding to use */
+    int length;			/* Length of the string being converted */
+    const char *stringPtr;	/* Pointer to the first byte of the string */
+
+    /* TODO - ADJUST OBJ INDICES WHEN ENSEMBLIFYING THIS */
+
+    if (objc == 2) {
+	encoding = Tcl_GetEncoding(interp, NULL);
+	data = objv[1];
+    } else if (objc == 3) {
+	if (Tcl_GetEncodingFromObj(interp, objv[1], &encoding) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	if (objc == 2) {
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    Tcl_GetEncodingName(NULL), -1));
-	} else {
-	    return Tcl_SetSystemEncoding(interp, TclGetString(objv[2]));
-	}
-	break;
+	data = objv[2];
+    } else {
+	Tcl_WrongNumArgs(interp, 1, objv, "?encoding? data");
+	return TCL_ERROR;
     }
+    
+    /*
+     * Convert the string to a byte array in 'ds'
+     */
+    
+    stringPtr = TclGetStringFromObj(data, &length);
+    Tcl_UtfToExternalDString(encoding, stringPtr, length, &ds);
+    Tcl_SetObjResult(interp, 
+		     Tcl_NewByteArrayObj((unsigned char*) Tcl_DStringValue(&ds),
+					 Tcl_DStringLength(&ds)));
+    Tcl_DStringFree(&ds);
+    
+    /*
+     * We're done with the encoding
+     */
+
+    Tcl_FreeEncoding(encoding);
     return TCL_OK;
+
 }
 
 /*
@@ -641,16 +747,16 @@ EncodingDirsObjCmd(
 {
     Tcl_Obj *dirListObj;
 
-    if (objc > 3) {
-	Tcl_WrongNumArgs(interp, 2, objv, "?dirList?");
+    if (objc > 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?dirList?");
 	return TCL_ERROR;
     }
-    if (objc == 2) {
+    if (objc == 1) {
 	Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath());
 	return TCL_OK;
     }
 
-    dirListObj = objv[2];
+    dirListObj = objv[1];
     if (Tcl_SetEncodingSearchPath(dirListObj) == TCL_ERROR) {
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		"expected directory list but got \"%s\"",
@@ -664,6 +770,68 @@ EncodingDirsObjCmd(
 }
 
 /*
+ *-----------------------------------------------------------------------------
+ *
+ * EncodingNamesObjCmd --
+ *
+ *	This command returns a list of the available encoding names
+ *
+ * Results:
+ *	Returns a standard Tcl result
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+int
+EncodingNamesObjCmd(ClientData dummy,       /* Unused */
+		    Tcl_Interp* interp,	    /* Tcl interpreter */
+		    int objc,		    /* Number of command line args */
+		    Tcl_Obj* const objv[])  /* Vector of command line args */
+{
+    if (objc > 1) {
+	Tcl_WrongNumArgs(interp, 1, objv, NULL);
+	return TCL_ERROR;
+    }
+    Tcl_GetEncodingNames(interp);
+    return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * EncodingSystemObjCmd --
+ *
+ *	This command retrieves or changes the system encoding
+ *
+ * Results:
+ *	Returns a standard Tcl result
+ *
+ * Side effects:
+ *	May change the system encoding.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+int
+EncodingSystemObjCmd(ClientData dummy,      /* Unused */
+		     Tcl_Interp* interp,    /* Tcl interpreter */
+		     int objc,		    /* Number of command line args */
+		     Tcl_Obj* const objv[]) /* Vector of command line args */
+{
+    if (objc > 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?encoding?");
+	return TCL_ERROR;
+    }
+    if (objc == 1) {
+	Tcl_SetObjResult(interp, 
+			 Tcl_NewStringObj(Tcl_GetEncodingName(NULL), -1));
+    } else {
+	return Tcl_SetSystemEncoding(interp, TclGetString(objv[1]));
+    }
+    return TCL_OK;
+}
+
+/*
  *----------------------------------------------------------------------
  *
  * Tcl_ErrorObjCmd --
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 4d3c0b1..6aa292c 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3239,10 +3239,7 @@ MODULE_SCOPE int	Tcl_AssembleObjCmd(ClientData clientData,
 MODULE_SCOPE int	TclNRAssembleObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
-
-MODULE_SCOPE int	Tcl_EncodingObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
+MODULE_SCOPE Tcl_Command TclInitEncodingCmd(Tcl_Interp *interp);
 MODULE_SCOPE int	Tcl_EofObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
diff --git a/library/init.tcl b/library/init.tcl
index 9ca4514..a202054 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -169,13 +169,7 @@ if {[interp issafe]} {
 
     namespace eval ::tcl::clock [list variable TclLibDir $::tcl_library]
 
-    proc clock args {
-	namespace eval ::tcl::clock [list namespace ensemble create -command \
-		[uplevel 1 [list namespace origin [lindex [info level 0] 0]]] \
-		-subcommands {
-		    add clicks format microseconds milliseconds scan seconds
-		}]
-
+    proc ::tcl::initClock {} {
 	# Auto-loading stubs for 'clock.tcl'
 
 	foreach cmd {add format scan} {
@@ -186,8 +180,9 @@ if {[interp issafe]} {
 	    }
 	}
 
-	return [uplevel 1 [info level 0]]
+	rename ::tcl::initClock {}
     }
+    ::tcl::initClock
 }
 
 # Conditionalize for presence of exec.