|
|
1.1 root 1: #include <stdio.h>
2: #ifdef PC
3: #include "../pcompile/adapt.h"
4: #define setbin(file) _isbin[file->_file] = 1;
5: #undef getchar
6: #undef putchar
7: #define getchar() fgetc(stdin)
8: #define putchar(x) fputc((x), stdout)
9: #endif
10: extern char *getenv();
11:
12: #define CTRLX 030
13: #define CMENT 034
14: #define META(x) (x+0200)
15: #define CTRL(x) (x^0100)
16:
17: #define BAD 0
18: #define SIMPLE 1
19: #define SDCL 2
20: #define CASE 3
21: #define COND 4
22: #define BEGIN 5
23: #define WHILE 6
24: #define PSTRING 7
25: #define NUMBER 8
26: #define BINARY 9
27: #define UNARY 10
28: #define QUOTE 11
29: #define INSERT 12
30: #define XSTRING 13
31: #define DCL 14
32: #define LOCAL 15
33: #define CHAR 16
34: #define MAP 17
35: #define GLOBAL 18
36: #define SGLOBAL 19
37: #define SVAL 256 /* Returns string value */
38: #define DOUBLE 512 /* Command is really 2 base commands */
39:
40: #ifndef PC
41: char *defdir = SDIR;
42: #define DEFILE "emacs_defs"
43: #endif
44:
45: int line = 1;
46: int DEBUG = 0;
47: char *typetable[] = {
48: "BAD","SIMPLE","SDCL","CASE","COND","BEGIN","WHILE",
49: "SSTRING","NUMBER","BINARY","UNARY","QUOTE","INSERT",
50: "STRING","DCL","LOCAL","CHAR","MAP","GLOBAL","SGLOBAL",NULL,
51: };
52:
53: #define NHOOKS 10
54: char *hooks[NHOOKS] = {
55: "No_Hook",
56: "Pre_Read_Hook",
57: "Post_Read_Hook",
58: "Pre_Write_Hook",
59: "Load_Macro_Hook",
60: "Read_Line_Hook",
61: "Mode_Line_Hook",
62: "Exit_Emacs_Hook",
63: "Leave_Buffer_Hook",
64: "Enter_Buffer_Hook",
65: };
66:
67: extern char *malloc();
68: struct defblk {
69: struct defblk *next;
70: char *name;
71: int type;
72: char *body;
73: };
74:
75: /* Definitions for expression contexts */
76:
77: #define CARG 1 /* function argument */
78: #define CSINGLE 2 /* Must produce single command */
79: #define CSTRING 4 /* Argument to string type function */
80:
81: #define CCONT 8 /* Must generate pass-last-result after command */
82: #define CCLOSE 16 /* Must generate a closing brace */
83:
84: #define NLOCAL 10
85: char *locals[NLOCAL];
86: int nlocal=NLOCAL;
87:
88: #define NHASH 256
89: struct defblk *hashtable[NHASH];
90:
91: char symbuf[128];
92:
93: char *
94: mstrcpy(cp,cp1)
95:
96: /* Keywords: assignment string-handling */
97: register char *cp;
98: register char *cp1;
99: {
100: while (*cp++ = *cp1++);
101: return(cp-1);
102: }
103:
104: wrdchr(c)
105: int c;
106: {
107: if ((c>='a') && (c <= 'z')) return(1);
108: if ((c>='A') && (c <= 'Z')) return(1);
109: if ((c>='0') && (c <= '9')) return(1);
110: return(0);
111: }
112:
113: char *
114: expenv(str)
115: register char *str;
116: /* Keywords: environment-variables unix-interface user-interface:20 shell-escape:10 */
117: {
118: char strtemp[128];
119: char vartemp [64];
120: register char *cp1;
121: char *cp2;
122: register int c;
123: int oc;
124:
125: if (str == NULL) return(NULL);
126:
127: cp1 = strtemp;
128: cp2 = str;
129: while (*cp1++ = *str) {
130: if ((*str== '`')||(*str=='*')||(*str=='{')||(*str=='[')||((*str++)=='?')) {
131: return("Error");
132: }
133: }
134: cp1 = strtemp;
135: str = symbuf; /* always copy back into file name */
136: while (c = *cp1++) {
137: if ((c == '$')|| (c == '~')) {
138:
139: /* Environment variable */
140:
141: oc = c;
142: cp2 = vartemp;
143: while (wrdchr(c=((*cp1++)&0377))) {
144: *cp2++ = c;
145: }
146: cp1--; /* backspace pointer */
147: *cp2 = 0;
148: if (oc == '$') {
149: cp2 = getenv(vartemp); /* environment variable */
150: } else {
151: /* Home Directory */
152:
153: if (*vartemp == 0) {
154: cp2 = getenv("HOME"); /* Bare ~ means home */
155: } else if ((strcmp(vartemp,"exptools")==0) &&
156: (cp2 = getenv("TOOLS")) && *cp2) {
157: ;
158: } else {
159: return("Error"); /* Can't do it */
160:
161: }
162: }
163: if (cp2 != NULL) {
164: str = mstrcpy(str,cp2);
165: } else {
166: *str++ = oc;
167: str = mstrcpy(str,vartemp);
168: }
169: } else {
170: *str++ = c;
171: }
172: }
173: *str++ = 0;
174: return(symbuf);
175: }
176: char macb[128];
177: char *
178: macbody(name)
179: char *name;
180: {
181: char *bp;
182: bp = macb;
183: *bp++ = META('x');
184: while (*name) *bp++ = *name++;
185: *bp++ = '\n';
186: *bp++ = 0;
187: return(macb);
188: }
189: struct defblk *
190: getname(name)
191:
192: char *name;
193: {
194: int hash;
195: char *np;
196: struct defblk *defp;
197:
198: np = name;
199: hash = 0;
200: while (*np) hash += *np++;
201: hash = hash %NHASH;
202: defp = hashtable[hash];
203: while (defp && strcmp(name,defp->name)) defp = defp->next;
204: if (defp == NULL) {
205: defp = ((struct defblk *) malloc(sizeof(*defp)));
206: defp->next = hashtable[hash];
207: hashtable[hash] = defp;
208: defp->name = malloc(strlen(name)+1);
209: strcpy(defp->name,name);
210: if ((*name == '-') || ((*name>='0') && (*name <= '9'))) {
211: defp->type = NUMBER;
212: defp->body = malloc(strlen(name)+1);
213: defp->body[0] = defp->name[0]+0200;
214: strcpy(defp->body+1,defp->name+1);
215: } else if ((*name == '\'') && (name[2] == '\'') && (name[3] == 0)) {
216: defp->type = SIMPLE;
217: defp->body = malloc(3);
218: defp->body[0] = META(CTRL('Q'));
219: defp->body[1] = name[1];
220: defp->body[2] = 0;
221: } else {
222: fprintf(stderr,"Undefined command name %s at line %d, assumed external\n",name,line);
223: defp->type = SIMPLE;
224: name = macbody(name);
225: defp->body = malloc(strlen(name));
226: strcpy(defp->body,name);
227: }
228: }
229: return(defp);
230: }
231:
232: lookhook(name)
233: char *name;
234: {
235: register int i;
236: for (i = 1; i < NHOOKS; i++) if(strcmp(name,hooks[i]) == 0) return(i);
237: return(0);
238: }
239: undefine(name)
240:
241: char *name;
242: {
243: int hash;
244: char *np;
245: struct defblk *defp;
246: struct defblk *odefp;
247: np = name;
248: hash = 0;
249: while (*np) hash += *np++;
250: hash = hash %NHASH;
251: defp = hashtable[hash];
252: odefp = ((struct defblk *) &hashtable[hash]);
253: while (defp && strcmp(name,defp->name)) {
254: odefp = defp;
255: defp = defp->next;
256: }
257: if (defp) odefp->next = defp->next;
258: else {
259: fprintf(stderr,"Internal error undefining symbol %s\n",name);
260: }
261: }
262: define(name,type,body)
263:
264: char *name;
265: char *body;
266: int type;
267: {
268: int hash;
269: char *np;
270: struct defblk *defp;
271:
272: np = name;
273: hash = 0;
274: while (*np) hash += *np++;
275: hash = hash %NHASH;
276: defp = hashtable[hash];
277: while (defp && strcmp(name,defp->name)) defp = defp->next;
278: if (defp == NULL) {
279: defp = ((struct defblk *) malloc(sizeof(*defp)));
280: defp->next = hashtable[hash];
281: hashtable[hash] = defp;
282: defp->name = malloc(strlen(name)+1);
283: strcpy(defp->name,name);
284: }
285: defp->type = type;
286: defp->body = malloc(strlen(body)+1);
287: strcpy(defp->body,body);
288: }
289:
290: definit()
291: {
292: int i;
293: for (i = 0; i < NHASH; i++) {
294: hashtable[i] = NULL;
295: }
296: }
297:
298:
299: char *
300: symbol()
301: {
302: char *sp;
303: int c;
304:
305: sp = symbuf;
306: c = nonblank(1);
307: ungetc(c,stdin);
308: while (1) {
309: c = gochar();
310: if ((c == EOF) || (c == ' ')|| (c == ' ')|| (c == ')') ||
311: (c == '(') || (c == '\n')) break;
312: *sp++ = c;
313: }
314: ungetc(c,stdin);
315: if (c == '\n') line--; /* Uncount newline */
316: *sp = 0;
317: return(symbuf);
318: }
319:
320: read_defs()
321: {
322: FILE *fp;
323: char name[128];
324: int type;
325: char body[128];
326: char *cp;
327: int c;
328:
329: #ifdef PC
330: fp = fopen ("edefs.dat","r");
331: if (fp == NULL) fp = fopen ("a:edefs.dat","r");
332: if (fp == NULL) fp = fopen ("b:edefs.dat","r");
333: if (fp == NULL) fp = fopen ("c:edefs.dat","r");
334: if (fp == NULL) {
335: printf ("Can't find definitions file edefs.dat\n");
336: exit(0);
337: }
338: setbin(fp);
339: #else
340: cp = expenv(defdir);
341: sprintf(name,"%s/%s",cp,DEFILE);
342: fp = fopen (name,"r");
343: if (fp == NULL) {
344: fprintf(stderr,"Can't open definitions file: %s\n",name);
345: fprintf(stderr,"Please contact your local emacs maintainer\n");
346: exit(-1);
347: }
348: #endif
349: while ((c = fgetc(fp)) != EOF) {
350: if (c != '(') fprintf(stderr,"Internal error, bad def file format %c\n",c);
351: symbin(fp,name);
352: symbin(fp,body);
353: type = gtype(body);
354: if ((type&0377) == BAD) fprintf(stderr,"Internal error, Bad type %s for symbol %s in defs file\n",body,name);
355: symbin(fp,body);
356: while ((c = fgetc(fp)) != '\n');
357: define(name,type,body);
358: }
359: fclose(fp);
360: }
361:
362: gtype(name)
363:
364: /* Returns type of name is a type definition, 0 otherwise */
365:
366: char *name;
367: {
368: int c;
369: int type;
370:
371: type = BAD;
372: if (*name == '$') {
373: type |= SVAL;
374: name++;
375: }
376: c = 0;
377: while (typetable[c]) if (strcmp(typetable[c],name) == 0) {
378: type |= c;
379: break;
380: } else c++;
381: return(type);
382: }
383:
384: symbin(fp,xp)
385: FILE *fp;
386: char *xp;
387: {
388: int c;
389: do {
390: c = fgetc(fp);
391: } while ((c == ' ') || (c == '\n'));
392: ungetc(c,fp);
393: while (1) {
394: c = fgetc(fp);
395: if ((c == EOF) || (c == ' ') || (c == ')') ||
396: (c == '(') || (c == '\n')) break;
397: if (c == '\\') {
398: c = fgetc(fp)-'0';
399: c = c * 8 + (fgetc(fp)-'0');
400: c = c * 8 + (fgetc(fp)-'0');
401: }
402: *xp++ = c;
403: }
404: ungetc(c,fp);
405: *xp = 0;
406: }
407:
408:
409: main(argc, argv)
410:
411: int argc;
412: char *argv [];
413:
414: {
415: int c;
416:
417: if (argc>1) {
418: char buf[256];
419: int x;
420: strcpy(buf,argv[1]);
421: x = strlen(buf);
422: if ((buf[x-2] != '.') || (buf[x-1] != 'e')) {
423: buf[x++]= '.';
424: buf[x++] = 'e';
425: buf[x]=0;
426: }
427: if (freopen(buf,"r",stdin) == NULL) {
428: fprintf(stderr,"Can't open input file %s\n",buf);
429: exit(-1);
430: }
431: buf[x-2]=0;
432: if (freopen(buf,"w",stdout) == NULL) {
433: fprintf(stderr,"Can't open output file %s\n",buf);
434: exit(-1);
435: }
436: #ifdef PC
437: setbin(stdout);
438: #endif
439: }
440: definit();
441: read_defs();
442: c = getchar();
443: if (c == '#') {
444: DEBUG=1;
445: } else {
446: ungetc(c,stdin);
447: }
448: while ((c = nonblank(0)) != EOF) {
449: if (c == '(' ) function();
450: }
451: }
452:
453:
454: char *
455: glob(name,body,arg)
456: char *name;
457: char *body;
458: int arg;
459: {
460: char *bp;
461: bp = macb;
462: *bp++ = CTRL('X');
463: *bp++ = '<';
464: while (*name) *bp++ = *name++;
465: *bp++ = '\n';
466: *bp++ = arg;
467: while (*body) *bp++ = *body++;
468: *bp=0;
469: return(macb);
470: }
471:
472:
473: function()
474: {
475: char *name;
476:
477: int c;
478: int type;
479: int nobind;
480:
481: c = nonblank(0);
482: if (c == '(') {
483: c = gochar();
484: while (c != ')') {
485: if (c == EOF) {
486: fprintf(stderr,"Error, macro binding sequence does not terminate\n");
487: return;
488: }
489: putchar(c);
490: c = gochar();
491: nobind = 0;
492: }
493: } else {
494: ungetc(c,stdin);
495: nobind=1;
496: }
497:
498: name = symbol();
499: if (type=gtype(name)) { /* Name is a symbol declaration */
500: name = symbol(); /* Now get real symbol */
501: } else type = SIMPLE; /* Defaults to simple macro */
502: if (nobind) {
503: nobind = lookhook(name);
504: putchar(CTRL('Z'));
505: putchar(nobind);
506: }
507: putchar (CMENT); /* ^/ */
508: PUTS(name);
509: define(name,type,macbody(name));
510: putchar (' ');
511: c = nonblank(0);
512: if (c != '(') fprintf(stderr,"Bad syntax for macro definition at line %d\n",line);
513: while ((c = getchar()) != ')') {
514: if (c == EOF) break;
515: putchar(c);
516: if (c == '\n') {
517: putchar(CMENT);
518: line++;
519: }
520: }
521: putchar('\n');
522: parseform(0);
523: putchar (CTRL('Z'));
524: putchar('\n');
525:
526: while (nlocal < NLOCAL) {
527: undefine(locals[nlocal]);
528: locals[nlocal] [strlen(locals[nlocal])-1] = 0;
529: undefine(locals[nlocal]);
530: nlocal++;
531: }
532: }
533: parseform(flags)
534: int flags;
535: {
536: int c;
537:
538: if (DEBUG) fprintf(stderr,"parseform\n");
539: /* Now parse the form */
540: while ((c = nonblank(1)) != ')') {
541: if (c == EOF) {
542: /* ARGH!! unterminated form */
543: fprintf(stderr,"Unterminated form at line %d\n",line);
544: return;
545: }
546: if (parsememb(c,flags)&CCLOSE) fprintf(stderr,"Internal error in parsememb at line %d\n",line);
547: flags = 0;
548: }
549: }
550: parsememb(c,context)
551: int c;
552: int context;
553: {
554: char *oname;
555: char *name;
556: struct defblk *defp;
557: int retflags,retval;
558:
559: retflags = 0;
560: if (c == ')') {
561: ungetc(c,stdin); /* handle users typing '(foo)' */
562: return(0);
563: }
564: if (c == '(') {
565: name = symbol();
566: defp = getname(name);
567: if (DEBUG) fprintf(stderr,"parsememb complex %s type %s context %d\n",name,typetable[(defp->type&0377)],context);
568: if (defp->type & SVAL) retflags |= CSTRING;
569: if ((defp->type & DOUBLE) && (context & CSINGLE)) {
570: putchar(META('{'));
571: retflags |= CCLOSE;
572: context^= CSINGLE;
573: }
574: if (context & CARG) {
575: if ((defp->type & SVAL) == 0) retflags |= CCONT;
576: if (context&CSINGLE) {
577: putchar(META('{'));
578: retflags |= CCLOSE;
579: context ^= CSINGLE;
580: }
581: }
582: switch(defp->type&0377) {
583:
584: case GLOBAL:
585: name = symbol();
586: define (name,SIMPLE+DOUBLE,glob(name,defp->body,META('1')));
587: c = strlen(name);
588: oname = glob(name,defp->body,META('2'));
589: name[c]='=';
590: name[c+1] = 0;
591: define (name,UNARY+DOUBLE,oname);
592: closep(defp->name);
593: break;
594: case SGLOBAL:
595: {
596: char sbuf[128];
597:
598: name = symbol();
599: sprintf(sbuf,"%c<%s\n%s",CTRL('X'),name,defp->body);
600: define (name,SIMPLE+DOUBLE+SVAL,sbuf);
601:
602: sprintf(sbuf,"%s=",defp->name);
603: defp = getname(sbuf); /* Look up giberish for def */
604: sprintf(sbuf,"%c<%s\n%s",CTRL('X'),name,defp->body);
605: c = strlen(name);
606: name[c]='=';
607: name[c+1] = 0;
608: define (name,XSTRING+DOUBLE,sbuf);
609: closep(defp->name);
610: }
611: break;
612:
613: case DCL:
614: name = symbol();
615: if (c = gtype(name)) {
616: name = symbol();
617: } else c = SIMPLE;
618: define(name,c,macbody(name));
619: closep(name);
620: break;
621: case LOCAL:
622: name = symbol();
623: if (--nlocal <= 1) {
624: fprintf (stderr,"Too many local declarations, symbol %s ignored at line %d\n",name,line);
625: ++nlocal;
626: } else {
627: char bod[4];
628: int x;
629:
630: bod[0] = META('0')+nlocal;
631: bod[1] = CTRL(']');
632: bod[2] = 0;
633:
634: define(name,NUMBER,bod);
635: x = strlen(name);
636: name[x]='=';
637: name[x+1] = 0;
638: bod[1] = META(CTRL(']'));
639: define(name,UNARY,bod);
640: defp = getname(name);
641: locals[nlocal] = defp->name;
642: }
643: closep(name);
644: break;
645: case SDCL:
646: name = symbol();
647: if (--nlocal <= 1) {
648: fprintf (stderr,"Too many local declarations, symbol %s ignored at line %d\n",name,line);
649: ++nlocal;
650: } else {
651: char bod[10];
652: int x;
653:
654: bod[0] = META('1');
655: bod[1] = '2';
656: bod[2] = CTRL('X');
657: bod[3] = '&';
658: bod[4] = META('0')+nlocal;
659: bod[5] = CTRL(']');
660: bod[6] = CTRL('Z');
661: bod[7] = 0;
662: define(name,SIMPLE+SVAL,bod);
663: x = strlen(name);
664: name[x]='=';
665: name[x+1] = 0;
666: bod[0] = META('0')+nlocal;
667: bod[1] = META(CTRL(']'));
668: bod[2] = META('1');
669: bod[3] = '1';
670: bod[4] = CTRL('X');
671: bod[5] = '&';
672: bod[6] = 0;
673: define(name,XSTRING,bod);
674: defp = getname(name);
675: locals[nlocal] = defp->name;
676: }
677: closep(name);
678: break;
679: case SIMPLE:
680: {
681: char nbuf[128];
682:
683: strcpy(nbuf,name);
684: c = nonblank(1);
685: retflags |= parsememb(c,CARG|(context&CSINGLE));
686: PUTS(defp->body);
687: closep(nbuf);
688: }
689: break;
690: case NUMBER:
691: PUTS (defp->body);
692: putchar(CTRL('Z'));
693: closep(name);
694: break;
695: case QUOTE:
696: PUTS(defp->body);
697: putchar(nonblank(1));
698: closep(name);
699: break;
700: case BINARY:
701: PUTS(defp->body);
702: c = nonblank(1);
703: parsememb(c,CSINGLE);
704: c = nonblank(1);
705: parsememb(c,CSINGLE);
706: closep(name);
707: break;
708: case UNARY:
709: PUTS(defp->body);
710: c = nonblank(1);
711: parsememb(c,CSINGLE);
712: closep(name);
713: break;
714: case BEGIN:
715: putchar (META('{'));
716: parseform(0);
717: putchar (META('}'));
718: break;
719: case WHILE:
720: putchar (CTRLX);
721: putchar ('^');
722: putchar (META('{'));
723: parseform(CSINGLE);
724: putchar (META('}'));
725: break;
726: case CASE:
727: putchar (CTRLX);
728: putchar ('!');
729: putchar (META('{'));
730: c = nonblank(1);
731: parsememb(c,CSINGLE);
732: while (1) {
733: c = nonblank(1);
734: if (c == ')') break;
735: if (c != '(') {
736: fprintf(stderr,"Syntax error in case at line %d, character %c\n",line,c);
737: if (c == EOF) break; /* Best we can do */
738: continue;
739: }
740: putchar (META('{'));
741: c = gochar();
742: if (c == 'e') {
743: int c1;
744: c1 = gochar();
745: if (c1 == 'l') {
746: c1 = gochar();
747: c1 = gochar();
748: c = 0377; /* Default case */
749: } else ungetc(c1,stdin);
750: }
751: putchar(c);
752: parseform(0);
753: putchar (META('}'));
754: }
755: putchar (META('}'));
756: break;
757: case COND:
758: putchar(CTRLX);
759: putchar ('|');
760: putchar (META('{'));
761: while (1) {
762: c = nonblank(1);
763: if (c == ')') {
764: putchar (META('}'));
765: break;
766: }
767: if (c != '(') {
768: fprintf(stderr,"Syntax error in conditional at line %d, character %c\n",line,c);
769: continue;
770: }
771: putchar(META('{'));
772: parseform(CSINGLE);
773: putchar(META('}'));
774: }
775: break;
776: case INSERT:
777: c = nonblank(1);
778: if (c == '"') {
779: while ((c=gochar()) != '"') {
780: if ((c <= 040) || ((c&0377) >= 0177)) {
781: if ((c&0377) >= 0200) putchar(META('q'));
782: else putchar(CTRL('Q'));
783: }
784: putchar(c&0177);
785: }
786: } else {
787: fprintf(stderr,"Argument to %s at line %d must be enclosed in quotes\n",name,line);
788: }
789: closep(name);
790: break;
791: case MAP:
792: {
793: char buf[256];
794: char *cp;
795: c = nonblank(1);
796: if (c == '"') {
797: pstring(buf);
798: } else {
799: fprintf(stderr,"Argument to %s at line %d must be enclosed in quotes\n",name,line);
800: }
801:
802: while ((c = nonblank(1)) != ')') {
803: retval = parsememb(c,CARG|CSTRING|(context&CSINGLE));
804: if (retval & CCLOSE) {
805: context &= ~CSINGLE;
806: retflags |= CCLOSE;
807: }
808: }
809: PUTS(defp->body);
810: cp = buf;
811: while (*cp) {
812: putchar(*cp);
813: cp++;
814: }
815: }
816: break;
817: case CHAR:
818: {
819: char buf[10];
820:
821: buf[0] = nonblank(1);
822: if (buf[0] == CTRL('X')) {
823: buf[1] = nonblank(1);
824: buf[2]= 0;
825: } else buf[1] = 0;
826: c = nonblank(1);
827: if (c != ')') {
828: retflags |= parsememb(c,CARG|(context&CSINGLE));
829: closep(defp->name);
830: }
831: PUTS(buf);
832: }
833: break;
834: case PSTRING:
835: {
836: char buf[256];
837: char *cp;
838: c = nonblank(1);
839: if (c == '"') {
840: pstring(buf);
841: } else {
842: /* Argument is not a literal, must use the long form */
843: ungetc(c,stdin);
844: sprintf(buf,"L%s",defp->name);
845: defp = getname(buf);
846: goto xstring; /* Process long form */
847: }
848:
849: while ((c = nonblank(1)) != ')') {
850: retval = parsememb(c,CARG|CSTRING|(context&CSINGLE));
851: if (retval & CCLOSE) {
852: context &= ~CSINGLE;
853: retflags |= CCLOSE;
854: }
855: }
856: PUTS(defp->body);
857: cp = buf;
858: while (*cp) {
859: if (*cp == '\n') putchar (CTRL('Q'));
860: if (*cp == CTRL('Z')) putchar (CTRL('Q'));
861: putchar(*cp);
862: cp++;
863: }
864: putchar('\n');
865: }
866: break;
867: case XSTRING:
868: xstring: while ((c = nonblank(1)) != ')') {
869: retval = parsememb(c,CARG|CSTRING|(context&CSINGLE));
870: if (retval & CCLOSE) {
871: context &= ~CSINGLE;
872: retflags |= CCLOSE;
873: }
874: }
875: PUTS(defp->body);
876: break;
877: default:
878: fprintf(stderr,"Error in parser at line %d, name %s\n",line,name);
879: }
880: } else {
881: if (c == '"') { /* String argument, if appropriate, push it */
882: if ((context & CSTRING) == 0) {
883: fprintf(stderr,"Misplaced character string at line %d\n",line);
884: }
885: if (context & CSINGLE) {
886: retflags |= CCLOSE;
887: putchar(META('{'));
888: }
889: putchar (CTRL('X'));
890: putchar ('<');
891: pstring (NULL);
892: retflags |= CSTRING;
893: } else {
894: ungetc(c,stdin);
895: name = symbol();
896: defp = getname(name);
897: if (defp->type & SVAL) retflags |= CSTRING;
898: if ((defp->type & DOUBLE) && (context & CSINGLE)) {
899: putchar(META('{'));
900: retflags |= CCLOSE;
901: context^= CSINGLE;
902: }
903: if (DEBUG) fprintf(stderr,"parsememb simple %s type %s, context: %d\n",name,typetable[defp->type&0377],context);
904: switch(defp->type&0377) {
905: case SIMPLE:
906: case XSTRING:
907: if (context & CARG) {
908: if ((defp->type & SVAL) == 0) retflags |= CCONT;
909: if (context&CSINGLE) {
910: putchar(META('{'));
911: retflags |= CCLOSE;
912: }
913: }
914: PUTS(defp->body);
915: break;
916: case NUMBER:
917: PUTS (defp->body);
918: if ((context &CARG) == 0) putchar(CTRL('Z'));
919: break;
920: default:
921: fprintf(stderr,"function %s at line %d requires arguments\n",name,line);
922: }
923: }
924: }
925: if (DEBUG) {
926: c = getchar();
927: fprintf(stderr,"exiting parsememb before %c\n",c);
928: ungetc(c,stdin);
929: }
930:
931: if (((context & CARG) == 0) && (retflags & CCLOSE)) {
932: putchar(CTRL('^'));
933: putchar(META('}'));
934: retflags &= ~(CCLOSE|CARG);
935: }
936: if (retflags & CCONT) putchar(CTRL('^'));
937: return(retflags & (CCLOSE^CSTRING));
938: }
939: closep(name)
940: char *name;
941: {
942: int c;
943:
944: c = nonblank(1);
945: if (c != ')') {
946: fprintf(stderr,"Syntax error at line %d, extraneous characters in form after %s\n Ignoring characters:",line,name);
947: while ((c = getchar()) != ')') {
948: if (c == EOF) break;
949: fputc(c,stderr);
950: }
951: fputc('\n',stderr);
952: }
953: }
954: gochar()
955: {
956: int c;
957:
958: c = getchar();
959: if (c == '\n') line++;
960: if (c != '\\') return(c);
961: else {
962: c = getchar();
963: if (c == 'n') return('\n'+01000);
964: if ((c >= '0') && (c <= '7')) {
965: c -= '0';
966: c = c*8 + getchar() - '0';
967: c = c*8 + getchar() - '0';
968: }
969: return(c+01000); /* Make sure it doesn't match anything */
970: }
971: }
972: nonblank(cment)
973: int cment;
974: {
975: int c;
976: while (1) {
977: c = gochar();
978: if (c == EOF) return(c);
979: if ((c == ' ') || (c == ' ')) continue;
980: if (c == '\n') {
981: continue;
982: }
983: if (c == '/') {
984: if (cment) putchar(CMENT);
985: while ((c = getchar()) != '/') {
986: if (c == EOF) {
987: fprintf(stderr,"unterminated comment");
988: return(c);
989: }
990: if (cment) putchar(c);
991: if (c == '\n') {
992: if (cment) putchar(CMENT);
993: line++;
994: }
995: }
996: if (cment) putchar('\n');
997: continue;
998: }
999: return(c);
1000: }
1001: }
1002:
1003: PUTS(string)
1004: char *string;
1005: {
1006: while (*string){
1007: putchar(*string);
1008: string++;
1009: }
1010: }
1011: pstring(ptr)
1012: char *ptr;
1013: {
1014: int c;
1015: int oline;
1016: oline = line;
1017: while ((c = gochar()) != '"') {
1018: if (c == EOF) {
1019: fprintf(stderr,"Unterminated string starting at line %d\n",oline);
1020: break;
1021: }
1022: if (ptr) {
1023: *ptr++ = c;
1024: } else {
1025: if ((c&0377) == '\n') putchar(CTRL('Q'));
1026: if ((c&0377) == CTRL('Z')) putchar(CTRL('Q'));
1027: putchar(c);
1028: }
1029: }
1030: if (ptr) {
1031: *ptr++ = 0;
1032: } else {
1033: putchar('\n');
1034: }
1035: }
1036:
1037: xgetc(fp)
1038: FILE *fp;
1039: {
1040: int c;
1041:
1042: c= fgetc(fp);
1043: fprintf(stderr,"got '%c' %o\n",c);
1044: return(c);
1045: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.