rem: parserProc = (Ns_AdpParserProc *) Tcl_GetHashValue(hePtr); } else { parserProc = defParserProc; }
add: parserProc = (Ns_AdpParserProc *) Tcl_GetHashValue(hPtr); argv += 2; argc -= 2; }
context: static Ns_TclInterpInitProc EnableCmds;static void TextChunk(Ns_DString *dsPtr, char *text);static void SetMimeType(AdpData *adPtr, char *mimeType);/* * Static global variables */static Ns_Tls            adKey;static Ns_AdpParserProc *defParserProc = NULL;static Tcl_HashTable     extensionsTable;static Tcl_HashTable     parsersTable;static Ns_Cache         *sharedCachePtr;/* *---------------------------------------------------------------------- * * Ns_AdpRegisterParser -- * *	Sets the ADP parser. *	 * * Results: *	None. * * Side effects: *	None. * *---------------------------------------------------------------------- */intNs_AdpRegisterParser(char *extension, Ns_AdpParserProc *newParserProc){    Tcl_HashEntry *hePtr;    int            new;        if (Ns_InfoServersStarted() == NS_TRUE) {	Ns_Log(Error, "adp: cannot register parser after server startup");	return NS_ERROR;    }    hePtr = Tcl_CreateHashEntry(&parsersTable, extension, &new);    Tcl_SetHashValue(hePtr, (void *) newParserProc);    return NS_OK;}/* *---------------------------------------------------------------------- * * NsAdpInit -- * *	Initialize the ADP interface. * * Results: *	None. * * Side effects: *	ADP processor is register as required, Tcl commands are added, and *	a simple cache is initialized. * *---------------------------------------------------------------------- */voidNsAdpInit(void){    Ns_Set *set;    char *path, *map;    int i;    /*     * Initialize the ADP core.     */    Ns_TlsAlloc(&adKey, DelAdpData);    if (nsconf.adp.cache && !nsconf.adp.threadcache) {        sharedCachePtr = Ns_CacheCreateSz("adp", CACHE_KEYS,	    	    	    	    	  nsconf.adp.cachesize, ns_free);    }    /*     * Add the Tcl commands     */    Ns_TclInitInterps(nsServer, EnableCmds, NULL);    /*     * Register ADP for any requested URLs.     */    path = Ns_ConfigPath(nsServer, NULL, "adp", NULL);    map = NULL;    set = Ns_ConfigGetSection(path);    for (i = 0; set != NULL && i < Ns_SetSize(set); ++i) {	char          *key;	key = Ns_SetKey(set, i);	if (!strcasecmp(key, "map")) {	    map = Ns_SetValue(set, i);	    Ns_RegisterRequest(nsServer, "GET", map, AdpProc, NULL,			       NULL, 0);	    Ns_RegisterRequest(nsServer, "HEAD", map, AdpProc, NULL,			       NULL, 0);	    Ns_RegisterRequest(nsServer, "POST", map, AdpProc, NULL,			       NULL, 0);	    Ns_Log(Notice, "adp: mapped %s", map);	}    }    if (map == NULL) {	Ns_Log(Warning, "adp: disabled -- no mappings");    }    /*     * Initialize the hash table of parsers     */    Tcl_InitHashTable(&parsersTable, TCL_STRING_KEYS);    Tcl_InitHashTable(&extensionsTable, TCL_STRING_KEYS);}/* *---------------------------------------------------------------------- * * NsAdpParsers -- * *	Load ADP parser mappings.  * * Results: *	None.  * * Side effects: *	Registers requests for each parser.  * *---------------------------------------------------------------------- */voidNsAdpParsers(void){    char             *path;    Tcl_HashEntry    *hePtr;    int               size = 0;    Ns_Set           *setPtr;    int               i, new;    Ns_AdpParserProc *parserProc;    path = Ns_ConfigPath(nsServer, NULL, "adp", "parsers", NULL);    NsAdpFancyInit(nsServer, path);    Ns_AdpRegisterParser("adp", ParsePage);    if (path != NULL) {	setPtr = Ns_ConfigGetSection(path);	size = Ns_SetSize(setPtr);    }    hePtr = Tcl_FindHashEntry(&parsersTable, nsconf.adp.defaultparser);    parserProc = (Ns_AdpParserProc *) Tcl_GetHashValue(hePtr);    defParserProc = parserProc;        hePtr = Tcl_CreateHashEntry(&extensionsTable, ".adp", &new);    Tcl_SetHashValue(hePtr, defParserProc);        for (i=0; i < size; i++) {	char             *parser;	char             *ext;	parser = Ns_SetKey(setPtr, i);	ext = Ns_SetValue(setPtr, i);	hePtr = Tcl_FindHashEntry(&parsersTable, parser);	if (hePtr == NULL) {	    Ns_Log(Notice, "adp: invalid parser '%s'", parser);	    continue;	}	parserProc = (Ns_AdpParserProc *) Tcl_GetHashValue(hePtr);	hePtr = Tcl_CreateHashEntry(&extensionsTable, ext, &new);	Tcl_SetHashValue(hePtr, parserProc);    }}/* *---------------------------------------------------------------------- * * NsAdpGetData -- * *	Return the per-thread ADP context structure. * * Results: *	Pointer to AdpData. * * Side effects: *	None. * *---------------------------------------------------------------------- */AdpData *NsAdpGetData(void){    AdpData *adPtr;    adPtr = (AdpData *) Ns_TlsGet(&adKey);    if (adPtr == NULL) {	adPtr = ns_calloc(1, sizeof(AdpData));        adPtr->mimeType = NULL;	Ns_DStringInit(&adPtr->output);	Ns_TlsSet(&adKey, adPtr);    }    return adPtr;}/* *---------------------------------------------------------------------- * * NsAdpEval -- * *	Evaluate a list of chunks from an ADP. * * Results: *	TCL_OK or TCL_ERROR. * * Side effects: *	Depends on script chunks. * *---------------------------------------------------------------------- */intNsAdpEval(Tcl_Interp *interp, char *file, char *chunks){    int chunk, n, code, fd;    register char *ch = chunks;    Ns_DString ds;    char buf[10], *script, debugfile[255];    AdpData *adPtr;    adPtr = NsAdpGetData();    if (Ns_CheckStack() != NS_OK) {        interp->result =  "danger: stack grown too large (recursive adp?)";	adPtr->exception = ADP_OVERFLOW;        return TCL_ERROR;    }    if (file == NULL) {	file = "<inlined script>";    }    Ns_DStringInit(&ds);    code = TCL_OK;    chunk = 1;    while (*ch && adPtr->exception == ADP_OK) {	n = strlen(ch);	if (*ch++ == 't') {	    Ns_DStringNAppend(&adPtr->output, ch, n-1);	} else {	    script = ch;	    if (adPtr->debugLevel > 0) {		Ns_DStringTrunc(&ds, 0);		sprintf(buf, "%d", adPtr->debugLevel);		Ns_DStringVarAppend(&ds,		    "#\n"		    "# level: ", buf, "\n", NULL);		sprintf(buf, "%d", chunk);		Ns_DStringVarAppend(&ds,		    "# chunk: ", buf, "\n"		    "# file:  ", file, "\n"		    "#\n\n", ch, NULL);		sprintf(debugfile, P_tmpdir "/adp%d.%d.XXXXXX",			adPtr->debugLevel, chunk);		mktemp(debugfile);		fd = open(debugfile, O_WRONLY|O_TRUNC|O_CREAT|O_TEXT, 0644);		if (fd < 0) {		    Ns_Log(Error, "adp: failed to open %s: %s",			   debugfile, strerror(errno));		} else {		    write(fd, ds.string, ds.length);		    close(fd);		    Ns_DStringTrunc(&ds, 0);		    Ns_DStringVarAppend(&ds, "source ", debugfile, NULL);		    script = ds.string;		}	    }    	    code = NsTclEval(interp, script);	    if (code != TCL_OK &&		code != TCL_RETURN &&		adPtr->exception == ADP_OK) {    	    	NsAdpLogError(interp, file, chunk);	    }	    if (adPtr->exception == ADP_RETURN) {		adPtr->exception = ADP_OK;		code = TCL_OK;		if (script != ch) {		    unlink(debugfile);		}		goto done;		break;	    }	    if (script != ch) {		unlink(debugfile);	    }	    ++chunk;	}	ch += n;	NsAdpFlush(adPtr);    }     done:    NsAdpFlush(adPtr);    Ns_DStringFree(&ds);        return code;}/* *---------------------------------------------------------------------- * * NsAdpStreamOn -- * *	Turn on streaming for the current connection. * * Results: *	None. * * Side effects: *	None unless streaming is not already enabled in which case *	headers and any pending content is immediately sent to the *	client.  Note that no content-length header will be sent *  	which has the side effect of disabling connection: keep-alive *	for the client. * *---------------------------------------------------------------------- */voidNsAdpStreamOn(void){    AdpData *adPtr;    adPtr = NsAdpGetData();    if (adPtr->conn == NULL) {	return;    }    if (adPtr->fStream != NS_TRUE) {    	adPtr->fStream = NS_TRUE;	Ns_ConnSetRequiredHeaders(adPtr->conn, "text/html", 0);	Ns_ConnFlushHeaders(adPtr->conn, 200);    }    NsAdpFlush(adPtr);}/* *---------------------------------------------------------------------- * * NsAdpFlush -- * *	Flush current output. * * Results: *	None. * * Side effects: *	None unless streaming is enabled in which case content is *  	written directly out the connection.  Also, output is disabled *  	during inlined evalution where the output buffer is used to *  	accumulate the inlined evaluation result before being copied *  	to the interp. * *---------------------------------------------------------------------- */voidNsAdpFlush(AdpData *adPtr){    if (adPtr->fStream == NS_TRUE &&	adPtr->evalLevel == 0 &&	adPtr->output.length > 0) {	Ns_WriteConn(adPtr->conn, adPtr->output.string,		     adPtr->output.length);	Ns_DStringTrunc(&adPtr->output, 0);    }}/* *---------------------------------------------------------------------- * * NsTclAdpEvalCmd -- * *	Process the Tcl _ns_adp_eval command. * * Results: *	A standard Tcl result. * * Side effects: *	Page string is parsed and evaluated at current Tcl level in a *	new ADP call frame. * *---------------------------------------------------------------------- */intNsTclAdpEvalCmd(ClientData dummy, Tcl_Interp *interp, int argc,		char **argv){    AdpData          *adPtr;    Frame             frame;    Ns_DString        ds;    int               code;    int               offset = 0;    int               parser = -1;    Tcl_HashEntry    *hePtr;    Ns_AdpParserProc *parserProc;        if (argc >= 2) {	if (!strcmp(argv[1], "-parser")) {	    offset += 2;	    parser = 1;	}    }    if (argc < 2 + offset) {	Tcl_AppendResult(interp, "wrong # args: should be \"",	    argv[0], " ?-parser parser? page ?arg ...?\"", NULL);	return TCL_ERROR;    }    if (parser != -1) {	hePtr = Tcl_FindHashEntry(&parsersTable, argv[parser]);	if (hePtr == NULL) {	    Tcl_AppendResult(interp, "invalid parser \"", parser, "\"", NULL);	    return TCL_ERROR;	}	parserProc = (Ns_AdpParserProc *) Tcl_GetHashValue(hePtr);    } else {	parserProc = defParserProc;    }        /*     * Increment the inline eval level to ensure flushing is disabled,     * push a frame, execute the code, and then move any result to the     * interp from the output buffer.     */         Ns_DStringInit(&ds);    adPtr = NsAdpGetData();    ++adPtr->evalLevel;    PushFrame(&frame, NULL, argc-1-offset, argv+1+offset);    Parse(NULL, &ds, argv[1]);    code = NsAdpEval(interp, argv[0], ds.string);    if (adPtr->output.length > frame.length) {	Tcl_SetResult(interp, adPtr->output.string + frame.length,		      TCL_VOLATILE);	Ns_DStringTrunc(&adPtr->output, frame.length);    }    PopFrame(&frame);    --adPtr->evalLevel;    Ns_DStringFree(&ds);    return code;}/* *---------------------------------------------------------------------- * * NsTclIncludeCmd -- * *	Process the Tcl _ns_adp_include and _ns_adp_parse commands. *	This routines is the core ADP execution engine. * * Results: *	A standard Tcl result. * * Side effects: *	Parse page for the given file is fetched from the cache and *	evaluated using the Tcl76 or Tcl81 code engine. * *---------------------------------------------------------------------- */ Page *NsAdpCopyShared(Ns_DString *dsPtr, struct stat *stPtr){    Page *pagePtr;    pagePtr = ns_malloc(sizeof(Page) + dsPtr->length);    pagePtr->mtime = stPtr->st_mtime;    pagePtr->size = stPtr->st_size;    pagePtr->length = dsPtr->length + 1;    memcpy(pagePtr->chunks, dsPtr->string, pagePtr->length);    return pagePtr;}intNsTclIncludeCmd(ClientData parse, Tcl_Interp *interp, int argc,		char **argv){    struct stat st;    Ns_DString file, *dsPtr;    AdpData *adPtr;    Frame frame;    Page *pagePtr;    Ns_Entry *ePtr;    int new, status;    char *p, *key;    Ns_Cache *cachePtr;        if (argc < 2) {	Tcl_AppendResult(interp, "wrong # args: should be \"",	    argv[0], " file ?args ...?\"", NULL);	return TCL_ERROR;    }    pagePtr = NULL;    status = TCL_ERROR;    dsPtr = Ns_DStringPop();    Ns_DStringInit(&file);    adPtr = NsAdpGetData();        /*     * Construct the full, normalized path to the ADP file.     */    if (Ns_PathIsAbsolute(argv[1])) {	Ns_NormalizePath(&file, argv[1]);    } else {	Ns_MakePath(dsPtr, adPtr->cwd, argv[1], NULL);	Ns_NormalizePath(&file, dsPtr->string);	Ns_DStringTrunc(dsPtr, 0);    }    /*     * Check for TclPro debugging.     */    if (adPtr->debugLevel > 0) {	++adPtr->debugLevel;    } else if (nsconf.adp.enabledebug != NS_FALSE &&	adPtr->debugFile != NULL &&	(p = strrchr(file.string, '/')) != NULL &&	Tcl_StringMatch(p+1, adPtr->debugFile)) {	Ns_Conn *conn;	Ns_Set *hdrs;	char *host, *port, *procs;        conn = Ns_TclGetConn(interp);	hdrs = Ns_ConnGetQuery(conn);	host = Ns_SetIGet(hdrs, "dhost");	port = Ns_SetIGet(hdrs, "dport");	procs = Ns_SetIGet(hdrs, "dprocs");	if (DebugInit(interp, host, port, procs) != TCL_OK) {	    Ns_ConnReturnNotice(conn, 200, "Debug Init Failed",				interp->result);	    adPtr->exception = ADP_ABORT;	    goto done;	}    }    /*     * Determine the cache to use (if any).     */         if (adPtr->debugLevel > 0) {	cachePtr = NULL;    } else if (!nsconf.adp.threadcache) {    	cachePtr = sharedCachePtr;    } else {	if (adPtr->cachePtr == NULL) {	    char name[30];    	    sprintf(name, "adpObj.%d", Ns_ThreadId());    	    adPtr->cachePtr = Ns_CacheCreateSz(name, CACHE_KEYS, nsconf.adp.cachesize,				(Ns_Callback *) NsAdpFreePrivate);	}    	cachePtr = adPtr->cachePtr;    }    /*     * Verify the file is an existing, ordinary file and then either     * parse directly or fetch through the cache.     */    if (stat(file.string, &st) != 0) {	Tcl_AppendResult(interp, "could not stat \"",	    file.string, "\": ", Tcl_PosixError(interp), NULL);    } else if (S_ISREG(st.st_mode) == 0) {    	Tcl_AppendResult(interp, "not an ordinary file: ", file.string,			 NULL);    } else if (cachePtr == NULL) {        	/*	 * Parse directly from file.	 */	     	status = ParseFile(interp, file.string, st.st_size, dsPtr);    } else {#ifdef WIN32	key = file.string;#else    	Key ukey;	ukey.dev = st.st_dev;	ukey.ino = st.st_ino;	key = (char *) &ukey;#endif	if (cachePtr != sharedCachePtr) {    	    /*	     * Fetch from private, free-threaded cache.	     */            ePtr = Ns_CacheCreateEntry(cachePtr, key, &new);            if (!new) {    		pagePtr = Ns_CacheGetValue(ePtr);    		if (pagePtr->mtime != st.st_mtime || pagePtr->size != st.st_size) {		    Ns_CacheUnsetValue(ePtr);		    new = 1;		} else {		    status = TCL_OK;		}	    }	    if (new) {		status = ParseFile(interp, file.string, st.st_size, dsPtr);		if (status != TCL_OK) {                    Ns_CacheDeleteEntry(ePtr);		} else {		    pagePtr = NsAdpCopyPrivate(dsPtr, &st);                    Ns_CacheSetValueSz(ePtr, pagePtr, pagePtr->size);		}	    }	} else {    	    /*	     * Fetch from shared, interlocked cache.	     */            Ns_CacheLock(cachePtr);            ePtr = Ns_CacheCreateEntry(cachePtr, key, &new);            if (!new) {		while (ePtr != NULL && (pagePtr = Ns_CacheGetValue(ePtr)) == NULL) {		    Ns_CacheWait(cachePtr);		    ePtr = Ns_CacheFindEntry(cachePtr, key);		}		if (pagePtr == NULL) {		    Tcl_AppendResult(interp, "wait failed for file: ", file.string, NULL);		} else if (pagePtr->mtime != st.st_mtime || pagePtr->size != st.st_size) {		    Ns_CacheUnsetValue(ePtr);		    new = 1;		} else {		    Ns_DStringNAppend(dsPtr, pagePtr->chunks, pagePtr->length);		    status = TCL_OK;		}	    }	    if (new) {		Ns_CacheUnlock(cachePtr);		status = ParseFile(interp, file.string, st.st_size, dsPtr);		Ns_CacheLock(cachePtr);		if (status != TCL_OK) {                    Ns_CacheDeleteEntry(ePtr);		} else {		    pagePtr = NsAdpCopyShared(dsPtr, &st);                    Ns_CacheSetValueSz(ePtr, pagePtr, pagePtr->size);        	}		Ns_CacheBroadcast(cachePtr);	    }	    Ns_CacheUnlock(cachePtr);	}    }        /*     * If valid chunks where parsed or copied, push a new call frame, run     * the chunks, and pop the frame.     */             if (status == TCL_OK) {    	PushFrame(&frame, file.string, argc-1, argv+1);        if (cachePtr == NULL || cachePtr == sharedCachePtr) {            status = NsAdpEval(interp, file.string, dsPtr->string);        } else {            status = NsAdpRunPrivate(interp, file.string, pagePtr);        }    	if (parse && adPtr->output.length > frame.length) {	    if (status == TCL_OK) {	    	Tcl_SetResult(interp, adPtr->output.string + frame.length,		    TCL_VOLATILE);	    }	    Ns_DStringTrunc(&adPtr->output, frame.length);	}    	PopFrame(&frame);	NsAdpFlush(adPtr);    }    if (adPtr->debugLevel > 0) {	--adPtr->debugLevel;    }done:    Ns_DStringFree(&file);    Ns_DStringPush(dsPtr);    return status;}/* *---------------------------------------------------------------------- * * NsTclPutsCmd -- * *	Process the Tcl ns_adp_puts command to append output. * * Results: *	A standard Tcl result. * * Side effects: *	Output buffer is extended with given text. * *---------------------------------------------------------------------- */ intNsTclPutsCmd(ClientData ignored, Tcl_Interp *interp, int argc, char **argv){    AdpData *adPtr;    if (argc != 2 && argc != 3) {	Tcl_AppendResult(interp, "wrong # args: should be \"",	    argv[0], " ?-nonewline? string\"", NULL);	return TCL_ERROR;    }    if (argc == 3 &&	strcmp(argv[1], "-nonewline") != 0) {	Tcl_AppendResult(interp, "invalid flag \"",	    argv[1], "\": expected -nonewline", NULL);	return TCL_ERROR;    }    adPtr = NsAdpGetData();    Ns_DStringAppend(&adPtr->output, argv[argc-1]);    if (argc != 3) {    	Ns_DStringNAppend(&adPtr->output, "\n", 1);    }    NsAdpFlush(adPtr);    return TCL_OK;}/* *---------------------------------------------------------------------- * * NsTclDirCmd -- * *	Process the Tcl ns_adp_dir command to return the current ADP *  	directory. * * Results: *	A standard Tcl result. * * Side effects: *	None. * *---------------------------------------------------------------------- */ intNsTclDirCmd(ClientData ignored, Tcl_Interp *interp, int argc, char **argv){    AdpData *adPtr;    if (argc != 1) {	Tcl_AppendResult(interp, "wrong # args: should be \"",	    argv[0], "\"", NULL);	return TCL_ERROR;    }    adPtr = NsAdpGetData();    if (adPtr->cwd != NULL && *adPtr->cwd) {       	Tcl_SetResult(interp, adPtr->cwd, TCL_VOLATILE);    } else {	interp->result = "/";    }    return TCL_OK;}/* *---------------------------------------------------------------------- * * NsTclBreakCmd -- * *	Process the Tcl ns_adp_break and ns_adp_abort commands to halt *  	page generation. * * Results: *	A standard Tcl result. * * Side effects: *	Break or abort exception is noted and will be handled in *  	AdpProc. * *---------------------------------------------------------------------- */ intNsTclBreakCmd(ClientData clientData, Tcl_Interp *interp, int argc,	      char **argv){    AdpData *adPtr;    if (argc != 1 && argc != 2) {	Tcl_AppendResult(interp, "wrong # args: should be \"",	    argv[0], " ?retval?\"", NULL);	return TCL_ERROR;    }    adPtr = NsAdpGetData();    adPtr->exception = (int) clientData;    if (argc == 2) {	Tcl_AppendResult(interp, argv[1], NULL);    }    return TCL_ERROR;}/* *---------------------------------------------------------------------- * * NsTclTellCmd -- * *	Process the Tcl ns_adp_tell commands to return the current *  	offset within the output buffer. * * Results: *	A standard Tcl result. * * Side effects: *  	None. * *---------------------------------------------------------------------- */ intNsTclTellCmd(ClientData ignored, Tcl_Interp *interp, int argc, char **argv){    AdpData *adPtr;    if (argc != 1) {	Tcl_AppendResult(interp, "wrong # args: should be \"",	    argv[0], "\"", NULL);	return TCL_ERROR;    }    adPtr = NsAdpGetData();    sprintf(interp->result, "%d", adPtr->output.length);    return TCL_OK;}/* *---------------------------------------------------------------------- * * NsTclTruncCmd -- * *	Process the Tcl ns_adp_trunc commands to truncate the output *  	buffer to the given length. * * Results: *	A standard Tcl result. * * Side effects: *  	Output buffer is truncated. * *---------------------------------------------------------------------- */ intNsTclTruncCmd(ClientData ignored, Tcl_Interp *interp, int argc,	      char **argv){    AdpData *adPtr;    int length;    if (argc != 1 && argc != 2) {	Tcl_AppendResult(interp, "wrong # args: should be \"",	    argv[0], " ?length?\"", NULL);	return TCL_ERROR;    }    if (argc == 1) {	length = 0;    } else {	if (Tcl_GetInt(interp, argv[1], &length) != TCL_OK) {	    return TCL_ERROR;	}	if (length < 0) {	    Tcl_AppendResult(interp, "invalid length: ", argv[1], NULL);	    return TCL_ERROR;	}    }    adPtr = NsAdpGetData();    Ns_DStringTrunc(&adPtr->output, length);    return TCL_OK;}/* *---------------------------------------------------------------------- * * NsTclDumpCmd -- * *	Process the Tcl ns_adp_dump commands to return the entire text *  	of the output buffer. * * Results: *	A standard Tcl result. * * Side effects: *  	None. * *---------------------------------------------------------------------- */ intNsTclDumpCmd(ClientData ignored, Tcl_Interp *interp, int argc, char **argv){    AdpData *adPtr;    if (argc != 1) {	Tcl_AppendResult(interp, "wrong # args: should be \"",	    argv[0], "\"", NULL);	return TCL_ERROR;    }    adPtr = NsAdpGetData();    Tcl_SetResult(interp, adPtr->output.string, TCL_VOLATILE);    return TCL_OK;}/* *---------------------------------------------------------------------- * * NsTclArgcCmd -- * *	Process the Tcl ns_adp_args commands to return the number of *  	arguments in the current ADP frame. * * Results: *	A standard Tcl result. * * Side effects: *  	None. * *---------------------------------------------------------------------- */ intNsTclArgcCmd(ClientData ignored, Tcl_Interp *interp, int argc, char **argv){    AdpData *adPtr;    if (argc != 1) {	Tcl_AppendResult(interp, "wrong # args: should be \"",	    argv[0], "\"", NULL);	return TCL_ERROR;    }    adPtr = NsAdpGetData();    sprintf(interp->result, "%d", adPtr->argc);    return TCL_OK;}/* *---------------------------------------------------------------------- * * NsTclArgvCmd -- * *	Process the Tcl ns_adp_args commands to return an argument (or *  	the entire list of arguments) within the current ADP frame. * * Results: *	A standard Tcl result. * * Side effects: *  	None. * *---------------------------------------------------------------------- */ intNsTclArgvCmd(ClientData ignored, Tcl_Interp *interp, int argc, char **argv){    AdpData *adPtr;    int i;    if (argc != 1 && argc != 2) {	Tcl_AppendResult(interp, "wrong # args: should be \"",	    argv[0], " ?index?\"", NULL);	return TCL_ERROR;    }    adPtr = NsAdpGetData();    if (adPtr->argv != NULL) {	if (argc == 1) {    	    for (i = 0; i < adPtr->argc; ++i) {    		Tcl_AppendElement(interp, adPtr->argv[i]);    	    }	} else {    	    if (Tcl_GetInt(interp, argv[1], &i) != TCL_OK) {    		return TCL_ERROR;    	    }    	    if (i > adPtr->argc) {    		i = adPtr->argc;    	    }    	    Tcl_SetResult(interp, adPtr->argv[i], TCL_VOLATILE);	}    }    return TCL_OK;}/* *---------------------------------------------------------------------- * * NsTclBindCmd -- * *	Process the Tcl ns_adp_bind_args commands to copy arguements *  	from the current frame into local variables. * * Results: *	A standard Tcl result. * * Side effects: *  	One or more local variables are created. * *---------------------------------------------------------------------- */ intNsTclBindCmd(ClientData ignored, Tcl_Interp *interp, int argc, char **argv){    AdpData *adPtr;    int i;    char *arg;    if (argc < 2) {	Tcl_AppendResult(interp, "wrong # args: should be \"",	    argv[0], " varName ?varName ...?\"", NULL);	return TCL_ERROR;    }    adPtr = NsAdpGetData();    if (adPtr->argc == 0) {	Tcl_AppendResult(interp, "not in an ADP", NULL);	return TCL_ERROR;    }    if (adPtr->argc != argc) {	char buf[sizeof(int) * 3 + 1];	sprintf(buf, "%d", adPtr->argc - 1);	Tcl_AppendResult(interp, "wrong # args: this ADP was passed ",			 buf, " parameters", NULL);	return TCL_ERROR;    }        for (i = 1; i < argc; ++i) {    	if (adPtr->argv != NULL && i < adPtr->argc) {    	    arg = adPtr->argv[i];    	} else {    	    arg = "";    	}    	if (Tcl_SetVar(interp, argv[i], arg, TCL_LEAVE_ERR_MSG) == NULL) {    	    return TCL_ERROR;    	}    }    return TCL_OK;}   	    /* *---------------------------------------------------------------------- * * ExcepetionCmd -- * *	Process the Tcl ns_adp_exception commands to return the current *  	exception state, ok, abort, or break. * * Results: *	A standard Tcl result. * * Side effects: *  	None. * *---------------------------------------------------------------------- */ intNsTclExceptionCmd(ClientData ignored, Tcl_Interp *interp, int argc,		  char **argv){    AdpData *adPtr;    char *exception;    if (argc != 1 && argc != 2) {	Tcl_AppendResult(interp, "wrong # args: should be \"",	    argv[0], " ?varName?\"", NULL);	return TCL_ERROR;    }    adPtr = NsAdpGetData();    if (adPtr->exception == ADP_OK) {	Tcl_SetResult(interp, "0", TCL_STATIC);    } else {	Tcl_SetResult(interp, "1", TCL_STATIC);    }    if (argc == 2) {	switch (adPtr->exception) {	case ADP_OK:	    exception = "ok";	    break;	case ADP_BREAK:	    exception = "break";	    break;	case ADP_ABORT:	    exception = "abort";	    break;	case ADP_OVERFLOW:	    exception = "overflow";	    break;	case ADP_RETURN:	    exception = "return";            break;	default:	    exception = "unknown";	    break;	}	if (Tcl_SetVar(interp, argv[1], exception, 		       TCL_LEAVE_ERR_MSG) == NULL) {	    return TCL_ERROR;	}    }    return TCL_OK;}/* *---------------------------------------------------------------------- * * NsTclStreamCmd -- * *	Process the Tcl ns_adp_stream commands to enable streaming *  	output mode. * * Results: *	A standard Tcl result. * * Side effects: *	See comments for NsAdpStreamOn. * *---------------------------------------------------------------------- */ intNsTclStreamCmd(ClientData ignored, Tcl_Interp *interp, int argc,	       char **argv){    if (argc != 1) {	Tcl_AppendResult(interp, "wrong # args: should be \"",	    argv[0], NULL);	return TCL_ERROR;    }    NsAdpStreamOn();    return TCL_OK;}/* *---------------------------------------------------------------------- * * NsTclDebugCmd -- * *	Process the Tcl ns_adp_debug command to connect to the TclPro *  	debugger if not already connected. * * Results: *	A standard Tcl result. * * Side effects: *  	See comments for DebugInit(). * *---------------------------------------------------------------------- */ intNsTclDebugCmd(ClientData ignored, Tcl_Interp *interp, int argc,	      char **argv){    AdpData *adPtr;    char *host, *port, *procs;    if (argc > 4) {	Tcl_AppendResult(interp, "wrong # args: should be \"",	    argv[0], " ?procs? ?host? ?port?\"", NULL);	return TCL_ERROR;    }    procs = (argc > 1) ? argv[1] : NULL;    host = (argc > 2) ? argv[2] : NULL;    port = (argc > 3) ? argv[3] : NULL;    if (DebugInit(interp, host, port, procs) != TCL_OK) {	Tcl_SetResult(interp, "could not initialize debugger", TCL_STATIC);	return TCL_ERROR;    }    adPtr = NsAdpGetData();    sprintf(interp->result, "%d", adPtr->debugLevel);    return TCL_OK;}/* *---------------------------------------------------------------------- * * EnableCmds -- * *	Enable the ADP Tcl commands and create ns_adp_include and *	ns_adp_parse commands. * * Results: *	NS_OK. * * Side effects: *	ADP commands are created in the parent Tcl interp. * *---------------------------------------------------------------------- */static intEnableCmds(Tcl_Interp *interp, void *ignored){    char incWrapper[] =	"proc ns_adp_include args {\n\teval _ns_adp_include $args\n}";    Tcl_CreateCommand(interp, "_ns_adp_include",		      NsTclIncludeCmd, (ClientData) 0, NULL);    Tcl_GlobalEval(interp, incWrapper);    return NS_OK;}