-- TexMacro.mesa

-- last written by Doug Wyatt, November 16, 1979  3:28 PM

DIRECTORY
	TexDefs: FROM "TexDefs"
		USING[DefType],
	TexErrorDefs: FROM "TexErrorDefs",
	TexHashDefs: FROM "TexHashDefs"
		USING[maxidsize,IdName],
	TexInpDefs: FROM "TexInpDefs",
	TexIODefs: FROM "TexIODefs",
	TexSynDefs: FROM "TexSynDefs",
	TexTableDefs: FROM "TexTableDefs"
		USING[HashIndex,SetHashEquiv,Cmd,CurTracing],
	TexTokenDefs: FROM "TexTokenDefs";

TexMacro: PROGRAM
IMPORTS TexErrorDefs,TexHashDefs,TexInpDefs,TexIODefs,TexSynDefs,
	TexTableDefs,TexTokenDefs
EXPORTS TexSynDefs =
BEGIN OPEN TexErrorDefs,TexInpDefs,TexSynDefs,TexTokenDefs;

MacroDef: PUBLIC PROCEDURE [dt: TexDefs.DefType] =
	BEGIN
	listhead: TokenListPtr;
	temphead: TokenLEntry←nilTokenLEntry;
	q: TokenPtr←@temphead;
	defplace: TexTableDefs.HashIndex;
	npars: CARDINAL;
	glob: BOOLEAN←(dt=gdef) OR (dt=xdef);

	-- remember to catch PageEndError
	GetTok[];
	WITH tok:curtok SELECT FROM
		ctrlseq => BEGIN defplace←tok.index; StoreTok[@q,tok] END;
		ENDCASE =>
			BEGIN
			BackError["You can only define a control sequence"L];
			RETURN;
			END;
	SELECT dt FROM
	xdef =>
		BEGIN -- *** is this right?
		list: TokenListPtr←ScanToks[def];
		StoreTok[@q,[match[end]]];
		q.link←list.link;
		FreeTokenLHead[list];
		END;
	gdef,def =>
		BEGIN
		npars←ScanMacroPars[@q !BadParam =>
			BEGIN
			BackError["Parameters must be numbered consecutively"L];
			RESUME;
			END];
		ScanMacroBody[@q, npars !BadParam =>
			BEGIN OPEN TexIODefs;
			BeginError; Ws["Illegal parameter number in definition of "L];
			MacroName[defplace];
			BackError[EndError[]]; RESUME;
			END];
		END;
	ENDCASE;
	listhead←MakeTokenLHead[temphead.link];
	TexTableDefs.SetHashEquiv[defplace,call,[call[listhead]],glob];
	ScanSpacer[];
	END -- of MacroDef --;

-- write a macro name on the current output stream
MacroName: PROCEDURE[defplace: TexTableDefs.HashIndex] =
	BEGIN OPEN TexHashDefs,TexIODefs;
	id: STRING←[maxidsize];
	IdName[id, defplace]; Esc; Ws[id];
	END;

BadParam: SIGNAL = CODE;

ScanMacroPars: PROCEDURE[qq: POINTER TO TokenPtr] RETURNS[npars: CARDINAL] =
	BEGIN
	npars←0;
	DO
	GetTok[];
	WITH cc:curchar SELECT curcmd FROM
	 	rbrace =>
			BEGIN
	 		BackError["Missing { has been inserted"L];
			EXIT;
	 		END;
		lbrace => EXIT;
		macprm =>
			BEGIN
			IF GetParamNum[]#(npars←npars+1) THEN SIGNAL BadParam;
			IF npars>parsize THEN ERROR OverFlow["npars"L];
			StoreTok[qq,[match[par]]];
			END;
		ENDCASE => StoreTok[qq,curtok];
	ENDLOOP;
	StoreTok[qq,[match[end]]];
	END;

ScanMacroBody: PROCEDURE[qq: POINTER TO TokenPtr, npars: CARDINAL] =
	BEGIN
	unbal: CARDINAL←1;
	DO -- ScanToks with additional check for macprms
	GetTok[];
	WITH cc:curchar SELECT curcmd FROM
		lbrace => unbal←unbal+1;
		rbrace => IF unbal=1 THEN EXIT ELSE unbal←unbal-1;
		macprm =>
			BEGIN
			par: CARDINAL←GetParamNum[];
			IF par IN[1..npars] THEN curtok←[outpar[par]]
			ELSE IF curcmd#macprm THEN SIGNAL BadParam;
			END;
		ENDCASE;
	StoreTok[qq,curtok];
	ENDLOOP;
	END;

GetParamNum: PROCEDURE RETURNS[[0..9]] = --INLINE--
	BEGIN
	GetTok[];
	WITH cc:curchar SELECT curcmd FROM
		otherchar => IF cc.char IN['1..'9] THEN RETURN[cc.char-'0];
		ENDCASE;
	RETURN[0];
	END -- of GetParamNum --;

ScanToks: PUBLIC PROCEDURE[type: TokListType] RETURNS[TokenListPtr] =
	BEGIN
	temphead: TokenLEntry←nilTokenLEntry;
	q: TokenPtr←@temphead;
	unbal: CARDINAL←1;
	docalls: BOOLEAN←(type=mark) OR (type=def);
	storerb: BOOLEAN←(type#def) AND (type#caseshift);
	ScanLB; -- *** perhaps this should not skip spacers
		DO
		IF docalls THEN GetNCTok[] ELSE GetTok[];
		SELECT curcmd FROM
			lbrace => unbal←unbal+1;
			rbrace => IF unbal=1 THEN EXIT ELSE unbal←unbal-1;
			ENDCASE;
		StoreTok[@q,curtok];
		ENDLOOP;
	IF storerb THEN BEGIN StoreTok[@q,curtok]; ScanSpacer; END;
	RETURN[MakeTokenLHead[temphead.link]];
	END -- of ScanToks --;


-- Calling user macros

MacroCall: PUBLIC PROCEDURE =
	BEGIN
	firsterror: BOOLEAN←TRUE;
	rclisthead: TokenListPtr;
	q,r: TokenPtr;
	npars,ngrps: CARDINAL←0;
	t: Token;
	defplace: TexTableDefs.HashIndex;
	unbal,i: CARDINAL←1;
	prevcmd: TexTableDefs.Cmd; 
	temphead: TokenLEntry←nilTokenLEntry;

	-- remember to catch PageEndError
	defplace←hashentry;
	WITH cc:curchar SELECT curcmd FROM
		call => rclisthead←cc.toklist;
		ENDCASE => ERROR;
	r←rclisthead.link.link;
	IF TexTableDefs.CurTracing[].showmacros THEN
	--	Ps[DumpTokens[rclisthead.link]];-- NULL; -- *** fix this
	WHILE (t←r.token)#[match[end]]
		DO
		q←@temphead;
		r←r.link;
		GetTok[];
		IF t=[match[par]] THEN
			BEGIN
			t←r.token;
			WHILE curcmd=rbrace DO
				BEGIN OPEN TexIODefs;
				BeginError; Ws["Argument begins with } in "L];
				MacroName[defplace];
				Error[EndError[]];
				GetTok[];
				END;
				ENDLOOP;
			ngrps←0;
			WHILE curtok#t DO
				StoreTok[@q,curtok];
				IF curcmd=lbrace THEN
					DO -- ScanToks not called because of recursion
					GetTok[];
					SELECT curcmd FROM
						lbrace => unbal←unbal+1;
						rbrace => IF unbal=1 THEN EXIT ELSE unbal←unbal-1;
						ENDCASE;
					StoreTok[@q,curtok];
					ENDLOOP;
				ngrps←ngrps+1; prevcmd←curcmd;
				IF t.cmd=match THEN EXIT;
				GetTok[];
				REPEAT
				FINISHED => r←r.link;
				ENDLOOP;
			IF prevcmd=rbrace THEN
				IF ngrps#1 THEN StoreTok[@q,curtok] -- store rbrace
				ELSE BEGIN p: TokenPtr; -- strip off lbrace
					p←temphead.link;
					temphead.link←p.link;
					FreeTokenLEntry[p];
					END;
			pstack[npars]←temphead.link;
			IF TexTableDefs.CurTracing[].showmacros THEN
				BEGIN OPEN TexIODefs;
				Pc['#]; Wn[npars+1]; Wc['←]; DumpTokens[NIL,pstack[npars]];
				END;
			npars←npars+1;
			END
		ELSE IF t#curtok AND firsterror THEN
			BEGIN OPEN TexIODefs;
			firsterror←FALSE;
			BeginError; Ws["Use doesn't match definition of "L];
			MacroName[defplace];
			Error[EndError[]];
			END;
	ENDLOOP;
	IF parptr+npars>parsize THEN ERROR OverFlow["parstack"L];
	FOR i IN [0..npars) DO parstack[parptr+i]←pstack[i]; ENDLOOP;
	PushInput[];
	instate←[tokenlist[r.link,[prune[parptr,rclisthead]]]];
	parptr←parptr+npars;
	rclisthead.refs←rclisthead.refs+1;
	END -- of MacroCall --;

STOP;

END -- of TexMacro --.