perm filename EADD6.2[EAL,HE] blob sn#712023 filedate 1983-05-26 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	{$NOMAIN	Editor: aux routines for addStmnt }
C00005 00003	procedure add1Filler(nextLinep: cursorpp var l,lcur: integer 
C00013 ENDMK
C⊗;
{$NOMAIN	Editor: aux routines for addStmnt }

%include eedit.hdr;

{ Externally defined routines from elsewhere: }

	(* From ALLOC *)
procedure relNode(n: nodep);					external;

	(* From EAUX1B *)
function checkArg(n: nodep; d: datatypes): nodep;		external;

	(* From EAUX1C *)
procedure errPrnt;						external;
function evalOrder(what,last: nodep; pcons: boolean): nodep;	external;

	(* From EPUT *)
procedure putLine;						external;

	(* From EAUX2C *)
procedure insertLines(start,number,coff: integer);		external;
procedure deleteLines(start,number,coff: integer);		external;

	(* From EPUTST *)
procedure putstmnt(s: statementp; indent, plevel: integer);	external;

	(* From EMOVEO *)
procedure moveOrder(st: statementp);				external;

	(* From EEXPAR *)
function exprParse: nodep;					external;

	(* From EPAR3E *)
function clauseParse(n: nodep; absSeen: boolean): nodep;	external;
procedure mClauseParse(n: nodep);				external;

	(* From EPAR3G *)
function thenCode(evp: boolean; s: statementp): statementp;	external;

	(* From EAUX3C - addStmnt aux routines *)
function getEmptyStmnt(sp:statementp): statementp;		external;
procedure addNSt(sty: stmntypes; nextLinep: cursorpp; 
	var sp: statementp; slabel: varidefp; 
	emptyp,stok: boolean; var nogood,flushp: boolean);	external;
function addNode(nextLinep: cursorpp; slabel:varidefp): nodep;	external;

	(* From PP *)
procedure relLine(l: linerecp);					external;
procedure ppLine; 						external;
procedure ppOutNow; 						external;
procedure ppChar(ch: ascii); 					external;
procedure pp5(ch: c5str; length: integer); 			external;
procedure pp10(ch: cstring; length: integer); 			external;
procedure pp10L(ch: cstring; length: integer);			external;
procedure pp20(ch: c20str; length: integer); 			external;
procedure pp20L(ch: c20str; length: integer); 			external;

procedure add1Filler(nextLinep: cursorpp; var l,lcur: integer; 
	var emptyp,stok,clok,nogood,flushp: boolean; 
	var sp: statementp; slabel: varidefp; var viaCl: nodep);  external;
procedure add1Filler;
 var n,np: nodep; i: integer;
 begin
 with curToken do
  if (filler = untltype) and (fieldNum = 2) and
	  nextLinep↑.stmntp and (nextLinep↑.st↑.stype = untiltype) then
    with nextLinep↑.st↑ do
     begin					(* this is special *)
     cond := checkArg(exprParse,svaltype);
     exprs := evalOrder(cond,nil,true);
     if not emptyp then
       deleteLines(ocur,1,1);		(* flush the extra line *)
     if not fParse then
       begin
       l := cursorLine - topDline + 1;	(* offset into line array *)
       relLine(lines[l]);			(* release old line *)
       lines[l] := nil;
       end;
     end
   else if (filler = dotype) or (filler = untltype) then
    begin
    addNSt(untiltype,nextLinep,sp,slabel,emptyp,stok,nogood,flushp);
    if stOk then
      with sp↑ do
       begin
       if filler = untltype then
	 begin
	 cond := checkArg(exprParse,svaltype);
	 exprs := evalOrder(cond,nil,true);
	 cursorLine := cursorLine + 2;
	 end
	else cond := nil;
       nlines := nlines + 2;
       body := getEmptyStmnt(sp);
       end
    end
   else if (filler = totype) or (filler = viatype) or (filler = bytype) or
	   (filler = withtype) then
    begin
    if clOk then
      begin				(* add a new motion clause *)
      np := addNode(nextLinep,slabel);
      with np↑ do
       if filler = totype then
	 begin ntype := destnode; loc := nil; code := nil end
	else if (filler = viatype) or (filler = bytype) then
	 begin
	 if filler = viatype then ntype := viaptnode else ntype := byptnode;
	 vlist := false; via := nil; vclauses := nil; vcode := nil
	 end
	else ntype := nullingnode;	(* random choice *)
      mClauseParse(np);
      with cursorStack[cursor-1] do
       if (filler = totype) and (st↑.clauses = np) then
	 begin			(* clause should go on previous line *)
	 l := cline - topDline + 1;
	 if (l > 0) and not fParse then		(* if any *)
	   begin
	   relLine(lines[l]);
	   lines[l] := nil;
	   firstLine := cline;
	   lastLine := cline;
	   curLine := 0;
	   putStmnt(dprog,0,99);	(* re-display old line *)
	   putLine;
	   end;
	 st↑.nlines := st↑.nlines - 1;
	 cursor := cursor - 1;
	 nogood := true;		(* flush extra line *)
	 end;
      end
     else
      begin
      pp20L(' Can''t have a clause',20); pp5(' here',5); errPrnt;
      nogood := true;
      flushp := true;
      end;
    end
   else if filler = thentype then
    begin
(* *** must be after a deproach or via clause *** *)
    if (fieldNum >= 1) and (viaCl <> nil) and (viaCl↑.vcode = nil) then
      begin
      if nextLinep↑.stmntp then
	begin
	np := addNode(nextLinep,slabel);  (* easiest way to back up cursorStack *)
	viaCl↑.next := np↑.next;
	relNode(np);		(* now get rid of the unneeded node *)
	end;
      viaCl↑.vcode := thenCode(true,getEmptyStmnt(sp));
      lcur := lcur + 1;
      insertLines(cursorLine,1,1);
      end
     else
      begin
      pp20L('THEN code must be af',20); pp20('ter VIA or BY clause',20);
      errprnt;
      nogood := true;
      flushp := true;
      end;
    end
   else if filler = wheretype then
    begin
    if (fieldNum = 1) and (viaCl↑.vcode <> nil) then viaCl := nil;
    if viaCl <> nil then
      begin
      n := clauseParse(nil,false);		(* get new WHERE clause *)
      if n <> nil then
	begin				(* add it to list *)
	np := viaCl↑.vclauses;
	if fieldNum = 2 then		(* new head of list *)
	  begin n↑.next := np; viaCl↑.vclauses := n end
	 else if fieldNum > 2 then
	  begin				(* add after Ith clause *)
	  for i := 4 to fieldNum do np := np↑.next;
	  n↑.next := np↑.next;
	  np↑.next := n;
	  end
	 else
	  begin				(* add after last clause *)
	  np := addNode(nextLinep,slabel);  (* easiest way to back up cursorStack *)
	  relNode(np);		(* now get rid of the unneeded node *)
	  viaCl↑.next := nil;
	  np := viaCl↑.vclauses;
	  if np = nil then viaCl↑.vclauses := n
	   else
	    begin
	    while np↑.next <> nil do np := np↑.next; (* find last clause *)
	    np↑.next := n;
	    end;
	  n↑.next := nil;
	  end;
	moveOrder(cursorStack[cursor-1].st);
	end;
      end
     else
      begin
      pp20L('WHERE must be after ',20); pp20('a VIA or BY clause  ',18);
      errprnt;
      nogood := true;
      flushp := true;
      end;
    end
 end;