home *** CD-ROM | disk | FTP | other *** search
/ Carousel / CAROUSEL.cdr / mactosh / lang / xlisp.sha / xlprin.c < prev    next >
C/C++ Source or Header  |  1985-02-17  |  3KB  |  155 lines
  1. /* xlprint - xlisp print routine */
  2.  
  3. #include "xlisp.h"
  4.  
  5. /* external variables */
  6. extern NODE *xlstack;
  7. extern char buf[];
  8.  
  9. /* xlprint - print an xlisp value */
  10. xlprint(fptr,vptr,flag)
  11.   NODE *fptr,*vptr; int flag;
  12. {
  13.     NODE *nptr,*next;
  14.  
  15.     /* print nil */
  16.     if (vptr == NIL) {
  17.     putstr(fptr,"nil");
  18.     return;
  19.     }
  20.  
  21.     /* check value type */
  22.     switch (ntype(vptr)) {
  23.     case SUBR:
  24.         putatm(fptr,"Subr",vptr);
  25.         break;
  26.     case FSUBR:
  27.         putatm(fptr,"FSubr",vptr);
  28.         break;
  29.     case LIST:
  30.         xlputc(fptr,'(');
  31.         for (nptr = vptr; nptr != NIL; nptr = next) {
  32.             xlprint(fptr,car(nptr),flag);
  33.         if (next = cdr(nptr))
  34.             if (consp(next))
  35.             xlputc(fptr,' ');
  36.             else {
  37.             putstr(fptr," . ");
  38.             xlprint(fptr,next,flag);
  39.             break;
  40.             }
  41.         }
  42.         xlputc(fptr,')');
  43.         break;
  44.     case SYM:
  45.         putstr(fptr,xlsymname(vptr));
  46.         break;
  47.     case INT:
  48.         putdec(fptr,vptr->n_int);
  49.         break;
  50.     case STR:
  51.         if (flag)
  52.         putstring(fptr,vptr->n_str);
  53.         else
  54.         putstr(fptr,vptr->n_str);
  55.         break;
  56.     case FPTR:
  57.         putatm(fptr,"File",vptr);
  58.         break;
  59.     case OBJ:
  60.         putatm(fptr,"Object",vptr);
  61.         break;
  62.     case FREE:
  63.         putatm(fptr,"Free",vptr);
  64.         break;
  65.     default:
  66.         putatm(fptr,"Foo",vptr);
  67.         break;
  68.     }
  69. }
  70.  
  71. /* xlterpri - terminate the current print line */
  72. xlterpri(fptr)
  73.   NODE *fptr;
  74. {
  75.     xlputc(fptr,'\n');
  76. }
  77.  
  78. /* putstring - output a string */
  79. LOCAL putstring(fptr,str)
  80.   NODE *fptr; char *str;
  81. {
  82.     int ch;
  83.  
  84.     /* output the initial quote */
  85.     xlputc(fptr,'"');
  86.  
  87.     /* output each character in the string */
  88.     while (ch = *str++)
  89.  
  90.     /* check for a control character */
  91.     if (ch < 040 || ch == '\\') {
  92.         xlputc(fptr,'\\');
  93.         switch (ch) {
  94.         case '\033':
  95.             xlputc(fptr,'e');
  96.             break;
  97.         case '\n':
  98.             xlputc(fptr,'n');
  99.             break;
  100.         case '\r':
  101.             xlputc(fptr,'r');
  102.             break;
  103.         case '\t':
  104.             xlputc(fptr,'t');
  105.             break;
  106.         case '\\':
  107.             xlputc(fptr,'\\');
  108.             break;
  109.         default:
  110.             putoct(fptr,ch);
  111.             break;
  112.         }
  113.     }
  114.  
  115.     /* output a normal character */
  116.     else
  117.         xlputc(fptr,ch);
  118.  
  119.     /* output the terminating quote */
  120.     xlputc(fptr,'"');
  121. }
  122.  
  123. /* putatm - output an atom */
  124. LOCAL putatm(fptr,tag,val)
  125.   NODE *fptr; char *tag; NODE *val;
  126. {
  127.     sprintf(buf,"#<%s: #",tag); putstr(fptr,buf);
  128.     sprintf(buf,AFMT,val); putstr(fptr,buf);
  129.     xlputc(fptr,'>');
  130. }
  131.  
  132. /* putdec - output a decimal number */
  133. LOCAL putdec(fptr,n)
  134.   NODE *fptr; int n;
  135. {
  136.     sprintf(buf,"%d",n);
  137.     putstr(fptr,buf);
  138. }
  139.  
  140. /* putoct - output an octal byte value */
  141. LOCAL putoct(fptr,n)
  142.   NODE *fptr; int n;
  143. {
  144.     sprintf(buf,"%03o",n);
  145.     putstr(fptr,buf);
  146. }
  147.  
  148. /* putstr - output a string */
  149. LOCAL putstr(fptr,str)
  150.   NODE *fptr; char *str;
  151. {
  152.     while (*str)
  153.     xlputc(fptr,*str++);
  154. }
  155.