home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / lisp / interpre / xlispplu / sources / xlpp.c < prev    next >
C/C++ Source or Header  |  1992-02-03  |  4KB  |  163 lines
  1. /* xlpp.c - xlisp pretty printer */
  2. /*      Copyright (c) 1985, by David Betz
  3.         All Rights Reserved                     */
  4.  
  5. #include "xlisp.h"
  6.  
  7. /* external variables */
  8. extern LVAL s_stdout;
  9. extern LVAL s_printlevel, s_printlength;    /*modified for depth/length ctrl*/
  10. extern int xlfsize;
  11. extern int plevel, plength;
  12.  
  13. /* local variables */
  14. static int pplevel,ppmargin,ppmaxlen;
  15. static LVAL ppfile;
  16.  
  17. /* forward declarations */
  18. #ifdef ANSI
  19. void NEAR pp(LVAL expr);
  20. void NEAR pplist(LVAL expr);
  21. void NEAR ppexpr(LVAL expr);
  22. void NEAR ppputc(int ch);
  23. void NEAR ppterpri(void);
  24. int  NEAR ppflatsize(LVAL expr);
  25. #else
  26. FORWARD VOID pp();
  27. FORWARD VOID pplist();
  28. FORWARD VOID ppexpr();
  29. FORWARD VOID ppputc();
  30. FORWARD VOID ppterpri();
  31. #endif
  32.  
  33.  
  34. /* xpp - pretty-print an expression */
  35. LVAL xpp()
  36. {
  37.     LVAL expr;
  38.  
  39.     /* get printlevel and depth values */
  40.     expr = getvalue(s_printlevel);
  41.     if (fixp(expr) && getfixnum(expr) <= 32767 && getfixnum(expr) >= 0) {
  42.         plevel = (int)getfixnum(expr);
  43.     }
  44.     else {
  45.         plevel = 32767;
  46.     }
  47.     expr = getvalue(s_printlength);
  48.     if (fixp(expr) && getfixnum(expr) <= 32767 && getfixnum(expr) >= 0) {
  49.         plength = (int)getfixnum(expr);
  50.     }
  51.     else
  52.         plength = 32767;
  53.  
  54.     /* get expression to print and file pointer */
  55.     expr = xlgetarg();
  56.     ppfile = (moreargs() ? xlgetfile(TRUE) : getvalue(s_stdout));
  57.     xllastarg();
  58.  
  59.     /* pretty print the expression */
  60.     pplevel = ppmargin = 0; ppmaxlen = 40;
  61.     pp(expr); ppterpri();
  62.  
  63.     /* return nil */
  64.     return (NIL);
  65. }
  66.  
  67. /* pp - pretty print an expression */
  68. LOCAL VOID NEAR pp(expr)
  69.   LVAL expr;
  70. {
  71.     if (consp(expr))
  72.         pplist(expr);
  73.     else
  74.         ppexpr(expr);
  75. }
  76.  
  77. /* pplist - pretty print a list */
  78. LOCAL VOID NEAR pplist(expr)
  79.   LVAL expr;
  80. {
  81.     int n;
  82.  
  83.     /* if the expression will fit on one line, print it on one */
  84.     if ((n = ppflatsize(expr)) < ppmaxlen) {
  85.         xlprintl(ppfile,expr,TRUE);
  86.         pplevel += n;
  87.     }
  88.  
  89.     /* otherwise print it on several lines */
  90.     else {
  91.         int llength = plength;
  92.  
  93.         if (plevel-- == 0) {
  94.             ppputc('#');
  95.             plevel++;
  96.             return;
  97.         }
  98.  
  99.         n = ppmargin;
  100.         ppputc('(');
  101.         if (atom(car(expr))) {
  102.             ppexpr(car(expr));
  103.             ppputc(' ');
  104.             ppmargin = pplevel;
  105.             expr = cdr(expr);
  106.         }
  107.         else
  108.             ppmargin = pplevel;
  109.         for (; consp(expr); expr = cdr(expr)) {
  110.             if (llength-- == 0) {
  111.                 xlputstr(ppfile,"... )");
  112.                 pplevel += 5;
  113.                 ppmargin =n;
  114.                 plevel++;
  115.                 return;
  116.             }
  117.             pp(car(expr));
  118.             if (consp(cdr(expr)))
  119.                 ppterpri();
  120.         }
  121.         if (expr != NIL) {
  122.             ppputc(' '); ppputc('.'); ppputc(' ');
  123.             ppexpr(expr);
  124.         }
  125.         ppputc(')');
  126.         ppmargin = n;
  127.         plevel++;
  128.     }
  129. }
  130.  
  131. /* ppexpr - print an expression and update the indent level */
  132. LOCAL VOID NEAR ppexpr(expr)
  133.   LVAL expr;
  134. {
  135.     xlprintl(ppfile,expr,TRUE);
  136.     pplevel += ppflatsize(expr);
  137. }
  138.  
  139. /* ppputc - output a character and update the indent level */
  140. LOCAL VOID NEAR ppputc(ch)
  141.   int ch;
  142. {
  143.     xlputc(ppfile,ch);
  144.     pplevel++;
  145. }
  146.  
  147. /* ppterpri - terminate the print line and indent */
  148. LOCAL VOID NEAR ppterpri()
  149. {
  150.     xlterpri(ppfile);
  151.     for (pplevel = 0; pplevel < ppmargin; pplevel++)
  152.         xlputc(ppfile,' ');
  153. }
  154.  
  155. /* ppflatsize - compute the flat size of an expression */
  156. LOCAL int NEAR ppflatsize(expr)
  157.   LVAL expr;
  158. {
  159.     xlfsize = 0;
  160.     xlprint(NIL,expr,TRUE);
  161.     return (xlfsize);
  162. }
  163.