projects / unix-history / blame
| Commit | Line | Data |
|---|---|---|
| 2103c4c6 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 | } | |
| 273 | ||
| 274 | ||
| 275 | ||
| 276 |