001: /*
002: * VariableCmd.java
003: *
004: * Copyright (c) 1987-1994 The Regents of the University of California.
005: * Copyright (c) 1994-1997 Sun Microsystems, Inc.
006: * Copyright (c) 1998-1999 by Scriptics Corporation.
007: * Copyright (c) 1999 by Moses DeJong.
008: *
009: * See the file "license.terms" for information on usage and
010: * redistribution of this file, and for a DISCLAIMER OF ALL
011: * WARRANTIES.
012: *
013: * RCS: @(#) $Id: VariableCmd.java,v 1.7 2006/03/27 00:06:42 mdejong Exp $
014: */
015:
016: package tcl.lang;
017:
018: /**
019: * This class implements the built-in "variable" command in Tcl.
020: */
021:
022: class VariableCmd implements Command {
023:
024: /*
025: *----------------------------------------------------------------------
026: *
027: * VariableCmd --
028: *
029: * Invoked to implement the "variable" command that creates one or more
030: * global variables. Handles the following syntax:
031: *
032: * variable ?name value...? name ?value?
033: *
034: * One or more variables can be created. The variables are initialized
035: * with the specified values. The value for the last variable is
036: * optional.
037: *
038: * If the variable does not exist, it is created and given the optional
039: * value. If it already exists, it is simply set to the optional
040: * value. Normally, "name" is an unqualified name, so it is created in
041: * the current namespace. If it includes namespace qualifiers, it can
042: * be created in another namespace.
043: *
044: * If the variable command is executed inside a Tcl procedure, it
045: * creates a local variable linked to the newly-created namespace
046: * variable.
047: *
048: * Results:
049: * Returns TCL_OK if the variable is found or created. Returns
050: * TCL_ERROR if anything goes wrong.
051: *
052: * Side effects:
053: * If anything goes wrong, this procedure returns an error message
054: * as the result in the interpreter's result object.
055: *
056: *----------------------------------------------------------------------
057: */
058:
059: public void cmdProc(Interp interp, TclObject[] objv)
060: throws TclException {
061: String varName;
062: int tail, cp;
063: Var var, array;
064: TclObject varValue;
065: int i;
066:
067: for (i = 1; i < objv.length; i = i + 2) {
068: // Look up each variable in the current namespace context, creating
069: // it if necessary.
070:
071: varName = objv[i].toString();
072: Var[] result = Var.lookupVar(interp, varName, null,
073: (TCL.NAMESPACE_ONLY | TCL.LEAVE_ERR_MSG), "define",
074: true, false);
075: if (result == null) {
076: // FIXME:
077: throw new TclException(interp, "");
078: }
079:
080: var = result[0];
081: array = result[1];
082:
083: // Mark the variable as a namespace variable and increment its
084: // reference count so that it will persist until its namespace is
085: // destroyed or until the variable is unset.
086:
087: if (!var.isVarNamespace()) {
088: var.setVarNamespace();
089: var.refCount++;
090: }
091:
092: // If a value was specified, set the variable to that value.
093: // Otherwise, if the variable is new, leave it undefined.
094: // (If the variable already exists and no value was specified,
095: // leave its value unchanged; just create the local link if
096: // we're in a Tcl procedure).
097:
098: if (i + 1 < objv.length) { // a value was specified
099: varValue = Var.setVar(interp, objv[i].toString(), null,
100: objv[i + 1],
101: (TCL.NAMESPACE_ONLY | TCL.LEAVE_ERR_MSG));
102:
103: if (varValue == null) {
104: // FIXME:
105: throw new TclException(interp, "");
106: }
107: }
108:
109: // If we are executing inside a Tcl procedure, create a local
110: // variable linked to the new namespace variable "varName".
111:
112: if ((interp.varFrame != null)
113: && interp.varFrame.isProcCallFrame) {
114:
115: // varName might have a scope qualifier, but the name for the
116: // local "link" variable must be the simple name at the tail.
117:
118: String varTail = NamespaceCmd.tail(varName);
119:
120: // Create a local link "tail" to the variable "varName" in the
121: // current namespace.
122:
123: Var.makeUpvar(interp, null, varName, null,
124: TCL.NAMESPACE_ONLY, varTail, 0, -1);
125: }
126: }
127: }
128: }
|