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;