4.3BSD - /usr/src/ucb/lisp/franz/lam9.c

   1: #ifndef lint
   2: static char *rcsid =
   3:    "$Header: lam9.c,v 1.7 85/03/13 17:19:15 sklower Exp $";
   4: #endif
   5: 
   6: /*					-[Sat Oct  1 19:44:47 1983 by jkf]-
   7:  * 	lam9.c				$Locker:  $
   8:  * lambda functions
   9:  *
  10:  * (c) copyright 1982, Regents of the University of California
  11:  */
  12: 
  13: #include "global.h"
  14: /*
  15:  * These routines writen in C will allow use of the termcap file
  16:  * by any lisp program. They are very basic routines which initialize
  17:  * termcap and allow the lisp to execute any of the termcap functions.
  18:  */
  19: 
  20: #include <stdio.h>      /*add definations for I/O and bandrate */
  21: #include <sgtty.h>
  22: #include <sys/types.h>
  23: #include <sys/stat.h>
  24: #include <pwd.h>
  25: 
  26: 
  27: #undef putchar
  28: int putchar();      /* functions used from the termlib */
  29: int tgetflag();
  30: char    *getenv();
  31: char    *tgoto();
  32: char    *tgetstr();
  33: 
  34: char    bpbuf[1024];
  35: char    tstrbuf[100];
  36: extern short    ospeed;
  37: extern char PC;
  38: extern char   *BC;
  39: extern char   *UP;
  40: 
  41: /*
  42: /*	This routine will initialize the termcap for the lisp programs.
  43: /*	If the termcap file is not found, or terminal type is undefined,
  44: /*	it will print out an error mesg.				*/
  45: 
  46: lispval
  47: Ltci()
  48: {
  49: char *cp = getenv("TERM");
  50: char *pc;
  51: int found;
  52: struct sgttyb tty;
  53: 
  54: found = tgetent(bpbuf,cp);      /* open ther termcap file */
  55: switch(found) {
  56:       case -1:  printf("\nError Termcap File not found \n");break;
  57:       case 0 :  printf("\nError No Termcap Entry for this terminal \n");
  58:         break;
  59:       case 1 : {            /* everything was ok	*/
  60:         gtty(1, &tty);
  61:         ospeed = tty.sg_ospeed;
  62:             }
  63:         break;
  64:     }
  65: cp = tstrbuf;
  66: BC = tgetstr("bc", &cp);
  67: UP = tgetstr("up", &cp);
  68: pc = tgetstr("pc", &cp);
  69: if (pc)
  70:     PC = *pc;
  71: return(nil);
  72: }
  73: /* This routine will execute any of the termcap functions used by the lisp
  74: /* program. If the feature is not include in the terminal defined it will
  75: /* ignore the call.
  76: /*		option	: feature to execute
  77: /*		line	: line if is nessery
  78: /*		colum	: colum if is nessaery
  79: /*									*/
  80: lispval
  81: Ltcx()
  82: {
  83:     register struct argent *mylbot = lbot;
  84:     int line, column;
  85: 
  86:     switch(np-lbot) {
  87:     case 1:
  88:         line = column = 0;
  89:         break;
  90:     case 2:
  91:         error("Wrong number of Arguments to Termcapexecute",FALSE);
  92:         break;
  93:     case 3:
  94:         line = mylbot[1].val->i;
  95:         column = mylbot[2].val->i;
  96:     }
  97:     return(inewint(show((char *) mylbot->val,&line,&column)));
  98: }
  99: 
 100: 
 101: static
 102: show(option,line,colum)
 103: char *option;
 104: int  *line,*colum;
 105: {
 106: int found;
 107: char clbuf[20];
 108: char *clbp = clbuf;
 109: char *clear;
 110: 
 111: /* the tegetflag doesnot work ? */
 112: clear = tgetstr(option,&clbp);
 113: /*printf("option = %d , %s \n",clear,option);*/
 114: if (!clear)
 115:     {found = tgetnum(option);
 116:      if (found)
 117:         return(found);
 118:       return(-1);
 119:        }
 120: PC = ' ';
 121: if (strcmp(option, "cm") == 0) {        /* if cursor motion, do it */
 122:     clear=tgoto(clear,*colum,*line);
 123:         if (*clear == 'O')
 124:         clear = 0;
 125:     }
 126: if (clear)                  /* execute the feature */
 127:      tputs(clear,0,putchar);
 128: return (0);
 129: }
 130: 
 131: 
 132: 
 133: /*
 134:  * LIfranzcall :: lisp function int:franz-call
 135:  *   this function serves many purposes.  It provides access to
 136:  *   those things that are best done in C or which required a
 137:  *   C access to unix system calls.
 138:  *
 139:  *   Calls to this routine are not error checked, for the most part
 140:  *   because this is only called from trusted lisp code.
 141:  *
 142:  *   The functions in this file may or may not be documented in the manual.
 143:  *   See the lisp interface to this function for more details. (common2.l)
 144:  *
 145:  *  the first argument is always a fixnum index, the other arguments
 146:  *   depend on the function.
 147:  */
 148: 
 149: #define fc_getpwnam 1
 150: #define fc_access   2
 151: #define fc_chdir    3
 152: #define fc_unlink   4
 153: #define fc_time     5
 154: #define fc_chmod    6
 155: #define fc_getpid   7
 156: #define fc_stat     8
 157: #define fc_gethostname 9
 158: #define fc_link     10
 159: #define fc_sleep    11
 160: #define fc_nice     12
 161: 
 162: lispval
 163: LIfranzcall()
 164: {
 165:     register lispval handy;
 166: 
 167:     if((np-lbot) <= 0) argerr("int:franz-call");
 168: 
 169:     switch (lbot[0].val->i) {
 170: 
 171:     case fc_getpwnam:
 172:         /* arg 1 = user name
 173: 	 * return vector of name, uid, gid, dir
 174: 	 * or nil if doesn't exist.
 175: 	 */
 176:      {
 177:          struct passwd *pw, *getpwnam();
 178:          lispval newvec(), inewint();
 179:          struct argent *oldnp;
 180: 
 181:          pw = getpwnam(verify(lbot[1].val,"int:franz-call: invalid name"));
 182:          if(pw)
 183:          {
 184:          handy =  newvec(4 * sizeof(long));
 185:          oldnp = np;
 186:          protect(handy);
 187:          handy->v.vector[0] = (lispval) inewstr(pw->pw_name);
 188:          handy->v.vector[1] = inewint(pw->pw_uid);
 189:          handy->v.vector[2] = inewint(pw->pw_gid);
 190:          handy->v.vector[3] = (lispval) inewstr(pw->pw_dir);
 191:          np = oldnp;
 192:          return(handy);
 193:          }
 194:          return(nil);
 195:      }
 196:      case fc_access:
 197:         return(inewint
 198:                 (access
 199:                (verify(lbot[1].val, "i:fc,access: non string"),
 200:                 lbot[2].val->i)));
 201:      case fc_chdir:
 202:         return(inewint
 203:                (chdir(verify(lbot[1].val,"i:fc,chdir: non string"))));
 204: 
 205:      case fc_unlink:
 206:         return(inewint
 207:                (unlink(verify(lbot[1].val,"i:fc,unlink: non string"))));
 208: 
 209:      case fc_time:
 210:         return(inewint(time(0)));
 211: 
 212:      case fc_chmod:
 213:         return(inewint(chmod(verify(lbot[1].val,
 214:                         "i:fc,chmod: non string"),
 215:                      lbot[2].val->i)));
 216: 
 217:      case fc_getpid:
 218:         return(inewint(getpid()));
 219: 
 220:      case fc_stat:
 221:             {
 222:             struct argent *oldnp;
 223:             struct stat statbuf;
 224: 
 225:             if(stat(verify(lbot[1].val,"ifc:stat bad file name "),
 226:                     &statbuf)
 227:             != 0) return(nil);  /* nil on error */
 228:             handy = newvec(12 * sizeof(long));
 229:             oldnp = np;
 230:             protect(handy);
 231:             handy->v.vector[0] = inewint(statbuf.st_mode & 07777);
 232:             handy->v.vector[1] = inewint(
 233:                            (statbuf.st_mode & S_IFMT) >> 12 );
 234:             handy->v.vector[2] = inewint(statbuf.st_nlink);
 235:             handy->v.vector[3] = inewint(statbuf.st_uid);
 236:             handy->v.vector[4] = inewint(statbuf.st_gid);
 237:             handy->v.vector[5] = inewint(statbuf.st_size);
 238:             handy->v.vector[6] = inewint(statbuf.st_atime);
 239:             handy->v.vector[7] = inewint(statbuf.st_mtime);
 240:             handy->v.vector[8] = inewint(statbuf.st_ctime);
 241:             handy->v.vector[9] = inewint(statbuf.st_dev);
 242:             handy->v.vector[10] = inewint(statbuf.st_rdev);
 243:             handy->v.vector[11] = inewint(statbuf.st_ino);
 244:             np = oldnp;
 245:             return(handy);
 246:         }
 247:      case fc_gethostname:
 248:         {
 249: #if os_4_1a || os_4_1c || os_4_2 || os_4_3
 250:         char hostname[32];
 251:         gethostname(hostname,sizeof(hostname));
 252:         return((lispval) inewstr(hostname));
 253: #else
 254:         return((lispval) inewstr(SITE));
 255: #endif
 256:         }
 257:      case fc_link:
 258:         return(inewint
 259:                 (link(verify(lbot[1].val,"i:fc,link: non string"),
 260:                   verify(lbot[2].val,"i:fc,link: non string"))));
 261: 
 262:      /* sleep for the given number of seconds */
 263:      case fc_sleep:
 264:         return(inewint(sleep(lbot[1].val->i)));
 265: 
 266:      case fc_nice:
 267:         return(inewint(nice(lbot[1].val->i)));
 268: 
 269:      default:
 270:         return(inewint(-1));
 271:     } /* end of switch */
 272: }

Defined functions

Defined variables

Defined macros