Return to lam9.c CVS log

Up to [CSRG BSD Unix] / 42BSD / ucb / lisp / franz

Annotation of 42BSD/ucb/lisp/franz/lam9.c, revision 1.1

1.1     ! root        1: #ifndef lint
        !             2: static char *rcsid =
        !             3:    "$Header: lam9.c 1.4 83/06/24 10:56:30 sklower Exp $";
        !             4: #endif
        !             5: 
        !             6: /*                                     -[Thu Mar  3 11:41:27 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: 
        !           160: lispval
        !           161: LIfranzcall()
        !           162: {
        !           163:     register lispval handy;
        !           164:     
        !           165:     if((np-lbot) <= 0) argerr("int:franz-call");
        !           166: 
        !           167:     switch (lbot[0].val->i) {
        !           168:     
        !           169:     case fc_getpwnam:
        !           170:        /* arg 1 = user name
        !           171:         * return vector of name, uid, gid, dir
        !           172:         * or nil if doesn't exist.
        !           173:         */
        !           174:         {
        !           175:             struct passwd *pw, *getpwnam();
        !           176:             lispval newvec(), inewint();
        !           177:             struct argent *oldnp;
        !           178: 
        !           179:             pw = getpwnam(verify(lbot[1].val,"int:franz-call: invalid name"));
        !           180:             if(pw)
        !           181:             {
        !           182:                 handy =  newvec(4 * sizeof(long));
        !           183:                 oldnp = np;
        !           184:                 protect(handy);
        !           185:                 handy->v.vector[0] = (lispval) inewstr(pw->pw_name);
        !           186:                 handy->v.vector[1] = inewint(pw->pw_uid);
        !           187:                 handy->v.vector[2] = inewint(pw->pw_gid);
        !           188:                 handy->v.vector[3] = (lispval) inewstr(pw->pw_dir);
        !           189:                 np = oldnp;
        !           190:                 return(handy);
        !           191:             }
        !           192:             return(nil);
        !           193:         }
        !           194:         case fc_access:
        !           195:                return(inewint
        !           196:                        (access
        !           197:                           (verify(lbot[1].val, "i:fc,access: non string"),
        !           198:                            lbot[2].val->i)));
        !           199:         case fc_chdir:
        !           200:                return(inewint
        !           201:                       (chdir(verify(lbot[1].val,"i:fc,chdir: non string"))));
        !           202: 
        !           203:         case fc_unlink:
        !           204:                return(inewint
        !           205:                       (unlink(verify(lbot[1].val,"i:fc,unlink: non string"))));
        !           206: 
        !           207:         case fc_time:
        !           208:                return(inewint(time(0)));
        !           209: 
        !           210:         case fc_chmod:
        !           211:                return(inewint(chmod(verify(lbot[1].val,
        !           212:                                                "i:fc,chmod: non string"),
        !           213:                                     lbot[2].val->i)));
        !           214: 
        !           215:         case fc_getpid:
        !           216:                return(inewint(getpid()));
        !           217: 
        !           218:         case fc_stat:
        !           219:                {
        !           220:                    struct argent *oldnp;
        !           221:                    struct stat statbuf;
        !           222: 
        !           223:                    if(stat(verify(lbot[1].val,"ifc:stat bad file name "),
        !           224:                            &statbuf)
        !           225:                        != 0) return(nil);      /* nil on error */
        !           226:                    handy = newvec(12 * sizeof(long));
        !           227:                    oldnp = np;
        !           228:                    protect(handy);
        !           229:                    handy->v.vector[0] = inewint(statbuf.st_mode & 07777);
        !           230:                    handy->v.vector[1] = inewint(
        !           231:                                           (statbuf.st_mode & S_IFMT) >> 12 );
        !           232:                    handy->v.vector[2] = inewint(statbuf.st_nlink);
        !           233:                    handy->v.vector[3] = inewint(statbuf.st_uid);
        !           234:                    handy->v.vector[4] = inewint(statbuf.st_gid);
        !           235:                    handy->v.vector[5] = inewint(statbuf.st_size);
        !           236:                    handy->v.vector[6] = inewint(statbuf.st_atime);
        !           237:                    handy->v.vector[7] = inewint(statbuf.st_mtime);
        !           238:                    handy->v.vector[8] = inewint(statbuf.st_ctime);
        !           239:                    handy->v.vector[9] = inewint(statbuf.st_dev);
        !           240:                    handy->v.vector[10] = inewint(statbuf.st_rdev);
        !           241:                    handy->v.vector[11] = inewint(statbuf.st_ino);
        !           242:                    np = oldnp;
        !           243:                    return(handy);
        !           244:                }
        !           245:         case fc_gethostname:
        !           246:            {
        !           247: #if os_4_1a || os_4_1c || os_4_2
        !           248:                char hostname[32];
        !           249:                gethostname(hostname,sizeof(hostname));
        !           250:                return((lispval) inewstr(hostname));
        !           251: #else
        !           252:                return((lispval) inewstr(SITE));
        !           253: #endif         
        !           254:            }
        !           255:         case fc_link:
        !           256:            return(inewint
        !           257:                    (link(verify(lbot[1].val,"i:fc,link: non string"),
        !           258:                          verify(lbot[2].val,"i:fc,link: non string"))));
        !           259:                         
        !           260:         default:
        !           261:                return(inewint(-1));
        !           262:        } /* end of switch */
        !           263: }
        !           264: 
        !           265:                 
        !           266: 
        !           267:                 

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.