![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to b2sou.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bsmall|
Return to b2sou.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bsmall |
1.1 root 1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
2: /* $Header: b2sou.c,v 1.1 84/06/28 00:49:20 timo Exp $ */
3:
4: /* Sources: maintaining units and values on external files */
5: #include "b.h"
6: #include "b0con.h"
7: #include "b1mem.h" /* shouldn't really */
8: #include "b1obj.h"
9: #include "b2env.h"
10: #include "b2scr.h"
11: #include "b2err.h"
12: #include "b2key.h"
13: #include "b2syn.h"
14: #include "b2sem.h"
15: #include "b2fil.h"
16: #include "b2sou.h"
17:
18: /************************** UNITS ************************************/
19:
20: value defunits, aster, global;
21:
22: Hidden value* unit_defn(fn) value fn; {
23: return envassoc(defunits, fn);
24: }
25:
26: Visible Procedure def_unit(u, un, ut) value u, un; literal ut; {
27: value fn= f_uname(un, ut);
28: e_replace(u, &defunits, fn);
29: release(fn);
30: }
31:
32: Visible value unit_info(un, ut) value un; literal ut; {
33: value fn= f_uname(un, ut);
34: value *aa= unit_defn(fn);
35: if (aa == Pnil) syserr("undefined function");
36: release(fn);
37: return *aa;
38: }
39:
40: Hidden bool is_loaded(un, ut, aa) value un, **aa; literal ut; {
41: value fn= f_uname(un, ut); txptr tx0, txstart0;
42: *aa= unit_defn(fn);
43: if (*aa != Pnil) { release(fn); return Yes; } /*already loaded*/
44: release(iname);
45: iname= fn;
46: ifile= fopen(strval(iname), "r");
47: if (ifile == NULL) {
48: vs_ifile();
49: return No;
50: }
51: tx0= tx; txstart0= txstart;
52: open_stream();
53: Eof= Eof0= No;
54: ilev(Yes); findceol();
55: get_unit(Yes);
56: *aa= unit_defn(iname);
57: if ((*aa) == Pnil) {
58: uname= un; /*utype= ???*/
59: parerr("filename and unit name incompatible","");
60: }
61: close_stream(tx0, txstart0);
62: fclose(ifile);
63: vs_ifile();
64: Eof= Eof0= No;
65: return Yes;
66: }
67:
68: Visible bool is_unit(un, ut, aa) value un, **aa; literal ut; {
69: context c; bool is;
70: sv_context(&c);
71: cntxt= In_unit;
72: is= is_loaded(un, ut, aa);
73: set_context(&c);
74: return is;
75: }
76:
77: #define DISCARD "the unit name is already in use; should the old unit be discarded?"
78: #define CANT_WRITE "cannot open file for editing; you need write permission in directory"
79: #define CANT_READ "unable to find file"
80:
81: Visible bool unit() {
82: txptr tx0= tx; value name, fname; literal type; FILE *ofile;
83: if (atkw(HOW_TO) || atkw(YIELD) || atkw(TEST)) {
84: tx= tx0;
85: uheading(aster, &name, &type);
86: fname= f_uname(name, type);
87: if (unit_defn(fname) != Pnil) {
88: if (is_intended(DISCARD)) free_unit(fname);
89: else { tx= ceol; release(fname); release(name);
90: return Yes;
91: }
92: }
93: if (interactive) {
94: ofile= fopen(strval(fname), "w");
95: if (ofile == NULL) error(CANT_WRITE);
96: while (Char(tx) != Eotc) putc(Char(tx++), ofile);
97: tx--;
98: fclose(ofile);
99: ed_unit(name, type, fname);
100: } else get_unit(No);
101: release(name); release(fname);
102: return Yes;
103: } else return No;
104: }
105:
106: #define On_file Vnil
107:
108: value last_tname= Vnil, last_tfname= Vnil; /*target*/
109:
110: Visible Procedure special() {
111: switch(Char(tx++)) {
112: case ':': ediuni(); break;
113: case '=': editar(); break;
114: case '!': shellcmd(); break;
115: default: syserr("edit");
116: }
117: }
118:
119:
120: #define FnSwitch(X) {release(fname); type= X; fname= f_uname(name, X);}
121:
122: #define MONADIC \
123: "the unit name is in use both for a monadic and a dyadic version;\n\
124: *** do you want to edit the monadic version?"
125:
126: Hidden Procedure ediuni() {
127: value name, fname; literal type;
128: Skipsp(tx);
129: if (Char(tx) == ':') {
130: lst_uhds();
131: To_eol(tx);
132: return;
133: }
134: if (Ceol(tx)) {
135: if (erruname == Vnil)
136: parerr("no current unit name known", "");
137: name= copy(erruname);
138: type= errutype;
139: fname= f_uname(name, type);
140: } else if (Cap(Char(tx))) {
141: name= keyword(ceol);
142: type= FHW;
143: fname= f_uname(name, FHW);
144: } else if (Letter(Char(tx))) {
145: name= tag(); type= FZR;
146: fname= f_uname(name, FZR);
147: if (!f_exists(fname)) {
148: bool is_mon, is_dya;
149: FnSwitch(FMN);
150: is_mon= f_exists(fname);
151: FnSwitch(FDY);
152: is_dya= f_exists(fname);
153: if (is_mon && (!is_dya || is_intended(MONADIC)))
154: FnSwitch(FMN);
155: }
156: } else parerr("I find nothing editible here", "");
157: To_eol(tx);
158: if (!f_exists(fname)) pprerr("no such unit in this workspace","");
159: ens_filed(fname);
160: ed_unit(name, type, fname); release(name); release(fname);
161: }
162:
163: Forward bool still_there();
164: Forward intlet err_line();
165:
166: /* Edit a unit.
167: It is possible that the user messes things up with the w command:
168: this is not checked. However it is allowed to rename the unit,
169: or delete it completely. If the file is empty, the unit is disposed of.
170: Otherwise, uheading is used to work out the name and adicity:
171: if these have changed, the new unit is written out to a new file,
172: and the original is written back. Thus the original is not lost.
173: Inability to find the file at all leads to the main_loop,
174: so that nothing is changed. */
175:
176: Hidden Procedure ed_unit(name, type, fname) value name, fname; literal type; {
177: intlet el= err_line(name); value nname, nfname, sname; literal ntype;
178: sname= f_save(fname); /*in case the unit gets renamed*/
179: f_edit(fname, el);
180: if (still_there(fname)) {
181: ilev(Yes); findceol();
182: uheading(name, &nname, &ntype);
183: nfname= f_uname(nname, ntype);
184: if (compare(fname, nfname) != 0) { /* unit heading was changed */
185: f_rename(fname, nfname); f_rename(sname, fname);
186: release(erruname); erruname= copy(nname);
187: errutype= ntype;
188: } else {
189: release(erruname); erruname= copy(name);
190: errutype= type;
191: f_delete(sname);
192: }
193: release(nname); release(nfname);
194: get_unit(Yes); /* file is still open */
195: } else {
196: free_unit(fname);
197: f_delete(sname);
198: release(erruname); erruname= Vnil; errlino= 0;
199: }
200: release(sname);
201: inistreams();
202: }
203:
204: Hidden Procedure uheading(oname, nname, ntype) value oname, *nname; literal *ntype; {
205: context ic; bool hu= No;
206: sv_context(&ic);
207: cntxt= In_unit; uname= oname;
208: lino= 1;
209: if ((hu= atkw(HOW_TO)) || atkw(YIELD) || atkw(TEST)) {
210: if (cur_ilev != 0) parerr("unit starts with indentation", "");
211: if (hu) {
212: uname= keyword(ceol); utype= FHW;
213: } else {
214: literal adic;
215: ytu_heading(&uname, &adic, ceol, No);
216: utype= (adic == Zer ? FZR : adic == Mon ? FMN : FDY);
217: }
218: *nname= uname; /*should really be n=copy(u); release(u);*/
219: *ntype= utype;
220: set_context(&ic);
221: } else parerr("no HOW'TO, YIELD or TEST where expected", "");
222: }
223:
224: Hidden bool still_there(fname) value fname; {
225: /* Find out if the file exists, and is not empty.
226: Some editors don't allow a file to be edited to empty,
227: but insist it should be at least one empty line.
228: Because it is hard to unget 2 chars, an initial empty line
229: may be disregarded, but this is not harmful. */
230: int k;
231: ifile= fopen(strval(fname), "r");
232: if (ifile == NULL) {
233: vs_ifile();
234: error(CANT_READ);
235: }
236: if ((k= getc(ifile)) == EOF || (k == '\n' && (k= getc(ifile)) == EOF)) {
237: fclose(ifile);
238: f_delete(fname);
239: vs_ifile();
240: return No;
241: }
242: ungetc(k, ifile);
243: return Yes;
244: }
245:
246: Hidden Procedure ens_filed(fname) value fname; {
247: value *aa= unit_defn(fname); how *du;
248: if (aa != Pnil) {
249: du= How_to(*aa);
250: if (du->filed == No) {
251: txptr ux= du->fux, lux= du->lux;
252: FILE *ofile= fopen(strval(fname), "w");
253: if (ofile == NULL) error(CANT_WRITE);
254: while (ux < lux) {
255: char c= *ux++;
256: putc(c == Eouc ? '\n' : c, ofile);
257: }
258: fclose(ofile);
259: du->filed= Yes;
260: }
261: }
262: }
263:
264: Hidden intlet err_line(name) value name; {
265: intlet el;
266: if (errlino == 0 || compare(erruname, name) != 0) return 0;
267: el= errlino; errlino= 0;
268: return el;
269: }
270:
271: Hidden Procedure free_unit(fname) value fname; {
272: e_delete(&defunits, fname);
273: }
274:
275: Hidden Procedure shellcmd() {
276: system(tx);
277: To_eol(tx);
278: }
279:
280: /************************** VALUES ***************************************/
281: /* The permanent environment in the old format was kept as a single file */
282: /* but this caused slow start ups if the file was big. */
283: /* Thus the new version stores each permanent target on a separate file, */
284: /* that furthermore is only loaded on demand. */
285: /* To achieve this, a directory is kept of the permanent tags and their */
286: /* file names. Care has to be taken that user interrupts occurring in */
287: /* the middle of an update of this directory do the least harm. */
288: /* Having the directory refer to a non-existent file is considered less */
289: /* harmful than leaving a file around that can never be accessed, for */
290: /* instance, so a file is deleted before its directory entry, */
291: /* and so forth. */
292: /*************************************************************************/
293:
294: value b_perm; /*The table that maps tags to their file names*/
295:
296: Visible bool is_tloaded(name, aa) value name, **aa; {
297: return No; /*for now*/
298: }
299:
300: Hidden bool new_tname(name, fname) value name, *fname; {
301: value *aa;
302: if (in_env(b_perm, name, &aa)) {
303: *fname= copy(*aa);
304: return No;
305: } else {
306: *fname= f_tname(name);
307: e_replace(*fname, &b_perm, name);
308: return Yes;
309: }
310: }
311:
312: Hidden Procedure editar() {
313: value name, fname;
314: Skipsp(tx);
315: if (Char(tx) == '=') {
316: lst_ttgs();
317: To_eol(tx);
318: return;
319: }
320: if (Ceol(tx)) {
321: if (last_tfname == Vnil)
322: parerr("no current target name known", "");
323: fname= copy(last_tfname);
324: name= copy(last_tname);
325: } else if (Letter(Char(tx))) {
326: name= tag();
327: VOID new_tname(name, &fname);
328: } else parerr("I find nothing editible here", "");
329: if (!f_exists(fname)) pprerr("no such target in this workspace","");
330: ens_tfiled(name, fname);
331: ed_target(name, fname); release(fname); release(name);
332: }
333:
334: Hidden Procedure lst_ttgs() {
335: int k, len;
336: len= length(prmnv->tab);
337: k_Over_len {
338: writ(*key(prmnv->tab, k));
339: wri_space();
340: }
341: newline();
342: }
343:
344: Hidden Procedure ed_target(name, fname) value name, fname; {
345: /* Edit a target. The value in the target is written to the file,
346: and then removed from the internal permanent environment so that
347: if a syntax error occurs when reading the value back, the value is
348: absent from the internal permanent environment.
349: Thus when editing the file to correct the syntax error, the
350: file doesn't get overwritten.
351: The contents may be completely deleted in which case the target is
352: deleted.
353: */
354: value v, p; context c; bool wia;
355: f_edit(fname, 0);
356: if (still_there(fname)) {
357: release(last_tfname); last_tfname= copy(fname);
358: release(last_tname); last_tname= copy(name);
359: fclose(ifile); /*since still_there leaves it open*/
360: sv_context(&c); wia= interactive;
361: cntxt= In_value;
362: getval(fname, &v);
363: /* p= mk_per(v);
364: */p=v; e_replace(p, &prmnv->tab, name);
365: set_context(&c); interactive= wia;
366: vs_ifile();
367: release(p);
368: /* release(v);
369: */ } else {
370: e_delete(&prmnv->tab, name);
371: e_delete(&b_perm, name);
372: release(last_tfname); release(last_tname);
373: last_tfname= Vnil; last_tname= Vnil;
374: }
375: f_delete(fname);
376: }
377:
378: Hidden Procedure ens_tfiled(name, fname) value name, fname; {
379: value p, *aa;
380: if (in_env(prmnv->tab, name, &aa) && !Is_filed(*aa)) {
381: putval(fname, *aa, No);
382: p= mk_per(Vnil);
383: e_replace(p, &prmnv->tab, name);
384: release(p);
385: }
386: }
387:
388: Hidden Procedure getval(nm, v) value nm, *v; {
389: char *buf= Nil; int k;
390: release(iname);
391: iname= copy(nm);
392: ifile= fopen(strval(iname), "r");
393: if (ifile != NULL) {
394: interactive= No;
395: alino= 0; xeq= Yes; active_reads= 0; /*CHANGE*/
396: buf= getmem((unsigned)(f_size(ifile)+2)*sizeof(char));
397: if (buf == Nil) syserr("can't get buffer to read file");
398: *(txend= buf)= Eotc; tx= ceol= txend+1;
399: while ((k= getc(ifile)) != EOF)
400: if (k != '\n') *ceol++= k;
401: *ceol= '\n'; alino= 1; *v= expr(ceol);
402: fclose(ifile);
403: if (buf != Nil) freemem(buf);
404: } else error(CANT_READ);
405: }
406:
407: Visible Procedure getprmnv() {
408: value fn= mk_text(".prmnv");
409: cntxt= In_prmnv;
410: if (f_exists(fn)) { /* convert from old to new format */
411: getval(fn, &prmnv->tab);
412: b_perm= mk_elt();
413: /* putprmnv();
414: f_delete(fn); /*after writing the new one, for safety*/
415: /* */ release(fn);
416: } else {
417: prmnv->tab= mk_elt();
418: b_perm= mk_elt();
419: /* release(fn);
420: fn= mk_text(".b_perm");
421: if (f_exists(fn)) {
422: getval(fn, &b_perm);
423: create_prmnv();
424: } else {
425: b_perm= mk_elt();
426: prmnv->tab= mk_elt();
427: }
428: */ release(fn);
429: }
430: }
431:
432: Hidden Procedure putval(nm, v, silently) value nm, v; bool silently; {
433: FILE *ofile;
434: ofile= fopen(strval(nm), "w");
435: if (ofile != NULL) {
436: redirect(ofile);
437: wri(v, No, No, Yes); newline();
438: fclose(ofile);
439: redirect(stdout);
440: } else if (!silently) error(CANT_WRITE);
441: }
442:
443: Visible Procedure putprmnv() {
444: bool changed= No; value fn;
445: value pt1, pt2; env c;
446: int k, len= length(prmnv->tab);
447:
448: ignsigs(); /*because files are created before the directory is written*/
449: pt1= prmnv->tab; pt2= prmnvtab; c= curnv;
450: setprmnv();
451: k_Over_len {
452: value v= copy(*assoc(prmnv->tab, k));
453: if (!Is_filed(v)) {
454: /* value t= copy(*key(prmnv->tab, k));
455: wri_target(t, v, &changed);
456: release(t);
457: */}else{e_delete(&prmnv->tab, *key(prmnv->tab, k));
458: }
459: release(v);
460: }
461: fn= mk_text(".prmnv");
462: putval(fn, prmnv->tab, Yes);
463: release(fn);
464: if (changed) {
465: fn= mk_text(".b_perm");
466: putval(fn, b_perm, Yes);
467: release(fn);
468: }
469: prmnv->tab= pt1; prmnvtab= pt2; curnv= c; /* kludgy */
470: re_sigs();
471: }
472:
473: Hidden Procedure wri_target(t, v, changed) value t, v; bool* changed; {
474: value fn, p;
475: bool new= new_tname(t, &fn);
476: if (new) *changed= Yes;
477: putval(fn, v, Yes);
478: p= mk_per(v);
479: e_replace(p, &prmnv->tab, t); /*after writing file*/
480: release(p); release(fn);
481: }
482:
483: Hidden Procedure create_prmnv() {
484: value p= mk_per(Vnil);
485: int k, len= length(b_perm);
486:
487: k_Over_len {
488: e_replace(copy(p), &prmnv->tab, *key(b_perm, k));
489: }
490: release(p);
491: }
492:
493: Visible Procedure initsou() {
494: defunits= mk_elt();
495: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.