public Procedure(
Interp interp, // Current interpreter.
Namespace ns, // The namespace that the proc is defined in.
String name, // Name of the procedure.
TclObject args, // The formal arguments of this procedure.
TclObject b, // The body of the procedure.
String sFileName, // Initial value for the srcFileName member.
int sLineNumber) // Initial value for the srcLineNumber member.
throws TclException // Standard Tcl exception.
{
srcFileName = sFileName;
srcLineNumber = sLineNumber;
// Break up the argument list into argument specifiers, then process
// each argument specifier.
int numArgs = TclList.getLength(interp, args);
argList = new TclObject[numArgs][2];
for (int i = 0; i < numArgs; i++) {
// Now divide the specifier up into name and default.
TclObject argSpec = TclList.index(interp, args, i);
int specLen = TclList.getLength(interp, argSpec);
if (specLen == 0) {
// NEM 2010-06-14: updated to match Tcl 8.5+ and [apply]
throw new TclException(interp, "argument with no name");
}
if (specLen > 2) {
throw new TclException(
interp, "too many fields in argument " + "specifier \"" + argSpec + "\"");
}
TclObject argName = TclList.index(interp, argSpec, 0);
String argNameStr = argName.toString();
if (argNameStr.indexOf("::") != -1) {
// NEM: 2010-06-14: updated to match Tcl 8.5+
throw new TclException(interp, "formal parameter \"" + argSpec + "\" is not a simple name");
} else if (Var.isArrayVarname(argNameStr)) {
// NEM: 2010-06-14: updated to match Tcl 8.5+
throw new TclException(interp, "formal parameter \"" + argSpec + "\" is an array element");
}
argList[i][0] = argName;
argList[i][0].preserve();
if (specLen == 2) {
argList[i][1] = TclList.index(interp, argSpec, 1);
argList[i][1].preserve();
} else {
argList[i][1] = null;
}
}
if (numArgs > 0 && (argList[numArgs - 1][0].toString().equals("args"))) {
isVarArgs = true;
} else {
isVarArgs = false;
}
body = new CharPointer(b.toString());
body_length = body.length();
}
/**
* Executes a "case" statement. See Tcl user documentation for details.
*
* @param interp the current interpreter.
* @param argv command arguments.
* @exception TclException If incorrect number of arguments.
*/
public void cmdProc(Interp interp, TclObject argv[]) throws TclException {
if (argv.length < 3) {
throw new TclNumArgsException(interp, 1, argv, "string ?in? patList body ... ?default body?");
}
int i, result;
int body;
TclObject caseArgv[];
String string;
string = argv[1].toString();
caseArgv = argv;
body = -1;
if (argv[2].toString().equals("in")) {
i = 3;
} else {
i = 2;
}
/*
* If all of the pattern/command pairs are lumped into a single
* argument, split them out again.
*/
if (argv.length - i == 1) {
caseArgv = TclList.getElements(interp, argv[i]);
i = 0;
}
match_loop:
{
for (; i < caseArgv.length; i += 2) {
int j;
if (i == (caseArgv.length - 1)) {
throw new TclException(interp, "extra case pattern with no body");
}
/*
* Check for special case of single pattern (no list) with
* no backslash sequences.
*/
String caseString = caseArgv[i].toString();
int len = caseString.length();
for (j = 0; j < len; j++) {
char c = caseString.charAt(j);
if (Character.isWhitespace(c) || (c == '\\')) {
break;
}
}
if (j == len) {
if (caseString.equals("default")) {
body = i + 1;
}
if (Util.stringMatch(string, caseString)) {
body = i + 1;
break match_loop;
}
continue;
}
/*
* Break up pattern lists, then check each of the patterns
* in the list.
*/
int numPats = TclList.getLength(interp, caseArgv[i]);
for (j = 0; j < numPats; j++) {
if (Util.stringMatch(string, TclList.index(interp, caseArgv[i], j).toString())) {
body = i + 1;
break match_loop;
}
}
}
}
if (body != -1) {
try {
interp.eval(caseArgv[body], 0);
} catch (TclException e) {
if (e.getCompletionCode() == TCL.ERROR) {
interp.addErrorInfo(
"\n (\"" + caseArgv[body - 1] + "\" arm line " + interp.errorLine + ")");
}
throw e;
}
}
}