home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_disks / 001-099 / ff093.lzh / MicroEmacs / source / src.arc / eval.c < prev    next >
C/C++ Source or Header  |  1987-08-16  |  14KB  |  585 lines
  1. /*    EVAL.C:    Expresion evaluation functions for
  2.         MicroEMACS
  3.  
  4.     written 1986 by Daniel Lawrence                */
  5.  
  6. #include    <stdio.h>
  7. #include    "estruct.h"
  8. #include    "edef.h"
  9. #include    "evar.h"
  10.  
  11. char value[NSTRING];        /* buffer to return value in */
  12.  
  13. varinit()        /* initialize the user variable list */
  14.  
  15. {
  16.     register int i;
  17.  
  18.     for (i=0; i < MAXVARS; i++)
  19.         uv[i].u_name[0] = 0;
  20. }
  21.  
  22. char *gtfun(fname)    /* evaluate a function */
  23.  
  24. char *fname;        /* name of function to evaluate */
  25.  
  26. {
  27.     register int fnum;        /* index to function to eval */
  28.     register int status;        /* return status */
  29.     char arg1[NSTRING];        /* value of first argument */
  30.     char arg2[NSTRING];        /* value of second argument */
  31.     char arg3[NSTRING];        /* value of third argument */
  32.     static char result[2 * NSTRING];    /* string result */
  33.  
  34.     /* look the function up in the function table */
  35.     fname[3] = 0;    /* only first 3 chars significant */
  36.     mklower(fname);    /* and let it be upper or lower case */
  37.     for (fnum = 0; fnum < NFUNCS; fnum++)
  38.         if (strcmp(fname, funcs[fnum].f_name) == 0)
  39.             break;
  40.  
  41.     /* return errorm on a bad reference */
  42.     if (fnum == NFUNCS)
  43.         return(errorm);
  44.  
  45.     /* if needed, retrieve the first argument */
  46.     if (funcs[fnum].f_type >= MONAMIC) {
  47.         if ((status = macarg(arg1)) != TRUE)
  48.             return(errorm);
  49.  
  50.         /* if needed, retrieve the second argument */
  51.         if (funcs[fnum].f_type >= DYNAMIC) {
  52.             if ((status = macarg(arg2)) != TRUE)
  53.                 return(errorm);
  54.     
  55.             /* if needed, retrieve the third argument */
  56.             if (funcs[fnum].f_type >= TRINAMIC)
  57.                 if ((status = macarg(arg3)) != TRUE)
  58.                     return(errorm);
  59.         }
  60.     }
  61.         
  62.  
  63.     /* and now evaluate it! */
  64.     switch (fnum) {
  65.         case UFADD:    return(itoa(atoi(arg1) + atoi(arg2)));
  66.         case UFSUB:    return(itoa(atoi(arg1) - atoi(arg2)));
  67.         case UFTIMES:    return(itoa(atoi(arg1) * atoi(arg2)));
  68.         case UFDIV:    return(itoa(atoi(arg1) / atoi(arg2)));
  69.         case UFMOD:    return(itoa(atoi(arg1) % atoi(arg2)));
  70.         case UFNEG:    return(itoa(-atoi(arg1)));
  71.         case UFCAT:    strcpy(result, arg1);
  72.                 return(strcat(result, arg2));
  73.         case UFLEFT:    return(strncpy(result, arg1, atoi(arg2)));
  74.         case UFRIGHT:    return(strcpy(result, &arg1[atoi(arg2)-1]));
  75.         case UFMID:    return(strncpy(result, &arg1[atoi(arg2)-1],
  76.                     atoi(arg3)));
  77.         case UFNOT:    return(ltos(stol(arg1) == FALSE));
  78.         case UFEQUAL:    return(ltos(atoi(arg1) == atoi(arg2)));
  79.         case UFLESS:    return(ltos(atoi(arg1) < atoi(arg2)));
  80.         case UFGREATER:    return(ltos(atoi(arg1) > atoi(arg2)));
  81.         case UFSEQUAL:    return(ltos(strcmp(arg1, arg2) == 0));
  82.         case UFSLESS:    return(ltos(strcmp(arg1, arg2) < 0));
  83.         case UFSGREAT:    return(ltos(strcmp(arg1, arg2) > 0));
  84.         case UFIND:    return(getval(arg1));
  85.         case UFAND:    return(ltos(stol(arg1) && stol(arg2)));
  86.         case UFOR:    return(ltos(stol(arg1) || stol(arg2)));
  87.         case UFLENGTH:    return(itoa(strlen(arg1)));
  88.         case UFUPPER:    return(mkupper(arg1));
  89.         case UFLOWER:    return(mklower(arg1));
  90.         case UFTRUTH:    return(ltos(atoi(arg1) == 42));
  91.         case UFASCII:    return(itoa((int)arg1[0]));
  92.         case UFCHR:    result[0] = atoi(arg1);
  93.                 result[1] = 0;
  94.                 return(result);
  95.         case UFGTKEY:    result[0] = tgetc();
  96.                 result[1] = 0;
  97.                 return(result);
  98.         case UFRND:    return(itoa((ernd() % abs(atoi(arg1))) + 1));
  99.         case UFABS:    return(itoa(abs(atoi(arg1))));
  100.     }
  101.  
  102.     exit(-11);    /* never should get here */
  103. }
  104.  
  105. char *gtusr(vname)    /* look up a user var's value */
  106.  
  107. char *vname;        /* name of user variable to fetch */
  108.  
  109. {
  110.  
  111.     register int vnum;    /* ordinal number of user var */
  112.  
  113.     /* scan the list looking for the user var name */
  114.     for (vnum = 0; vnum < MAXVARS; vnum++)
  115.         if (strcmp(vname, uv[vnum].u_name) == 0)
  116.             break;
  117.  
  118.     /* return errorm on a bad reference */
  119.     if (vnum == MAXVARS)
  120.         return(errorm);
  121.  
  122.     return(uv[vnum].u_value);
  123. }
  124.  
  125. char *gtenv(vname)
  126.  
  127. char *vname;        /* name of environment variable to retrieve */
  128.  
  129. {
  130.     register int vnum;    /* ordinal number of var refrenced */
  131.  
  132.     /* scan the list, looking for the referenced name */
  133.     for (vnum = 0; vnum < NEVARS; vnum++)
  134.         if (strcmp(vname, envars[vnum]) == 0)
  135.             break;
  136.  
  137.     /* return errorm on a bad reference */
  138.     if (vnum == NEVARS)
  139.         return(errorm);
  140.  
  141.     /* otherwise, fetch the appropriate value */
  142.     switch (vnum) {
  143.         case EVFILLCOL:    return(itoa(fillcol));
  144.         case EVPAGELEN:    return(itoa(term.t_nrow + 1));
  145.         case EVCURCOL:    return(itoa(getccol(FALSE) + 1));
  146.         case EVCURLINE: return(itoa(getcline()));
  147.         case EVRAM:    return(itoa((int)(envram / 1024l)));
  148.         case EVFLICKER:    return(ltos(flickcode));
  149.         case EVCURWIDTH:return(itoa(term.t_nrow));
  150.         case EVCBUFNAME:return(curbp->b_bname);
  151.         case EVCFNAME:    return(curbp->b_fname);
  152.         case EVSRES:    return(sres);
  153.         case EVDEBUG:    return(ltos(macbug));
  154.         case EVSTATUS:    return(ltos(cmdstatus));
  155.         case EVPALETTE:    return(palstr);
  156.         case EVASAVE:    return(itoa(gasave));
  157.         case EVACOUNT:    return(itoa(gacount));
  158.         case EVLASTKEY: return(itoa(lastkey));
  159.         case EVCURCHAR:    return(itoa(
  160.                     lgetc(curwp->w_dotp,curwp->w_doto)));
  161.         case EVDISCMD:    return(ltos(discmd));
  162.         case EVVERSION:    return(VERSION);
  163.         case EVPROGNAME:return(PROGNAME);
  164.         case EVSEED:    return(itoa(seed));
  165.         case EVDISINP:    return(ltos(disinp));
  166.     }
  167.     exit(-12);    /* again, we should never get here */
  168. }
  169.  
  170. int setvar(f, n)        /* set a variable */
  171.  
  172. int f;        /* default flag */
  173. int n;        /* numeric arg (can overide prompted value) */
  174.  
  175. {
  176.     register int vnum;    /* ordinal number of var refrenced */
  177.     register int status;    /* status return */
  178.     register int vtype;    /* type of variable to set */
  179.     register int c;        /* translated character */
  180.     register char * sp;    /* scratch string pointer */
  181.     char var[NVSIZE+1];    /* name of variable to fetch */
  182.     char value[NSTRING];    /* value to set variable to */
  183.  
  184.     /* first get the variable to set.. */
  185.     if (clexec == FALSE) {
  186.         status = mlreply("Variable to set: ", &var[0], NVSIZE);
  187.         if (status != TRUE)
  188.             return(status);
  189.     } else {    /* macro line argument */
  190.         /* grab token and skip it */
  191.         execstr = token(execstr, var);
  192.     }
  193.  
  194.     /* check the legality and find the var */
  195. sv01:    vtype = -1;
  196.     switch (var[0]) {
  197.  
  198.         case '$': /* check for legal enviromnent var */
  199.             for (vnum = 0; vnum < NEVARS; vnum++)
  200.                 if (strcmp(&var[1], envars[vnum]) == 0) {
  201.                     vtype = TKENV;
  202.                     break;
  203.                 }
  204.             break;
  205.  
  206.         case '%': /* check for existing legal user variable */
  207.             for (vnum = 0; vnum < MAXVARS; vnum++)
  208.                 if (strcmp(&var[1], uv[vnum].u_name) == 0) {
  209.                     vtype = TKVAR;
  210.                     break;
  211.                 }
  212.             if (vnum < MAXVARS)
  213.                 break;
  214.  
  215.             /* create a new one??? */
  216.             for (vnum = 0; vnum < MAXVARS; vnum++)
  217.                 if (uv[vnum].u_name[0] == 0) {
  218.                     vtype = TKVAR;
  219.                     strcpy(uv[vnum].u_name, &var[1]);
  220.                     break;
  221.                 }
  222.             break;
  223.  
  224.         case '&':    /* indirect operator? */
  225.             var[4] = 0;
  226.             if (strcmp(&var[1], "ind") == 0) {
  227.                 /* grab token, and eval it */
  228.                 execstr = token(execstr, var);
  229.                 strcpy(var, getval(var));
  230.                 goto sv01;
  231.             }
  232.     }
  233.  
  234.     /* if its not legal....bitch */
  235.     if (vtype == -1) {
  236.         mlwrite("%%No such variable");
  237.         return(FALSE);
  238.     }
  239.  
  240.     /* get the value for that variable */
  241.     if (f == TRUE)
  242.         strcpy(value, itoa(n));
  243.     else {
  244.         status = mlreply("Value: ", &value[0], NSTRING);
  245.         if (status != TRUE)
  246.             return(status);
  247.     }
  248.  
  249.     /* and set the appropriate value */
  250.     status = TRUE;
  251.     switch (vtype) {
  252.     case TKVAR: /* set a user variable */
  253.         if (uv[vnum].u_value != NULL)
  254.             free(uv[vnum].u_value);
  255.         sp = malloc(strlen(value) + 1);
  256.         if (sp == NULL)
  257.             return(FALSE);
  258.         strcpy(sp, value);
  259.         uv[vnum].u_value = sp;
  260.         break;
  261.  
  262.     case TKENV: /* set an environment variable */
  263.         status = TRUE;    /* by default */
  264.         switch (vnum) {
  265.         case EVFILLCOL:    fillcol = atoi(value);
  266.                 break;
  267.         case EVPAGELEN:    status = newsize(TRUE, atoi(value));
  268.                 break;
  269.         case EVCURCOL:    status = setccol(atoi(value));
  270.                 break;
  271.         case EVCURLINE:    status = gotoline(TRUE, atoi(value));
  272.                 break;
  273.         case EVRAM:    break;
  274.         case EVFLICKER:    flickcode = stol(value);
  275.                 break;
  276.         case EVCURWIDTH:status = newwidth(TRUE, atoi(value));
  277.                 break;
  278.         case EVCBUFNAME:strcpy(curbp->b_bname, value);
  279.                 curwp->w_flag |= WFMODE;
  280.                 break;
  281.         case EVCFNAME:    strcpy(curbp->b_fname, value);
  282.                 curwp->w_flag |= WFMODE;
  283.                 break;
  284.         case EVSRES:    status = TTrez(value);
  285.                 break;
  286.         case EVDEBUG:    macbug = stol(value);
  287.                 break;
  288.         case EVSTATUS:    cmdstatus = stol(value);
  289.                 break;
  290.         case EVPALETTE:    strncpy(palstr, value, 48);
  291.                 spal(palstr);
  292.                 break;
  293.         case EVASAVE:    gasave = atoi(value);
  294.                 break;
  295.         case EVACOUNT:    gacount = atoi(value);
  296.                 break;
  297.         case EVLASTKEY:    lastkey = atoi(value);
  298.                 break;
  299.         case EVCURCHAR:    ldelete(1, FALSE);    /* delete 1 char */
  300.                 c = atoi(value);
  301.                 if (c == '\n')
  302.                     lnewline(FALSE, 1);
  303.                 else
  304.                     linsert(1, c);
  305.                 break;
  306.         case EVDISCMD:    discmd = stol(value);
  307.                 break;
  308.         case EVVERSION:    break;
  309.         case EVPROGNAME:break;
  310.         case EVSEED:    seed = atoi(value);
  311.                 break;
  312.         case EVDISINP:    disinp = stol(value);
  313.                 break;
  314.         }
  315.         break;
  316.     }
  317.     return(status);
  318. }
  319.  
  320. /*    atoi:    ascii string to integer......This is too
  321.         inconsistant to use the system's    */
  322.  
  323. atoi(st)
  324.  
  325. char *st;
  326.  
  327. {
  328.     int result;    /* resulting number */
  329.     int sign;    /* sign of resulting number */
  330.     char c;        /* current char being examined */
  331.  
  332.     result = 0;
  333.     sign = 1;
  334.  
  335.     /* skip preceding whitespace */
  336.     while (*st == ' ' || *st == '\t')
  337.         ++st;
  338.  
  339.     /* check for sign */
  340.     if (*st == '-') {
  341.         sign = -1;
  342.         ++st;
  343.     }
  344.     if (*st == '+')
  345.         ++st;
  346.  
  347.     /* scan digits, build value */
  348.     while ((c = *st++))
  349.         if (c >= '0' && c <= '9')
  350.             result = result * 10 + c - '0';
  351.         else
  352.             return(0);
  353.  
  354.     return(result * sign);
  355. }
  356.  
  357. /*    itoa:    integer to ascii string.......... This is too
  358.         inconsistant to use the system's    */
  359.  
  360. char *itoa(i)
  361.  
  362. int i;    /* integer to translate to a string */
  363.  
  364. {
  365.     register int digit;        /* current digit being used */
  366.     register char *sp;        /* pointer into result */
  367.     register int sign;        /* sign of resulting number */
  368.     static char result[INTWIDTH+1];    /* resulting string */
  369.  
  370.     /* eliminate the trivial 0 */
  371.     if (i == 0)
  372.         return("0");
  373.  
  374.     /* record the sign...*/
  375.     sign = 1;
  376.     if (i < 0) {
  377.         sign = -1;
  378.         i = -i;
  379.     }
  380.  
  381.     /* and build the string (backwards!) */
  382.     sp = result + INTWIDTH;
  383.     *sp = 0;
  384.     while (i) {
  385.         digit = i % 10;
  386.         *(--sp) = '0' + digit;    /* and install the new digit */
  387.         i = i / 10;
  388.     }
  389.  
  390.     /* and fix the sign */
  391.     if (sign == -1) {
  392.         *(--sp) = '-';    /* and install the minus sign */
  393.     }
  394.  
  395.     return(sp);
  396. }
  397.  
  398. int gettyp(token)    /* find the type of a passed token */
  399.  
  400. char *token;    /* token to analyze */
  401.  
  402. {
  403.     register char c;    /* first char in token */
  404.  
  405.     /* grab the first char (this is all we need) */
  406.     c = *token;
  407.  
  408.     /* no blanks!!! */
  409.     if (c == 0)
  410.         return(TKNUL);
  411.  
  412.     /* a numeric literal? */
  413.     if (c >= '0' && c <= '9')
  414.         return(TKLIT);
  415.  
  416.     switch (c) {
  417.         case '"':    return(TKSTR);
  418.  
  419.         case '!':    return(TKDIR);
  420.         case '@':    return(TKARG);
  421.         case '#':    return(TKBUF);
  422.         case '$':    return(TKENV);
  423.         case '%':    return(TKVAR);
  424.         case '&':    return(TKFUN);
  425.         case '*':    return(TKLBL);
  426.  
  427.         default:    return(TKCMD);
  428.     }
  429. }
  430.  
  431. char *getval(token)    /* find the value of a token */
  432.  
  433. char *token;        /* token to evaluate */
  434.  
  435. {
  436.     register int status;    /* error return */
  437.     register BUFFER *bp;    /* temp buffer pointer */
  438.     register int blen;    /* length of buffer argument */
  439.     char pad[20];        /* pad 20 bytes on stack for safety */
  440.     char buf[NSTRING];    /* string buffer for some returns */
  441.  
  442.     switch (gettyp(token)) {
  443.         case TKNUL:    return("");
  444.  
  445.         case TKARG:    /* interactive argument */
  446.                 strcpy(token, getval(&token[1]));
  447.                 status = getstring(token,
  448.                        buf, NSTRING, ctoec('\n'));
  449.                 if (status == ABORT)
  450.                     return(errorm);
  451.                 return(buf);
  452.  
  453.         case TKBUF:    /* buffer contents fetch */
  454.  
  455.                 /* grab the right buffer */
  456.                 strcpy(token, getval(&token[1]));
  457.                 bp = bfind(token, FALSE, 0);
  458.                 if (bp == NULL)
  459.                     return(errorm);
  460.         
  461.                 /* if the buffer is displayed, get the window
  462.                    vars instead of the buffer vars */
  463.                 if (bp->b_nwnd > 0) {
  464.                     curbp->b_dotp = curwp->w_dotp;
  465.                     curbp->b_doto = curwp->w_doto;
  466.                 }
  467.  
  468.                 /* make sure we are not at the end */
  469.                 if (bp->b_linep == bp->b_dotp)
  470.                     return(errorm);
  471.         
  472.                 /* grab the line as an argument */
  473.                 blen = bp->b_dotp->l_used - bp->b_doto;
  474.                 if (blen > NSTRING)
  475.                     blen = NSTRING;
  476.                 strncpy(buf, bp->b_dotp->l_text + bp->b_doto,
  477.                     blen);
  478.                 buf[blen] = 0;
  479.         
  480.                 /* and step the buffer's line ptr ahead a line */
  481.                 bp->b_dotp = bp->b_dotp->l_fp;
  482.                 bp->b_doto = 0;
  483.  
  484.                 /* if displayed buffer, reset window ptr vars*/
  485.                 if (bp->b_nwnd > 0) {
  486.                     curwp->w_dotp = curbp->b_dotp;
  487.                     curwp->w_doto = 0;
  488.                     curwp->w_flag |= WFMOVE;
  489.                 }
  490.  
  491.                 /* and return the spoils */
  492.                 return(buf);        
  493.  
  494.         case TKVAR:    return(gtusr(token+1));
  495.         case TKENV:    return(gtenv(token+1));
  496.         case TKFUN:    return(gtfun(token+1));
  497.         case TKDIR:    return(errorm);
  498.         case TKLBL:    return(itoa(gtlbl(token)));
  499.         case TKLIT:    return(token);
  500.         case TKSTR:    return(token+1);
  501.         case TKCMD:    return(token);
  502.     }
  503. }
  504.  
  505. gtlbl(token)    /* find the line number of the given label */
  506.  
  507. char *token;    /* label name to find */
  508.  
  509. {
  510.     return(1);
  511. }
  512.  
  513. int stol(val)    /* convert a string to a numeric logical */
  514.  
  515. char *val;    /* value to check for stol */
  516.  
  517. {
  518.     /* check for logical values */
  519.     if (val[0] == 'F')
  520.         return(FALSE);
  521.     if (val[0] == 'T')
  522.         return(TRUE);
  523.  
  524.     /* check for numeric truth (!= 0) */
  525.     return((atoi(val) != 0));
  526. }
  527.  
  528. char *ltos(val)        /* numeric logical to string logical */
  529.  
  530. int val;    /* value to translate */
  531.  
  532. {
  533.     if (val)
  534.         return(truem);
  535.     else
  536.         return(falsem);
  537. }
  538.  
  539. char *mkupper(str)    /* make a string upper case */
  540.  
  541. char *str;        /* string to upper case */
  542.  
  543. {
  544.     char *sp;
  545.  
  546.     sp = str;
  547.     while (*sp) {
  548.         if ('a' <= *sp && *sp <= 'z')
  549.             *sp += 'A' - 'a';
  550.         ++sp;
  551.     }
  552.     return(str);
  553. }
  554.  
  555. char *mklower(str)    /* make a string lower case */
  556.  
  557. char *str;        /* string to lower case */
  558.  
  559. {
  560.     char *sp;
  561.  
  562.     sp = str;
  563.     while (*sp) {
  564.         if ('A' <= *sp && *sp <= 'Z')
  565.             *sp += 'a' - 'A';
  566.         ++sp;
  567.     }
  568.     return(str);
  569. }
  570.  
  571. int abs(x)    /* take the absolute value of an integer */
  572.  
  573. int x;
  574.  
  575. {
  576.     return(x < 0 ? -x : x);
  577. }
  578.  
  579. int ernd()    /* returns a random integer */
  580.  
  581. {
  582.     seed = abs(seed * 1721 + 10007);
  583.     return(seed);
  584. }
  585.