![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to lam9.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDTahoe / ucb / lisp / franz|
Return to lam9.c CVS log | Up to [CSRG BSD Unix] / 43BSDTahoe / ucb / lisp / franz |
1.1 root 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:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.