home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / plbin.zip / pl / src / pl-fmt.c < prev    next >
C/C++ Source or Header  |  1993-02-23  |  11KB  |  503 lines
  1. /*  pl-fmt.c,v 1.4 1993/02/23 13:16:31 jan Exp
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     See ../LICENCE to find out about your rights.
  5.     jan@swi.psy.uva.nl
  6.  
  7.     Purpose: Formated write
  8. */
  9.  
  10. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  11. Formatted output (Prolog predicates format/[1,2,3]).   One  day,  the  C
  12. source should also use format() to produce error messages, etc.
  13. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  14.  
  15. #include "pl-incl.h"
  16. #include "pl-ctype.h"
  17. #include "pl-itf.h"
  18. extern int Output;
  19.  
  20. #define BUFSIZE     10240
  21. #define DEFAULT     (-1)
  22. #define SHIFT       { argc--; argv++; }
  23. #define NEED_ARG    { if ( argc <= 0 ) \
  24.               { ERROR("not enough arguments"); \
  25.               } else \
  26.               { deRef2(argv, a); \
  27.               } \
  28.             }
  29. #define ERROR(fmt)    return warning("format/2: %s", fmt)
  30. #define ERROR1(fmt, a)    { char tp[50]; \
  31.               strcpy(tp, "format/2: "); \
  32.               strcat(tp, fmt); \
  33.               return warning(tp, a); \
  34.             }
  35. #define OUTSTRING(s)    { char *q = s; \
  36.               for(; *q; q++) OUTCHR(*q); \
  37.             }
  38. #define OUTCHR(c)    { if ( pending_rubber ) \
  39.                 buffer[index++] = (c); \
  40.               else \
  41.                 Put((Char)(c)); \
  42.               column = update_column(column, c); \
  43.             }
  44.  
  45. #define MAXRUBBER 100
  46.  
  47. struct rubber
  48. { int where;                /* where is rubber in output */
  49.   int size;                /* how big should it be */
  50.   Char pad;                /* padding character */
  51. };
  52.  
  53. static Table format_predicates;        /* Prolog defined fromatting */
  54.  
  55. forwards int    update_column P((int, Char));
  56. forwards bool    do_format P((char *fmt, int argc, Word argv));
  57. forwards void    distribute_rubber P((struct rubber *, int, int));
  58. forwards void    emit_rubber P((char *buf, int, struct rubber *, int));
  59.  
  60.         /********************************
  61.         *       PROLOG CONNECTION    *
  62.         ********************************/
  63.  
  64. word
  65. pl_format_predicate(chr, descr)
  66. Word chr, descr;
  67. { long c;
  68.   Procedure proc;
  69.   Symbol s;
  70.  
  71.   if ( isInteger(*chr) )
  72.   { c = valNum(*chr);
  73.     if ( c < 0 || c > 255 )
  74.       return warning("format_predicate/2: illegal character");
  75.   } else if ( isAtom(*chr) )
  76.   { c = stringAtom(*chr)[0];
  77.   } else
  78.     return warning("format_predicate/2: illegal character");
  79.  
  80.   if ( (proc = findCreateProcedure(descr)) == NULL )
  81.     fail;
  82.   if ( proc->functor->arity == 0 )
  83.     return warning("format_predicate/2: predicate must have at least 1 argument");
  84.  
  85.   if ( format_predicates == NULL )
  86.     format_predicates = newHTable(64);
  87.   
  88.   if ( (s = lookupHTable(format_predicates, (Void)c)) != NULL )
  89.     s->value = (word) proc;
  90.   else
  91.     addHTable(format_predicates, (Void)c, proc);
  92.  
  93.   succeed;
  94. }
  95.  
  96.  
  97. word
  98. pl_format(fmt, args)
  99. Word fmt;
  100. register Word args;
  101. { Word argv;
  102.   word rval;
  103.   int argc = 0;
  104.   char *f;
  105.   mark m;
  106.  
  107.   if ( isAtom(*fmt) )
  108.     f = stringAtom(*fmt);
  109.   else if ( isString(*fmt) )
  110.     f = valString(*fmt);
  111.   else if ( (f = listToString(*fmt)) != NULL )
  112.     f = store_string(f);
  113.   else
  114.     return warning("format/2: format is not an atom or string");
  115.  
  116.   Mark(m);
  117.   deRef(args);
  118.   if ( isNil(*args) )
  119.   { argc = 0;
  120.     argv = NULL;
  121.   } else if ( !isList(*args) )
  122.   { argc = 1;
  123.     argv = args;
  124.   } else
  125.   { Word ap;
  126.  
  127.     if ( (argc = lengthList(args)) < 0 )
  128.       return warning("format/2: argument list is not proper");
  129.     ap = argv = allocGlobal(argc * sizeof(word));
  130.  
  131.     while( isList(*args) )
  132.     { Word a = HeadList(args);
  133.  
  134.       deRef(a);
  135.       *ap++ = (isVar(*a) ? makeRef(a) : *a);
  136.  
  137.       args = TailList(args);
  138.       deRef(args);
  139.     }
  140.   }
  141.  
  142.   rval = do_format(f, argc, argv);
  143.   Undo(m);
  144.  
  145.   return rval;
  146. }
  147.  
  148. word
  149. pl_format3(stream, fmt, args)
  150. Word stream, fmt, args;
  151. { streamOutput(stream, pl_format(fmt, args));
  152. }
  153.  
  154. #if O_C_FORMAT
  155.  
  156.         /********************************
  157.         *          C-CONNECTION        *
  158.         ********************************/
  159.  
  160. static bool
  161. vformat(fm, args)
  162. char *fm;
  163. va_list args;
  164. { 
  165. }
  166.  
  167. #if ANSI
  168. bool
  169. format(char *fm, ...)
  170. { va_list args;
  171.   bool rval;
  172.  
  173.   va_start(args, fm);
  174.   rval = vformat(fm, args);
  175.   va_end(args);
  176.  
  177.   return rval;
  178. }
  179.  
  180. #else
  181.  
  182. bool
  183. format(va_alist)
  184. va_dcl
  185. { va_list args;
  186.   char *fm;
  187.   bool rval;
  188.  
  189.   va_start(args);
  190.   fm = va_arg(args, char *);
  191.   rval = vformat(fm, args);
  192.   va_end(args);
  193.  
  194.   return rval;
  195. }
  196. #endif /* ANSI */
  197.  
  198. #endif /* O_C_FORMAT */
  199.         /********************************
  200.         *       ACTUAL FORMATTING    *
  201.         ********************************/
  202.  
  203. static int
  204. update_column(col, c)
  205. register int col;
  206. register Char c;
  207. { switch(c)
  208.   { case '\n':    return 0;
  209.     case '\t':    return (col + 1) | 0x7;
  210.     case '\b':    return (col <= 0 ? 0 : col - 1);
  211.     default:    return col + 1;
  212.   }
  213. }   
  214.  
  215. static bool
  216. do_format(fmt, argc, argv)
  217. char *fmt;
  218. int argc;
  219. Word argv;
  220. { char buffer[BUFSIZE];            /* to store chars with tabs */
  221.   int index = 0;            /* index in buffer */
  222.   int column = currentLinePosition();    /* current output column */
  223.   int tab_stop = 0;            /* padded tab stop */
  224.   int pending_rubber = 0;        /* number of not-filled ~t's */
  225.   struct rubber rub[MAXRUBBER];
  226.   Symbol s;
  227.  
  228.   while(*fmt)
  229.   { switch(*fmt)
  230.     { case '~':
  231.     { int arg = DEFAULT;        /* Numeric argument */
  232.       Word a;            /* (List) argument */
  233.                     /* Get the numeric argument */
  234.       if ( isDigit(*++fmt) )
  235.       { for( ; isDigit(*fmt); fmt++ )
  236.           arg = (arg == DEFAULT ? arg = *fmt - '0' : arg*10 + *fmt - '0');
  237.       } else if ( *fmt == '*' )
  238.       { NEED_ARG;
  239.         if ( isInteger(*a) && (arg = (int)valNum(*a)) >= 0 )
  240.         { SHIFT;
  241.         } else
  242.           ERROR("no or negative integer for `*' argument");
  243.         fmt++;
  244.       } else if ( *fmt == '`' )
  245.       { arg = *++fmt;
  246.         fmt++;
  247.       }
  248.         
  249.                     /* Check for user defined format */
  250.       if ( format_predicates != NULL &&
  251. #if gould
  252.            (s = lookupHTable(format_predicates, (ulong)*fmt)) != NULL )
  253. #else
  254.            (s = lookupHTable(format_predicates,
  255.                  (Void)((long)*fmt))) != NULL )
  256. #endif
  257.       { Procedure proc = (Procedure) s->value;
  258.         char buf[BUFSIZE];
  259.         mark m;
  260.         word goal;
  261.         Word g;
  262.         int n;
  263.  
  264.         Mark(m);
  265.         goal = globalFunctor(FUNCTOR_module2);
  266.         unifyAtomic(argTermP(goal, 0), proc->definition->module->name);
  267.         unifyAtomic(argTermP(goal, 1), globalFunctor(proc->functor));
  268.         g = argTermP(goal, 1);
  269.         unifyAtomic(argTermP(*g, 0), arg == DEFAULT ? (word)ATOM_default
  270.                                 : consNum(arg));
  271.         for(n = 1; n < proc->functor->arity; n++)
  272.         { NEED_ARG;
  273.           pl_unify(argTermP(*g, n), a);
  274.           SHIFT;
  275.         }
  276.         tellString(buf, BUFSIZE);
  277.         debugstatus.suspendTrace++;
  278.         callGoal(MODULE_user, goal, FALSE);
  279.         debugstatus.suspendTrace--;
  280.         toldString();
  281.         OUTSTRING(buf);
  282.         Undo(m);
  283.  
  284.         fmt++;
  285.       } else
  286.       { switch(*fmt)        /* Build in formatting */
  287.         { case 'a':            /* atomic */
  288.         { char *s;
  289.  
  290.           NEED_ARG;
  291.           if ( (s = primitiveToString(*a, FALSE)) == (char *) NULL )
  292.             ERROR("illegal argument to ~a");
  293.           SHIFT;
  294.           OUTSTRING(s);
  295.           fmt++;
  296.           break;
  297.         }
  298.           case 'c':            /* ascii */
  299.         { NEED_ARG;
  300.           if ( isInteger(*a) )
  301.           { Char c = (int)valNum(*a);
  302.  
  303.             if ( c < 0 || c > 255 )
  304.               ERROR("illegal argument to ~c");
  305.             OUTCHR(c);
  306.             SHIFT;
  307.           } else
  308.             ERROR("illegal argument to ~c");
  309.           fmt++;
  310.           break;
  311.         }
  312.           case 'e':            /* exponential float */
  313.           case 'E':            /* Exponential float */
  314.           case 'f':            /* float */
  315.           case 'g':            /* shortest of 'f' and 'e' */
  316.           case 'G':            /* shortest of 'f' and 'E' */
  317.         { real f;
  318.           char tmp[12];
  319.           char buf[256];
  320.  
  321.           NEED_ARG;
  322.           if ( wordToReal(*a, &f) == FALSE )
  323.             ERROR1("illegal argument to ~%c", *fmt);
  324.           SHIFT;
  325.           sprintf(tmp, "%%.%d%c", arg == DEFAULT ? 6 : arg, *fmt);
  326.           sprintf(buf, tmp, f);
  327.           OUTSTRING(buf);
  328.           fmt++;
  329.           break;
  330.         }
  331.           case 'd':            /* integer */
  332.           case 'D':            /* grouped integer */
  333.           case 'r':            /* radix number */
  334.           case 'R':            /* Radix number */
  335.         { long i;
  336.           char *s;
  337.  
  338.           NEED_ARG;
  339.           if ( wordToInteger(*a, &i) == FALSE )
  340.             ERROR1("illegal argument to ~%c", *fmt);
  341.           SHIFT;
  342.           if ( arg == DEFAULT )
  343.             arg = 0;
  344.           s = ( (*fmt == 'd' || *fmt == 'D')
  345.             ? formatInteger(*fmt == 'D', arg, 10, TRUE, i)
  346.             : formatInteger(FALSE, 0, arg, *fmt == 'r', i)
  347.               );
  348.           OUTSTRING(s);            
  349.           fmt++;
  350.           break;
  351.         }
  352.           case 's':            /* string */
  353.         { char *s;
  354.  
  355.           NEED_ARG;
  356.           if ( (s = listToString(*a)) == (char *)NULL )
  357.             ERROR("illegal argument to ~s");
  358.           OUTSTRING(s);
  359.           SHIFT;
  360.           fmt++;
  361.           break;
  362.         }
  363.           case 'i':            /* ignore */
  364.         { NEED_ARG;
  365.           SHIFT;
  366.           fmt++;
  367.           break;
  368.         }
  369.         { Func f;
  370.           char buf[BUFSIZE];
  371.  
  372.           case 'k':            /* displayq */
  373.           f = pl_displayq;    goto pl_common;
  374.           case 'p':            /* print */
  375.           f = pl_print;        goto pl_common;
  376.           case 'q':            /* writeq */
  377.           f = pl_writeq;    goto pl_common;
  378.           case 'w':            /* write */
  379.           f = pl_write;
  380.           pl_common:
  381.  
  382.           NEED_ARG;
  383.           tellString(buf, BUFSIZE);
  384.           (*f)(a);
  385.           toldString();
  386.           SHIFT;
  387.           OUTSTRING(buf);
  388.           fmt++;
  389.           break;
  390.         }
  391.           case '~':            /* ~ */
  392.         { OUTCHR('~');
  393.           fmt++;
  394.           break;
  395.         }
  396.           case 'n':            /* \n */
  397.           case 'N':            /* \n if not on newline */
  398.         { if ( arg == DEFAULT )
  399.             arg = 1;
  400.           if ( *fmt == 'N' && column == 0 )
  401.             arg--;
  402.           while( arg-- > 0 )
  403.             OUTCHR('\n');
  404.           fmt++;
  405.           break;
  406.         }
  407.           case 't':            /* insert tab */
  408.         { rub[pending_rubber].where = index;
  409.           rub[pending_rubber].pad   = (arg == DEFAULT ? (Char) ' '
  410.                                   : (Char) arg);
  411.           pending_rubber++;
  412.           fmt++;
  413.           break;
  414.         }
  415.           case '|':            /* set tab */
  416.         { int stop;
  417.  
  418.           if ( arg == DEFAULT )
  419.             arg = column;
  420.           case '+':            /* tab relative */
  421.           if ( arg == DEFAULT )
  422.             arg = 8;
  423.           stop = (*fmt == '+' ? tab_stop + arg : arg);
  424.  
  425.           if ( pending_rubber == 0 ) /* nothing to distribute */
  426.           { rub[0].where = index;
  427.             rub[0].pad = ' ';
  428.             pending_rubber++;
  429.           }
  430.           distribute_rubber(rub, pending_rubber, stop - column);
  431.           emit_rubber(buffer, index, rub, pending_rubber);
  432.           index = 0;
  433.           pending_rubber = 0;
  434.  
  435.           column = tab_stop = stop;
  436.           fmt++;
  437.           break;
  438.         }
  439.           default:
  440.         ERROR1("unknown format: %c", *fmt);
  441.         }
  442.       }
  443.       break;            /* the '~' switch */
  444.     }
  445.       default:
  446.     { OUTCHR(*fmt);
  447.       fmt++;
  448.       break;
  449.     }
  450.     }
  451.   }
  452.  
  453.   if ( pending_rubber )            /* not closed ~t: flush out */
  454.     emit_rubber(buffer, index, rub, 0);
  455.  
  456.   succeed;
  457. }
  458.  
  459. static void
  460. distribute_rubber(r, rn, space)
  461. struct rubber *r;
  462. int rn;
  463. int space;
  464. { if ( space > 0 )
  465.   { int s = space / rn;
  466.     int n, m;
  467.  
  468.     for(n=0; n < rn; n++)        /* give them equal size */
  469.       r[n].size = s;
  470.                     /* distribute from the center */
  471.     space -= s*rn;
  472.     for(m = rn / 2, n = 0; space; n++, space--)
  473.     { r[m + (n % 2 ? n : -n)].size++;
  474.     }
  475.   } else
  476.   { int n;
  477.  
  478.     for(n=0; n < rn; n++)        /* set all rubber to 0 */
  479.       r[n].size = 0;
  480.   }
  481. }
  482.  
  483. static void
  484. emit_rubber(buf, i, r, rn)
  485. char *buf;
  486. int i;
  487. struct rubber *r;
  488. int rn;
  489. { int j;
  490.  
  491.   for(j = 0; j <= i; j++)
  492.   { if ( r->where == j && rn )
  493.     { int n;
  494.       for(n=0; n<r->size; n++)
  495.         Put(r->pad);
  496.       r++;
  497.       rn--;
  498.     }
  499.     if ( j < i )
  500.       Put(buf[j]);
  501.   }
  502. }
  503.