home *** CD-ROM | disk | FTP | other *** search
/ The C Users' Group Library 1994 August / wc-cdrom-cusersgrouplibrary-1994-08.iso / vol_100 / 198_01 / eval.c < prev    next >
C/C++ Source or Header  |  1990-01-23  |  27KB  |  1,083 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. varinit()        /* initialize the user variable list */
  12.  
  13. {
  14.     register int i;
  15.  
  16.     for (i=0; i < MAXVARS; i++)
  17.         uv[i].u_name[0] = 0;
  18. }
  19.  
  20. char *gtfun(fname)    /* evaluate a function */
  21.  
  22. char *fname;        /* name of function to evaluate */
  23.  
  24. {
  25.     register int fnum;        /* index to function to eval */
  26.     register int arg;        /* value of some arguments */
  27.     char arg1[NSTRING];        /* value of first argument */
  28.     char arg2[NSTRING];        /* value of second argument */
  29.     char arg3[NSTRING];        /* value of third argument */
  30.     static char result[2 * NSTRING];    /* string result */
  31. #if    ENVFUNC
  32.     char *getenv();
  33. #endif
  34.  
  35.     /* look the function up in the function table */
  36.     fname[3] = 0;    /* only first 3 chars significant */
  37.     mklower(fname);    /* and let it be upper or lower case */
  38.     for (fnum = 0; fnum < NFUNCS; fnum++)
  39.         if (strcmp(fname, funcs[fnum].f_name) == 0)
  40.             break;
  41.  
  42.     /* return errorm on a bad reference */
  43.     if (fnum == NFUNCS)
  44.         return(errorm);
  45.  
  46.     /* if needed, retrieve the first argument */
  47.     if (funcs[fnum].f_type >= MONAMIC) {
  48.         if (macarg(arg1) != TRUE)
  49.             return(errorm);
  50.  
  51.         /* if needed, retrieve the second argument */
  52.         if (funcs[fnum].f_type >= DYNAMIC) {
  53.             if (macarg(arg2) != TRUE)
  54.                 return(errorm);
  55.     
  56.             /* if needed, retrieve the third argument */
  57.             if (funcs[fnum].f_type >= TRINAMIC)
  58.                 if (macarg(arg3) != TRUE)
  59.                     return(errorm);
  60.         }
  61.     }
  62.         
  63.  
  64.     /* and now evaluate it! */
  65.     switch (fnum) {
  66.         case UFADD:    return(itoa(atoi(arg1) + atoi(arg2)));
  67.         case UFSUB:    return(itoa(atoi(arg1) - atoi(arg2)));
  68.         case UFTIMES:    return(itoa(atoi(arg1) * atoi(arg2)));
  69.         case UFDIV:    return(itoa(atoi(arg1) / atoi(arg2)));
  70.         case UFMOD:    return(itoa(atoi(arg1) % atoi(arg2)));
  71.         case UFNEG:    return(itoa(-atoi(arg1)));
  72.         case UFCAT:    bytecopy(result, arg1, NSTRING-1);
  73.                 bytecopy(&result[strlen(result)], arg2,
  74.                     NSTRING-1-strlen(result));
  75.                 return(result);
  76.         case UFLEFT:    return(bytecopy(result, arg1, atoi(arg2)));
  77.         case UFRIGHT:    arg = atoi(arg2);
  78.                 if (arg > strlen(arg1)) arg = strlen(arg1);
  79.                 return(strcpy(result,
  80.                     &arg1[strlen(arg1)-arg]));
  81.         case UFMID:    arg = atoi(arg2);
  82.                 if (arg > strlen(arg1)) arg = strlen(arg1);
  83.                 return(bytecopy(result, &arg1[arg-1],
  84.                     atoi(arg3)));
  85.         case UFNOT:    return(ltos(stol(arg1) == FALSE));
  86.         case UFEQUAL:    return(ltos(atoi(arg1) == atoi(arg2)));
  87.         case UFLESS:    return(ltos(atoi(arg1) < atoi(arg2)));
  88.         case UFGREATER:    return(ltos(atoi(arg1) > atoi(arg2)));
  89.         case UFSEQUAL:    return(ltos(strcmp(arg1, arg2) == 0));
  90.         case UFSLESS:    return(ltos(strcmp(arg1, arg2) < 0));
  91.         case UFSGREAT:    return(ltos(strcmp(arg1, arg2) > 0));
  92.         case UFIND:    return(bytecopy(result, fixnull(getval(arg1)),
  93.                     NSTRING-1));
  94.         case UFAND:    return(ltos(stol(arg1) && stol(arg2)));
  95.         case UFOR:    return(ltos(stol(arg1) || stol(arg2)));
  96.         case UFLENGTH:    return(itoa(strlen(arg1)));
  97.         case UFUPPER:    return(mkupper(arg1));
  98.         case UFLOWER:    return(mklower(arg1));
  99.         case UFTRUTH:    return(ltos(atoi(arg1) == 42));
  100.         case UFASCII:    return(itoa((int)arg1[0]));
  101.         case UFCHR:    result[0] = atoi(arg1);
  102.                 result[1] = 0;
  103.                 return(result);
  104.         case UFGTCMD:    cmdstr(getcmd(), result);
  105.                 return(result);
  106.         case UFGTKEY:    result[0] = tgetc();
  107.                 result[1] = 0;
  108.                 return(result);
  109.         case UFRND:    return(itoa((ernd() % abs(atoi(arg1))) + 1));
  110.         case UFABS:    return(itoa(abs(atoi(arg1))));
  111.         case UFSINDEX:    return(itoa(sindex(arg1, arg2)));
  112.         case UFENV:
  113. #if    ENVFUNC
  114.                 return(fixnull(getenv(arg1)));
  115. #else
  116.                 return("");
  117. #endif
  118.         case UFBIND:    return(transbind(arg1));
  119.          case UFBAND:    return(int_asc(asc_int(arg1) & asc_int(arg2)));
  120.          case UFBOR:    return(int_asc(asc_int(arg1) | asc_int(arg2)));
  121.          case UFBXOR:    return(int_asc(asc_int(arg1) ^ asc_int(arg2)));
  122.         case UFBNOT:    return(int_asc(~asc_int(arg1)));
  123.     }
  124.  
  125.     exit(-11);    /* never should get here */
  126. }
  127.  
  128. char *gtusr(vname)    /* look up a user var's value */
  129.  
  130. char *vname;        /* name of user variable to fetch */
  131.  
  132. {
  133.  
  134.     register int vnum;    /* ordinal number of user var */
  135.  
  136.     /* scan the list looking for the user var name */
  137.     for (vnum = 0; vnum < MAXVARS; vnum++)
  138.         if (strcmp(vname, uv[vnum].u_name) == 0)
  139.             break;
  140.  
  141.     /* return errorm on a bad reference */
  142.     if (vnum == MAXVARS)
  143.         return(errorm);
  144.  
  145.     return(uv[vnum].u_value);
  146. }
  147.  
  148. #if    DECEDT
  149. extern int advset;
  150. #endif
  151.  
  152. char *gtenv(vname)
  153.  
  154. char *vname;        /* name of environment variable to retrieve */
  155.  
  156. {
  157.     register int vnum;    /* ordinal number of var refrenced */
  158.     char *getkill();
  159.  
  160.     /* scan the list, looking for the referenced name */
  161.     for (vnum = 0; vnum < NEVARS; vnum++)
  162.         if (strcmp(vname, envars[vnum]) == 0)
  163.             break;
  164.  
  165.     /* return errorm on a bad reference */
  166.     if (vnum == NEVARS)
  167.         return(errorm);
  168.  
  169.     /* otherwise, fetch the appropriate value */
  170.     switch (vnum) {
  171.         case EVFILLCOL:    return(itoa(fillcol));
  172.         case EVPAGELEN:    return(itoa(term.t_nrow + 1));
  173.         case EVCURCOL:    return(itoa(getccol(FALSE)));
  174.         case EVCURLINE: return(itoa(getcline()));
  175.         case EVRAM:    return(itoa((int)(envram / 1024l)));
  176.         case EVFLICKER:    return(ltos(flickcode));
  177.         case EVCURWIDTH:return(itoa(term.t_nrow));
  178.         case EVCBUFNAME:return(curbp->b_bname);
  179.         case EVCBFLAGS:    return(itoa(curbp->b_flag));
  180.         case EVCFNAME:    return(curbp->b_fname);
  181.         case EVSRES:    return(sres);
  182.         case EVDEBUG:    return(ltos(macbug));
  183.         case EVSTATUS:    return(ltos(cmdstatus));
  184.         case EVPALETTE:    return(palstr);
  185.         case EVASAVE:    return(itoa(gasave));
  186.         case EVACOUNT:    return(itoa(gacount));
  187.         case EVLASTKEY: return(itoa(lastkey));
  188.         case EVCURCHAR:
  189.             return(curwp->w_dotp->l_used ==
  190.                     curwp->w_doto ? itoa('\n') :
  191.                 itoa(lgetc(curwp->w_dotp, curwp->w_doto)));
  192.         case EVDISCMD:    return(ltos(discmd));
  193.         case EVVERSION:    return(VERSION);
  194.         case EVPROGNAME:return(PROGNAME);
  195.         case EVSEED:    return(itoa(seed));
  196.         case EVDISINP:    return(ltos(disinp));
  197.         case EVWLINE:    return(itoa(curwp->w_ntrows));
  198.         case EVCWLINE:    return(itoa(getwpos()));
  199.         case EVTARGET:    saveflag = lastflag;
  200.                 return(itoa(curgoal));
  201.         case EVSEARCH:    return(pat);
  202.         case EVREPLACE:    return(rpat);
  203.         case EVMATCH:    return((patmatch == NULL)? "": patmatch);
  204.         case EVKILL:    return(getkill());
  205.         case EVCMODE:    return(itoa(curbp->b_mode));
  206.         case EVGMODE:    return(itoa(gmode));
  207.         case EVTPAUSE:    return(itoa(term.t_pause));
  208.         case EVPENDING:
  209. #if    TYPEAH
  210.                 return(ltos(typahead()));
  211. #else
  212.                 return(falsem);
  213. #endif
  214.         case EVLWIDTH:    return(itoa(llength(curwp->w_dotp)));
  215.         case EVLINE:    return(getctext());
  216.         case EVHARDTAB:    return(int_asc(tabsize));
  217.         case EVSOFTTAB:    return(int_asc(stabsize));
  218.         case EVFCOL:    return(itoa(curwp->w_fcol));
  219.         case EVHSCROLL:    return(ltos(hscroll));
  220.         case EVHJUMP:    return(int_asc(hjump));
  221.         case EVADVANCE:
  222. #if    DECEDT
  223.             return(itoa(advset));
  224. #else
  225.             return(itoa(1));
  226. #endif
  227.         case EVVT100KEYS: return(itoa(vt100keys));
  228.     }
  229.     exit(-12);    /* again, we should never get here */
  230. }
  231.  
  232. char *fixnull(s)    /* Don't return NULL pointers! */
  233.  
  234. char *s;
  235.  
  236. {
  237.     if (s == NULL)
  238.         return("");
  239.     else
  240.         return(s);
  241. }
  242. char *getkill()        /* return some of the contents of the kill buffer */
  243.  
  244. {
  245.     register int size;    /* max number of chars to return */
  246.     static char value[NSTRING];    /* temp buffer for value */
  247.  
  248.     if (kbufh == NULL)
  249.         /* no kill buffer....just a null string */
  250.         value[0] = 0;
  251.     else {
  252.         /* copy in the contents... */
  253.         if (kused < NSTRING)
  254.             size = kused;
  255.         else
  256.             size = NSTRING - 1;
  257.         bytecopy(value, kbufh->d_chunk, size);
  258.     }
  259.  
  260.     /* and return the constructed value */
  261.     return(value);
  262. }
  263.  
  264. int setvar(f, n)        /* set a variable */
  265.  
  266. int f;        /* default flag */
  267. int n;        /* numeric arg (can overide prompted value) */
  268.  
  269. {
  270.     register int status;    /* status return */
  271.     VDESC vd;        /* variable num/type */
  272.     char var[NVSIZE+1];    /* name of variable to fetch */
  273.     char value[NSTRING];    /* value to set variable to */
  274.  
  275.     /* first get the variable to set.. */
  276.     if (clexec == FALSE) {
  277.         status = mlreply("Variable to set: ", &var[0], NVSIZE);
  278.         if (status != TRUE)
  279.             return(status);
  280.     } else {    /* macro line argument */
  281.         /* grab token and skip it */
  282.         execstr = token(execstr, var, NVSIZE+1);
  283.     }
  284.  
  285.     /* check the legality and find the var */
  286.     findvar(var, &vd, NVSIZE+1);
  287.     
  288.     /* if its not legal....bitch */
  289.     if (vd.v_type == -1) {
  290.         mlwrite("%%No such variable as '%s'", var);
  291.         return(FALSE);
  292.     }
  293.  
  294.     /* get the value for that variable */
  295.     if (f == TRUE)
  296.         strcpy(value, itoa(n));
  297.     else {
  298.         status = mlreply("Value: ", &value[0], NSTRING);
  299.         if (status != TRUE)
  300.             return(status);
  301.     }
  302.  
  303.     /* and set the appropriate value */
  304.     status = svar(&vd, value);
  305.  
  306. #if    DEBUGM
  307.     /* if $debug == TRUE, every assignment will echo a statment to
  308.        that effect here. */
  309.     
  310.     if (macbug) {
  311.         strcpy(outline, "(((");
  312.  
  313.         /* assignment status */
  314.         strcat(outline, ltos(status));
  315.         strcat(outline, ":");
  316.  
  317.         /* variable name */
  318.         strcat(outline, var);
  319.         strcat(outline, ":");
  320.  
  321.         /* and lastly the value we tried to assign */
  322.         bytecopy(&outline[strlen(outline)], value, NSTRING-NVSIZE-20);
  323.         strcat(outline, ")))");
  324.  
  325.         /* expand '%' to "%%" so mlwrite wont bitch */
  326.         makelit(outline, NSTRING);
  327.  
  328.         /* write out the debug line */
  329.         mlforce(outline);
  330.         update(TRUE);
  331.  
  332.         /* and get the keystroke to hold the output */
  333.         if (get1key() == abortc) {
  334.             mlforce("[Macro aborted]");
  335.             status = FALSE;
  336.         }
  337.     }
  338. #endif
  339.  
  340.     /* and return it */
  341.     return(status);
  342. }
  343.  
  344. findvar(var, vd, size)    /* find a variables type and name */
  345.  
  346. char *var;    /* name of var to get */
  347. VDESC *vd;    /* structure to hold type and ptr */
  348. int size;    /* size of var array */
  349.  
  350. {
  351.     register int vnum;    /* subscript in varable arrays */
  352.     register int vtype;    /* type to return */
  353.  
  354. fvar:    vtype = -1;
  355.     switch (var[0]) {
  356.  
  357.         case '$': /* check for legal enviromnent var */
  358.             for (vnum = 0; vnum < NEVARS; vnum++)
  359.                 if (strcmp(&var[1], envars[vnum]) == 0) {
  360.                     vtype = TKENV;
  361.                     break;
  362.                 }
  363.             break;
  364.  
  365.         case '%': /* check for existing legal user variable */
  366.             for (vnum = 0; vnum < MAXVARS; vnum++)
  367.                 if (strcmp(&var[1], uv[vnum].u_name) == 0) {
  368.                     vtype = TKVAR;
  369.                     break;
  370.                 }
  371.             if (vnum < MAXVARS)
  372.                 break;
  373.  
  374.             /* create a new one??? */
  375.             for (vnum = 0; vnum < MAXVARS; vnum++)
  376.                 if (uv[vnum].u_name[0] == 0) {
  377.                     vtype = TKVAR;
  378.                     bytecopy(uv[vnum].u_name,
  379.                             &var[1], NVSIZE);
  380.                     break;
  381.                 }
  382.             break;
  383.  
  384.         case '&':    /* indirect operator? */
  385.             var[4] = 0;
  386.             if (strcmp(&var[1], "ind") == 0) {
  387.                 /* grab token, and eval it */
  388.                 execstr = token(execstr, var, size);
  389.                 bytecopy(var, fixnull(getval(var)), size);
  390.                 goto fvar;
  391.             }
  392.     }
  393.  
  394.     /* return the results */
  395.     vd->v_num = vnum;
  396.     vd->v_type = vtype;
  397.     return;
  398. }
  399.  
  400. int svar(var, value)        /* set a variable */
  401.  
  402. VDESC *var;    /* variable to set */
  403. char *value;    /* value to set to */
  404.  
  405. {
  406.     register int vnum;    /* ordinal number of var refrenced */
  407.     register int vtype;    /* type of variable to set */
  408.     register int status;    /* status return */
  409.     register int c;        /* translated character */
  410.     register char * sp;    /* scratch string pointer */
  411.  
  412.     /* simplify the vd structure (we are gonna look at it a lot) */
  413.     vnum = var->v_num;
  414.     vtype = var->v_type;
  415.  
  416.     /* and set the appropriate value */
  417.     status = TRUE;
  418.     switch (vtype) {
  419.     case TKVAR: /* set a user variable */
  420.         if (uv[vnum].u_value != NULL)
  421.             free(uv[vnum].u_value);
  422.         sp = malloc(strlen(value) + 1);
  423.         if (sp == NULL)
  424.             return(FALSE);
  425.         strcpy(sp, value);
  426.         uv[vnum].u_value = sp;
  427.         break;
  428.  
  429.     case TKENV: /* set an environment variable */
  430.         status = TRUE;    /* by default */
  431.         switch (vnum) {
  432.         case EVFILLCOL:    fillcol = atoi(value);
  433.                 break;
  434.         case EVPAGELEN:    status = newsize(TRUE, atoi(value));
  435.                 break;
  436.         case EVCURCOL:    status = setccol(atoi(value));
  437.                 break;
  438.         case EVCURLINE:    status = gotoline(TRUE, atoi(value));
  439.                 break;
  440.         case EVRAM:    break;
  441.         case EVFLICKER:    flickcode = stol(value);
  442.                 break;
  443.         case EVCURWIDTH:status = newwidth(TRUE, atoi(value));
  444.                 break;
  445.         case EVCBFLAGS:    curbp->b_flag =
  446.                  ((curbp->b_flag & ~(BFCHG|BFINVS|BFTRUNC)) |
  447.                   (atoi(value) & (BFCHG|BFINVS|BFTRUNC)));
  448.                 upmode();
  449.                 break;
  450.         case EVCBUFNAME:bytecopy(curbp->b_bname, value, NBUFN);
  451.                 upmode();
  452.                 break;
  453.         case EVCFNAME:    bytecopy(curbp->b_fname, value, NFILEN);
  454.                 upmode();
  455.                 break;
  456.         case EVSRES:    status = TTrez(value);
  457.                 break;
  458.         case EVDEBUG:    macbug = stol(value);
  459.                 break;
  460.         case EVSTATUS:    cmdstatus = stol(value);
  461.                 break;
  462.         case EVPALETTE:    bytecopy(palstr, value, 48);
  463.                 spal(palstr);
  464.                 break;
  465.         case EVASAVE:    gasave = atoi(value);
  466.                 break;
  467.         case EVACOUNT:    gacount = atoi(value);
  468.                 break;
  469.         case EVLASTKEY:    lastkey = atoi(value);
  470.                 break;
  471.         case EVCURCHAR:    ldelete(1L, FALSE);    /* delete 1 char */
  472.                 c = atoi(value);
  473.                 if (c == '\n')
  474.                     lnewline();
  475.                 else
  476.                     linsert(1, c);
  477.                 backchar(FALSE, 1);
  478.                 break;
  479.         case EVDISCMD:    discmd = stol(value);
  480.                 break;
  481.         case EVVERSION:    break;
  482.         case EVPROGNAME:break;
  483.         case EVSEED:    seed = atoi(value);
  484.                 break;
  485.         case EVDISINP:    disinp = stol(value);
  486.                 break;
  487.         case EVWLINE:    status = resize(TRUE, atoi(value));
  488.                 break;
  489.         case EVCWLINE:    status = forwline(TRUE,
  490.                         atoi(value) - getwpos());
  491.                 break;
  492.         case EVTARGET:    curgoal = atoi(value);
  493.                 thisflag = saveflag;
  494.                 break;
  495.         case EVSEARCH:    strcpy(pat, value);
  496.                 setjtable(pat);
  497. #if    MAGIC
  498.                 mcclear();
  499. #endif
  500.                 break;
  501.         case EVREPLACE:    strcpy(rpat, value);
  502.                 break;
  503.         case EVMATCH:    break;
  504.         case EVKILL:    break;
  505.         case EVCMODE:    curbp->b_mode = atoi(value);
  506.                 curwp->w_flag |= WFMODE;
  507.                 break;
  508.         case EVGMODE:    gmode = atoi(value);
  509.                 break;
  510.         case EVTPAUSE:    term.t_pause = atoi(value);
  511.                 break;
  512.         case EVPENDING:    break;
  513.         case EVLWIDTH:    break;
  514.         case EVLINE:    putctext(value); break;
  515.         case EVHARDTAB:    tabsize = asc_int(value);
  516.                 if (tabsize <= 0) tabsize = 1;
  517.                 upwind();
  518.                 break;
  519.         case EVSOFTTAB:    stabsize = asc_int(value);
  520.                 upwind();
  521.                 break;
  522.         case EVFCOL:    curwp->w_fcol = atoi(value);
  523.                 if (curwp->w_fcol < 0)
  524.                     curwp->w_fcol = 0;
  525.                 curwp->w_flag |= WFHARD | WFMODE;
  526.                 break;
  527.         case EVHSCROLL:    hscroll = stol(value);
  528.                 lbound = 0;
  529.                 break;
  530.         case EVHJUMP:    hjump = asc_int(value);
  531.                 if (hjump < 1)
  532.                     hjump = 1;
  533.                 if (hjump > term.t_ncol - 1)
  534.                     hjump = term.t_ncol - 1;
  535.                 break;
  536.         case EVADVANCE:
  537. #if    DECEDT
  538.                 advset = atoi(value);
  539. #endif
  540.                 break;
  541.         case EVVT100KEYS: vt100keys = atoi(value); break;
  542.         }
  543.         break;
  544.     }
  545.     return(status);
  546. }
  547.  
  548. /* atoi and itoa defined to asc_int and int_asc in estruct.h */
  549.  
  550. /*    asc_int:    ascii string to integer......This is too
  551.         inconsistant to use the system's    */
  552.  
  553. atoi(st)
  554.  
  555. char *st;
  556.  
  557. {
  558.     int result;    /* resulting number */
  559.     int sign;    /* sign of resulting number */
  560.     char c;        /* current char being examined */
  561.  
  562.     result = 0;
  563.     sign = 1;
  564.  
  565.     /* skip preceding whitespace */
  566.     while (*st == ' ' || *st == '\t')
  567.         ++st;
  568.  
  569.     /* check for sign */
  570.     if (*st == '-') {
  571.         sign = -1;
  572.         ++st;
  573.     }
  574.     if (*st == '+')
  575.         ++st;
  576.  
  577.     /* scan digits, build value */
  578.     while ((c = *st++) != '\0')
  579.         if (c >= '0' && c <= '9')
  580.             result = result * 10 + c - '0';
  581.         else
  582.             break;
  583.  
  584.     return(result * sign);
  585. }
  586.  
  587. /*    int_asc:    integer to ascii string.......... This is too
  588.             inconsistant to use the system's    */
  589.  
  590. char *itoa(i)
  591.  
  592. int i;    /* integer to translate to a string */
  593.  
  594. {
  595.     register int digit;        /* current digit being used */
  596.     register char *sp;        /* pointer into result */
  597.     register int sign;        /* sign of resulting number */
  598.     static char result[INTWIDTH+1];    /* resulting string */
  599.  
  600.     /* record the sign...*/
  601.     sign = 1;
  602.     if (i < 0) {
  603.         sign = -1;
  604.         i = -i;
  605.     }
  606.  
  607.     /* and build the string (backwards!) */
  608.     sp = result + INTWIDTH;
  609.     *sp = 0;
  610.     do {
  611.         digit = i % 10;
  612.         *(--sp) = '0' + digit;    /* and install the new digit */
  613.         i = i / 10;
  614.     } while (i);
  615.  
  616.     /* and fix the sign */
  617.     if (sign == -1) {
  618.         *(--sp) = '-';    /* and install the minus sign */
  619.     }
  620.  
  621.     return(sp);
  622. }
  623.  
  624. int gettyp(tok)    /* find the type of a passed token */
  625.  
  626. char *tok;    /* token to analyze */
  627.  
  628. {
  629.     register char c;    /* first char in token */
  630.  
  631.     /* grab the first char (this is all we need) */
  632.     c = *tok;
  633.  
  634.     /* no blanks!!! */
  635.     if (c == 0)
  636.         return(TKNUL);
  637.  
  638.     /* a numeric literal? */
  639.     if (c >= '0' && c <= '9')
  640.         return(TKLIT);
  641.  
  642.     switch (c) {
  643.         case '"':    return(TKSTR);
  644.  
  645.         case '!':    return(TKDIR);
  646.         case '@':    return(TKARG);
  647.         case '#':    return(TKBUF);
  648.         case '$':    return(TKENV);
  649.         case '%':    return(TKVAR);
  650.         case '&':    return(TKFUN);
  651.         case '*':    return(TKLBL);
  652.  
  653.         default:    return(TKCMD);
  654.     }
  655. }
  656.  
  657. char *getval(tok)    /* find the value of a token */
  658.  
  659. char *tok;        /* token to evaluate */
  660.  
  661. {
  662.     register int status;    /* error return */
  663.     register BUFFER *bp;    /* temp buffer pointer */
  664.     register int blen;    /* length of buffer argument */
  665.     register int distmp;    /* temporary discmd flag */
  666.     char buf[NSTRING];    /* string buffer for some returns */
  667.  
  668.     switch (gettyp(tok)) {
  669.         case TKNUL:    return("");
  670.  
  671.         case TKARG:    /* interactive argument */
  672.                 strcpy(tok, getval(&tok[1]));
  673.                 distmp = discmd;    /* echo it always! */
  674.                 discmd = TRUE;
  675.                 status = getstring(tok,
  676.                        buf, NSTRING, ctoec('\n'));
  677.                 discmd = distmp;
  678.                 if (status == ABORT)
  679.                     return(errorm);
  680.                 return(buf);
  681.  
  682.         case TKBUF:    /* buffer contents fetch */
  683.  
  684.                 /* grab the right buffer */
  685.                 strcpy(tok, getval(&tok[1]));
  686.                 bp = bfind(tok, FALSE, 0);
  687.                 if (bp == NULL)
  688.                     return(errorm);
  689.         
  690.                 /* if the buffer is displayed, get the window
  691.                    vars instead of the buffer vars */
  692.                 if (bp->b_nwnd > 0) {
  693.                     curbp->b_dotp = curwp->w_dotp;
  694.                     curbp->b_doto = curwp->w_doto;
  695.                 }
  696.  
  697.                 /* make sure we are not at the end */
  698.                 if (bp->b_linep == bp->b_dotp)
  699.                     return(errorm);
  700.         
  701.                 /* grab the line as an argument */
  702.                 blen = bp->b_dotp->l_used - bp->b_doto;
  703.                 if (blen >= NSTRING)
  704.                     blen = NSTRING-1;
  705.                 bytecopy(buf, bp->b_dotp->l_text + bp->b_doto,
  706.                     blen);
  707.                 buf[blen] = 0;
  708.         
  709.                 /* and step the buffer's line ptr ahead a line */
  710.                 bp->b_dotp = bp->b_dotp->l_fp;
  711.                 bp->b_doto = 0;
  712.  
  713.                 /* if displayed buffer, reset window ptr vars*/
  714.                 if (bp->b_nwnd > 0) {
  715.                     curwp->w_dotp = curbp->b_dotp;
  716.                     curwp->w_doto = 0;
  717.                     curwp->w_flag |= WFMOVE;
  718.                 }
  719.  
  720.                 /* and return the spoils */
  721.                 return(buf);        
  722.  
  723.         case TKVAR:    return(gtusr(tok+1));
  724.         case TKENV:    return(gtenv(tok+1));
  725.         case TKFUN:    return(gtfun(tok+1));
  726.         case TKDIR:    return(errorm);
  727.         case TKLBL:    return(itoa(gtlbl(tok)));
  728.         case TKLIT:    return(tok);
  729.         case TKSTR:    return(tok+1);
  730.         case TKCMD:    return(tok);
  731.     }
  732. }
  733.  
  734. gtlbl(tok)    /* find the line number of the given label */
  735.  
  736. char *tok;    /* label name to find */
  737.  
  738. {
  739.     return(1);
  740. }
  741.  
  742. int stol(val)    /* convert a string to a numeric logical */
  743.  
  744. char *val;    /* value to check for stol */
  745.  
  746. {
  747.     /* check for logical values */
  748.     if (val[0] == 'F' || val[0] == 'f' || val[0] == 'N' || val[0] == 'n')
  749.         return(FALSE);
  750.     if (val[0] == 'T' || val[0] == 't' || val[0] == 'Y' || val[0] == 'y')
  751.         return(TRUE);
  752.  
  753.     /* check for numeric truth (!= 0) */
  754.     return((atoi(val) != 0));
  755. }
  756.  
  757. char *ltos(val)        /* numeric logical to string logical */
  758.  
  759. int val;    /* value to translate */
  760.  
  761. {
  762.     if (val)
  763.         return(truem);
  764.     else
  765.         return(falsem);
  766. }
  767.  
  768. char *mkupper(str)    /* make a string upper case */
  769.  
  770. char *str;        /* string to upper case */
  771.  
  772. {
  773.     char *sp;
  774.  
  775.     sp = str;
  776.     while (*sp) {
  777.         if ('a' <= *sp && *sp <= 'z')
  778.             *sp += 'A' - 'a';
  779.         ++sp;
  780.     }
  781.     return(str);
  782. }
  783.  
  784. char *mklower(str)    /* make a string lower case */
  785.  
  786. char *str;        /* string to lower case */
  787.  
  788. {
  789.     char *sp;
  790.  
  791.     sp = str;
  792.     while (*sp) {
  793.         if ('A' <= *sp && *sp <= 'Z')
  794.             *sp += 'a' - 'A';
  795.         ++sp;
  796.     }
  797.     return(str);
  798. }
  799.  
  800. #if    (MSC & MSDOS) | VMS
  801. #else
  802. int abs(x)    /* take the absolute value of an integer */
  803.  
  804. int x;
  805.  
  806. {
  807.     return(x < 0 ? -x : x);
  808. }
  809. #endif
  810.  
  811. int ernd()    /* returns a random integer */
  812.  
  813. {
  814.     seed = abs(seed * 1721 + 10007);
  815.     return(seed);
  816. }
  817.  
  818. int sindex(source, pattern)    /* find pattern within source */
  819.  
  820. char *source;    /* source string to search */
  821. char *pattern;    /* string to look for */
  822.  
  823. {
  824.     char *sp;    /* ptr to current position to scan */
  825.     char *csp;    /* ptr to source string during comparison */
  826.     char *cp;    /* ptr to place to check for equality */
  827.  
  828.     /* scanning through the source string */
  829.     sp = source;
  830.     while (*sp) {
  831.         /* scan through the pattern */
  832.         cp = pattern;
  833.         csp = sp;
  834.         while (*cp) {
  835.             if (!eq(*cp, *csp))
  836.                 break;
  837.             ++cp;
  838.             ++csp;
  839.         }
  840.  
  841.         /* was it a match? */
  842.         if (*cp == 0)
  843.             return((int)(sp - source) + 1);
  844.         ++sp;
  845.     }
  846.  
  847.     /* no match at all.. */
  848.     return(0);
  849. }
  850.  
  851. #if    DEBUGM
  852. int dispvar(f, n)        /* display a variable's value */
  853.  
  854. int f;        /* default flag */
  855. int n;        /* numeric arg (can overide prompted value) */
  856.  
  857. {
  858.     register int status;    /* status return */
  859.     VDESC vd;        /* variable num/type */
  860.     char var[NVSIZE+1];    /* name of variable to fetch */
  861.  
  862.     /* first get the variable to dispaly.. */
  863.     if (clexec == FALSE) {
  864.         status = mlreply("Variable to display: ", &var[0], NVSIZE+1);
  865.         if (status != TRUE)
  866.             return(status);
  867.     } else {    /* macro line argument */
  868.         /* grab token and skip it */
  869.         execstr = token(execstr, var, NVSIZE + 1);
  870.     }
  871.  
  872.     /* check the legality and find the var */
  873.     findvar(var, &vd, NVSIZE + 1);
  874.     
  875.     /* if its not legal....bitch */
  876.     if (vd.v_type == -1) {
  877.         mlwrite("%%No such variable as '%s'", var);
  878.         return(FALSE);
  879.     }
  880.  
  881.     /* and display the value */
  882.     strcpy(outline, var);
  883.     strcat(outline, " = ");
  884.  
  885.     /* and lastly the current value */
  886.     strcat(outline, fixnull(getval(var)));
  887.  
  888.     /* expand '%' to "%%" so mlwrite wont bitch */
  889.     makelit(outline, NSTRING);
  890.  
  891.     /* write out the result */
  892.     mlforce(outline);
  893.     update(TRUE);
  894.  
  895.     /* and return */
  896.     return(TRUE);
  897. }
  898.  
  899. /*    describe-variables    Bring up a fake buffer and list the contents
  900.                 of all the environment variables
  901. */
  902.  
  903. desvars(f, n)
  904.  
  905. {
  906.     register WINDOW *wp;    /* scanning pointer to windows */
  907.     register BUFFER *bp;    /* buffer to put binding list into */
  908.     register int uindex;    /* index into uvar table */
  909.     char outseq[NSTRING+NVSIZE+20];    /* output buffer for keystroke sequence */
  910.  
  911.     /* split the current window to make room for the variable list */
  912.     if (splitwind(FALSE, 1) == FALSE)
  913.         return(FALSE);
  914.     curwp = spltwp; curbp = curwp->w_bufp;
  915.  
  916.     /* and get a buffer for it */
  917.     bp = bfind("Variable list", TRUE, 0);
  918.     if (bp == NULL || bclear(bp) == FALSE) {
  919.         mlwrite("Can not display variable list");
  920.         return(FALSE);
  921.     }
  922.  
  923.     /* let us know this is in progress */
  924.     mlwrite("[Building variable list]");
  925.  
  926.     /* disconect the current buffer */
  927.         if (--curbp->b_nwnd == 0) {             /* Last use.            */
  928.                 curbp->b_dotp  = curwp->w_dotp;
  929.                 curbp->b_doto  = curwp->w_doto;
  930.                 curbp->b_markp = curwp->w_markp;
  931.                 curbp->b_marko = curwp->w_marko;
  932.         curbp->b_fcol  = curwp->w_fcol;
  933.         }
  934.  
  935.     /* connect the current window to this buffer */
  936.     curbp = bp;    /* make this buffer current in current window */
  937.     bp->b_mode = 0;        /* no modes active in binding list */
  938.     bp->b_nwnd++;        /* mark us as more in use */
  939.     wp = curwp;
  940.     wp->w_bufp = bp;
  941.     wp->w_linep = bp->b_linep;
  942.     wp->w_flag = WFHARD|WFFORCE;
  943.     wp->w_dotp = bp->b_dotp;
  944.     wp->w_doto = bp->b_doto;
  945.     wp->w_markp = NULL;
  946.     wp->w_marko = 0;
  947.  
  948.     /* build the environment variable list */
  949.     for (uindex = 0; uindex < NEVARS; uindex++) {
  950.  
  951.         /* add in the environment variable name */
  952.         strcpy(outseq, "$");
  953.         strcat(outseq, envars[uindex]);
  954.         pad(outseq, 14);
  955.         
  956.         /* add in the value */
  957.         bytecopy(&outseq[strlen(outseq)],
  958.                 gtenv(envars[uindex]), NSTRING);
  959.         strcat(outseq, "\n");
  960.  
  961.         /* and add it as a line into the buffer */
  962.         if (linstr(outseq) != TRUE)
  963.             return(FALSE);
  964.     }
  965.  
  966.     linstr("\n");
  967.  
  968.     /* build the user variable list */
  969.     for (uindex = 0; uindex < MAXVARS; uindex++) {
  970.         if (uv[uindex].u_name[0] == 0)
  971.             break;
  972.  
  973.         /* add in the user variable name */
  974.         strcpy(outseq, "%");
  975.         strcat(outseq, uv[uindex].u_name);
  976.         pad(outseq, 14);
  977.         
  978.         /* add in the value */
  979.         bytecopy(&outseq[strlen(outseq)],
  980.                 uv[uindex].u_value, NSTRING);
  981.         strcat(outseq, "\n");
  982.  
  983.         /* and add it as a line into the buffer */
  984.         if (linstr(outseq) != TRUE)
  985.             return(FALSE);
  986.     }
  987.  
  988.     curwp->w_bufp->b_mode |= MDVIEW;/* put this buffer view mode */
  989.     curbp->b_flag &= ~BFCHG;    /* don't flag this as a change */
  990.     wp->w_dotp = lforw(bp->b_linep);/* back to the beginning */
  991.     wp->w_doto = 0;
  992.     upmode();
  993.     mlwrite("");    /* clear the mode line */
  994.     return(TRUE);
  995. }
  996.  
  997. /*    describe-functions    Bring up a fake buffer and list the
  998.                 names of all the functions
  999. */
  1000.  
  1001. desfunc(f, n)
  1002.  
  1003. {
  1004.     register WINDOW *wp;    /* scanning pointer to windows */
  1005.     register BUFFER *bp;    /* buffer to put binding list into */
  1006.     register int uindex;    /* index into funcs table */
  1007.     char outseq[80];    /* output buffer for keystroke sequence */
  1008.  
  1009.     /* split the current window to make room for the variable list */
  1010.     if (splitwind(FALSE, 1) == FALSE)
  1011.         return(FALSE);
  1012.     curwp = spltwp; curbp = curwp->w_bufp;
  1013.  
  1014.     /* and get a buffer for it */
  1015.     bp = bfind("Function list", TRUE, 0);
  1016.     if (bp == NULL || bclear(bp) == FALSE) {
  1017.         mlwrite("Can not display function list");
  1018.         return(FALSE);
  1019.     }
  1020.  
  1021.     /* let us know this is in progress */
  1022.     mlwrite("[Building function list]");
  1023.  
  1024.     /* disconect the current buffer */
  1025.         if (--curbp->b_nwnd == 0) {             /* Last use.            */
  1026.                 curbp->b_dotp  = curwp->w_dotp;
  1027.                 curbp->b_doto  = curwp->w_doto;
  1028.                 curbp->b_markp = curwp->w_markp;
  1029.                 curbp->b_marko = curwp->w_marko;
  1030.         curbp->b_fcol  = curwp->w_fcol;
  1031.         }
  1032.  
  1033.     /* connect the current window to this buffer */
  1034.     curbp = bp;    /* make this buffer current in current window */
  1035.     bp->b_mode = 0;        /* no modes active in binding list */
  1036.     bp->b_nwnd++;        /* mark us as more in use */
  1037.     wp = curwp;
  1038.     wp->w_bufp = bp;
  1039.     wp->w_linep = bp->b_linep;
  1040.     wp->w_flag = WFHARD|WFFORCE;
  1041.     wp->w_dotp = bp->b_dotp;
  1042.     wp->w_doto = bp->b_doto;
  1043.     wp->w_markp = NULL;
  1044.     wp->w_marko = 0;
  1045.  
  1046.     /* build the function list */
  1047.     for (uindex = 0; uindex < NFUNCS; uindex++) {
  1048.  
  1049.         /* add in the environment variable name */
  1050.         strcpy(outseq, "&");
  1051.         strcat(outseq, funcs[uindex].f_name);
  1052.         strcat(outseq, "\n");
  1053.  
  1054.         /* and add it as a line into the buffer */
  1055.         if (linstr(outseq) != TRUE)
  1056.             return(FALSE);
  1057.     }
  1058.  
  1059.     linstr("\n");
  1060.  
  1061.     curwp->w_bufp->b_mode |= MDVIEW;/* put this buffer view mode */
  1062.     curbp->b_flag &= ~BFCHG;    /* don't flag this as a change */
  1063.     wp->w_dotp = lforw(bp->b_linep);/* back to the beginning */
  1064.     wp->w_doto = 0;
  1065.     upmode();
  1066.     mlwrite("");    /* clear the mode line */
  1067.     return(TRUE);
  1068. }
  1069.  
  1070. pad(s, len)    /* pad a string to indicated length */
  1071.  
  1072. char *s;    /* string to add spaces to */
  1073. int len;    /* wanted length of string */
  1074.  
  1075. {
  1076.     while (strlen(s) < len) {
  1077.         strcat(s, "          ");
  1078.         s[len] = '\0';
  1079.     }
  1080. }
  1081. #endif
  1082.  
  1083.