/*Copyright (C) 1992, 1995 by Thomas Glen Smith.  All Rights Reserved.*/
/* apleddl APL2 V1.0.0 *************************************************
* Called from aplediy to delete a statement.  Items must be:           *
* LEFT_BRACKET DELTA NUM RIGHT_BRACKET                                 *
***********************************************************************/
#define INCLUDES APLCB+APLCHDEF+APLED+APLFUNCI+APLMEM+APLTOKEN+STRING+TREE
#include "includes.h"
void apleddl(e,cp,stmtlen,tokcnt)
Apledst e;		/* Edit common area.					*/
char *cp;				/* Pointer to current input.				*/
int stmtlen;			/* Length of current input.				*/
int tokcnt;			/* Tokens remaining to process.			*/
{
	Apledno; Codechar; Dequeue; Execmsg; Expungf; Value; Vector;
	extern int aplerr;
	Apltoken tok,tokhdr;
	Apled ed;
	double delno;
	int delta_len,in_len,ok,tempsave;
	char *delta_ptr,*in,*in_end;

	tokhdr = *(e->fp->functokp); /* token list from temp. hdr. */
	delta_len = strlen(delta_ptr = codechar(DELTA));
	in_len = strlen(in = (tokhdr + tokcnt - 2)->token_ptr.token_string);
	for (;;) { /* Allows use of break. */
		ok = (0 == memcmp(in,delta_ptr,delta_len));
		if (!ok) break;
		if (in_len > delta_len) { /* e.g. [H23] or [H23.1] */
			in += delta_len; /* Bump past delta. */
			in_end = in + in_len - delta_len; /* End string. */
			delno = value(vector(&in,in_end,0)); /* Get e.g. 23 */
			ok = (aplerr == 0 && delno >= 0.0);
			if (!ok) break;
		}
		else delno = 0.0;
		if (tokcnt == 3) break; /* Break if e.g. [H23]. */
		ok = (tokcnt == 4);
		if (!ok) break; /* Too many tokens. */
		delno += apledno(tokhdr + tokcnt - 3, cp, stmtlen);
		break; /* end for(;;) */
	}
	if (!ok) {
		execmsg(cp,stmtlen,0,"Bad syntax for DEL delete.");
		return;
	}
	for (ed = e->edhdr; ed != NULL && delno != ed->apledst;
		ed = ed->aplednxt);
	if (ed == NULL) {
		execmsg(cp,stmtlen,0,"Statement to delete not found.");
		return;
	}
	e->aplstinc = (NULL == (e->cured = ed->aplednxt)) ? 1.0 : 0.0;
	dequeue(e,ed); /* remove from list */
	if (ed->apledtm)
		expungf(ed->apledhd, ed->apledcn); /* free old tokens */
	free(ed->apledch); /* free statement text */
	free(ed); /* free apled structure */
}