/* xlpp.c - xlisp pretty printer */
/*		Copyright (c) 1985, by David Betz
		All Rights Reserved						*/

#include "xlisp.h"

/* external variables */
extern LVAL s_stdout;
extern int xlfsize;

/* local variables */
static int pplevel,ppmargin,ppmaxlen;
static LVAL ppfile;

/* forward declarations */
#ifdef ANSI
void pp(LVAL expr);
void pplist(LVAL expr);
void ppexpr(LVAL expr);
void ppputc(int ch);
void ppterpri(void);
int  ppflatsize(LVAL expr);
#else
FORWARD VOID pp();
FORWARD VOID pplist();
FORWARD VOID ppexpr();
FORWARD VOID ppputc();
FORWARD VOID ppterpri();
#endif

#ifdef PRINDEPTH
extern LVAL s_printlevel, s_printlength;	/*modified for depth/length ctrl*/
extern FIXTYPE plevel, plength;
#define xlprint xlprintl
#endif

/* xpp - pretty-print an expression */
LVAL xpp()
{
	LVAL expr;

#ifdef PRINDEPTH

	/* get printlevel and depth values */
	expr = getvalue(s_printlevel);
	if (fixp(expr)) {
		plevel = getfixnum(expr);
	}
	else {
		plevel = 32767;
	}
	expr = getvalue(s_printlength);
	if (fixp(expr)) {
		plength = getfixnum(expr);
	}
	else
		plength = 32767;
#endif

	/* get expression to print and file pointer */
	expr = xlgetarg();
	ppfile = (moreargs() ? xlgetfile() : getvalue(s_stdout));
	xllastarg();

	/* pretty print the expression */
	pplevel = ppmargin = 0; ppmaxlen = 40;
	pp(expr); ppterpri();

	/* return nil */
	return (NIL);
}

/* pp - pretty print an expression */
LOCAL VOID pp(expr)
  LVAL expr;
{
	if (consp(expr))
		pplist(expr);
	else
		ppexpr(expr);
}

/* pplist - pretty print a list */
LOCAL VOID pplist(expr)
  LVAL expr;
{
	int n;

	/* if the expression will fit on one line, print it on one */
	if ((n = ppflatsize(expr)) < ppmaxlen) {
		xlprint(ppfile,expr,TRUE);
		pplevel += n;
	}

	/* otherwise print it on several lines */
	else {
#ifdef PRINDEPTH
		FIXTYPE llength = plength;

		if (plevel-- == 0) {
			ppputc('#');
			plevel++;
			return;
		}
#endif

		n = ppmargin;
		ppputc('(');
		if (atom(car(expr))) {
			ppexpr(car(expr));
			ppputc(' ');
			ppmargin = pplevel;
			expr = cdr(expr);
		}
		else
			ppmargin = pplevel;
		for (; consp(expr); expr = cdr(expr)) {
#ifdef PRINDEPTH
			if (llength-- == 0) {
				xlputstr(ppfile,"... )");
				pplevel += 5;
				ppmargin =n;
				plevel++;
				return;
			}
#endif
			pp(car(expr));
			if (consp(cdr(expr)))
				ppterpri();
		}
		if (expr != NIL) {
			ppputc(' '); ppputc('.'); ppputc(' ');
			ppexpr(expr);
		}
		ppputc(')');
		ppmargin = n;
#ifdef PRINDEPTH
		plevel++;
#endif
	}
}

/* ppexpr - print an expression and update the indent level */
LOCAL VOID ppexpr(expr)
  LVAL expr;
{
	xlprint(ppfile,expr,TRUE);
	pplevel += ppflatsize(expr);
}

/* ppputc - output a character and update the indent level */
LOCAL VOID ppputc(ch)
  int ch;
{
	xlputc(ppfile,ch);
	pplevel++;
}

/* ppterpri - terminate the print line and indent */
LOCAL VOID ppterpri()
{
	xlterpri(ppfile);
	for (pplevel = 0; pplevel < ppmargin; pplevel++)
		xlputc(ppfile,' ');
}

/* ppflatsize - compute the flat size of an expression */
LOCAL int ppflatsize(expr)
  LVAL expr;
{
	xlfsize = 0;
	xlprint(NIL,expr,TRUE);
	return (xlfsize);
}