![[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] / 42BSD / ucb / lisp / franz|
Return to lam9.c CVS log | Up to [CSRG BSD Unix] / 42BSD / ucb / lisp / franz |
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.