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