Tcl Source Code

Artifact [d6edd1db29]
Login

Artifact d6edd1db29341fda175df98971dfdd8d496d09bd:

Attachment "x" to ticket [1015338fff] added by nobody 2004-08-24 22:24:35.
*** tclCmdIL.c.orig	2004-08-24 12:13:59.000000000 +0200
--- tclCmdIL.c	2004-08-24 15:01:46.000000000 +0200
***************
*** 139,144 ****
--- 139,147 ----
  static int		InfoProcsCmd _ANSI_ARGS_((ClientData dummy,
  			    Tcl_Interp *interp, int objc,
  			    Tcl_Obj *CONST objv[]));
+ static int		InfoReprCmd _ANSI_ARGS_((ClientData dummy,
+ 			    Tcl_Interp *interp, int objc,
+ 			    Tcl_Obj *CONST objv[]));
  static int		InfoScriptCmd _ANSI_ARGS_((ClientData dummy,
  			    Tcl_Interp *interp, int objc,
  			    Tcl_Obj *CONST objv[]));
***************
*** 401,406 ****
--- 404,410 ----
  	     "complete", "default", "exists", "functions", "globals",
  	     "hostname", "level", "library", "loaded",
  	     "locals", "nameofexecutable", "patchlevel", "procs",
+              "representation",
  	     "script", "sharedlibextension", "tclversion", "vars",
  	     (char *) NULL};
      enum ISubCmdIdx {
***************
*** 408,413 ****
--- 412,418 ----
  	    ICompleteIdx, IDefaultIdx, IExistsIdx, IFunctionsIdx, IGlobalsIdx,
  	    IHostnameIdx, ILevelIdx, ILibraryIdx, ILoadedIdx,
  	    ILocalsIdx, INameOfExecutableIdx, IPatchLevelIdx, IProcsIdx,
+             IReprIdx,
  	    IScriptIdx, ISharedLibExtensionIdx, ITclVersionIdx, IVarsIdx
      };
      int index, result;
***************
*** 475,480 ****
--- 480,488 ----
          case IProcsIdx:
  	    result = InfoProcsCmd(clientData, interp, objc, objv);
  	    break;
+         case IReprIdx:
+ 	    result = InfoReprCmd(clientData, interp, objc, objv);
+ 	    break;
          case IScriptIdx:
  	    result = InfoScriptCmd(clientData, interp, objc, objv);
  	    break;
***************
*** 1660,1665 ****
--- 1668,1721 ----
  /*
   *----------------------------------------------------------------------
   *
+  * InfoReprCmd --
+  *
+  *      Called to implement the "info representation" command that returns
+  *      the internal representation of a variable. Handles the following
+  *      syntax:
+  *
+  *          info representation varName
+  *
+  * Results:
+  *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
+  *
+  * Side effects:
+  *      Returns a result in the interpreter's result object. If there is
+  *      an error, the result is an error message.
+  *
+  *----------------------------------------------------------------------
+  */
+ 
+ static int
+ InfoReprCmd(dummy, interp, objc, objv)
+     ClientData dummy;           /* Not used. */
+     Tcl_Interp *interp;         /* Current interpreter. */
+     int objc;                   /* Number of arguments. */
+     Tcl_Obj *CONST objv[];      /* Argument objects. */
+ {
+     Tcl_Obj *vobj;
+     Tcl_ObjType *vtype;
+ 
+     if (objc != 3) {
+         Tcl_WrongNumArgs(interp, 2, objv, "varName");
+         return TCL_ERROR;
+     }
+ 
+     vobj = Tcl_ObjGetVar2(interp, objv[2], NULL, TCL_LEAVE_ERR_MSG);
+     if (vobj == NULL)
+         return TCL_ERROR;
+     vtype = vobj->typePtr;
+     if (vtype == NULL)
+         /* if variable exists but has no rep, default to "string" */
+         Tcl_SetResult(interp, "string", TCL_VOLATILE);
+     else
+         Tcl_SetResult(interp, vtype->name, TCL_VOLATILE);
+     return TCL_OK;
+ }
+ 
+ /*
+  *----------------------------------------------------------------------
+  *
   * InfoScriptCmd --
   *
   *      Called to implement the "info script" command that returns the