1 /* This file is for functions dealing with execution of
2 commands, command lines, buffers, files and startup files
3
4 written 1993 by Daniel Lawrence */
5
6 #include <stdio.h>
7 #include "estruct.h"
8 #include "eproto.h"
9 #include "edef.h"
10 #include "elang.h"
11
12 /* namedcmd: execute a named command even if it is not bound */
13
namedcmd(f,n)14 PASCAL NEAR namedcmd(f, n)
15
16 int f, n; /* command arguments [passed through to command executed] */
17
18 {
19 int (PASCAL NEAR *kfunc)(); /* ptr to the function to execute */
20 char buffer[NSTRING]; /* buffer to store function name */
21 int status;
22
23 /* if we are non-interactive.... force the command interactivly */
24 if (clexec == TRUE) {
25
26 /* grab token and advance past */
27 execstr = token(execstr, buffer, NPAT);
28
29 /* evaluate it */
30 strcpy(buffer, fixnull(getval(buffer)));
31 if (strcmp(buffer, errorm) == 0)
32 return(FALSE);
33
34 /* and look it up */
35 if ((kfunc = fncmatch(buffer)) == NULL) {
36 mlwrite(TEXT16);
37 /* "[No such Function]" */
38 return(FALSE);
39 }
40
41 /* and execute it INTERACTIVE */
42 clexec = FALSE;
43 status = (*kfunc)(f, n); /* call the function */
44 clexec = TRUE;
45 return(status);
46 }
47
48 /* prompt the user to type a named command */
49 /* and get the function name to execute */
50 kfunc = getname(": ");
51 if (kfunc == NULL) {
52 mlwrite(TEXT16);
53 /* "[No such function]" */
54 return(FALSE);
55 }
56
57 /* and then execute the command */
58 return((*kfunc)(f, n));
59 }
60
61 /* execcmd: Execute a command line command to be typed in
62 by the user */
63
execcmd(f,n)64 PASCAL NEAR execcmd(f, n)
65
66 int f, n; /* default Flag and Numeric argument */
67
68 {
69 register int status; /* status return */
70 char cmdstr[NSTRING]; /* string holding command to execute */
71
72 /* get the line wanted */
73 if ((status = mlreply(": ", cmdstr, NSTRING)) != TRUE)
74 return(status);
75
76 execlevel = 0;
77 return(docmd(cmdstr));
78 }
79
80 /* docmd: take a passed string as a command line and translate
81 it to be executed as a command. This function will be
82 used by execute-command-line and by all source and
83 startup files. Lastflag/thisflag is also updated.
84
85 format of the command line is:
86
87 {# arg} <command-name> {<argument string(s)>}
88
89 */
90
docmd(cline)91 PASCAL NEAR docmd(cline)
92
93 char *cline; /* command line to execute */
94
95 {
96 register int f; /* default argument flag */
97 register int n; /* numeric repeat value */
98 int (PASCAL NEAR *fnc)();/* function to execute */
99 BUFFER *bp; /* buffer to execute */
100 int status; /* return status of function */
101 int oldcle; /* old contents of clexec flag */
102 char *oldestr; /* original exec string */
103 char tkn[NSTRING]; /* next token off of command line */
104 char bufn[NBUFN+2]; /* name of buffer to execute */
105
106 /* if we are scanning and not executing..go back here */
107 if (execlevel)
108 return(TRUE);
109
110 oldestr = execstr; /* save last ptr to string to execute */
111 execstr = cline; /* and set this one as current */
112
113 /* first set up the default command values */
114 f = FALSE;
115 n = 1;
116 lastflag = thisflag;
117 thisflag = 0;
118
119 if ((status = macarg(tkn)) != TRUE) { /* and grab the first token */
120 execstr = oldestr;
121 return(status);
122 }
123
124 /* process leadin argument */
125 if (gettyp(tkn) != TKCMD) {
126 f = TRUE;
127 strcpy(tkn, fixnull(getval(tkn)));
128 n = asc_int(tkn);
129
130 /* and now get the command to execute */
131 if ((status = macarg(tkn)) != TRUE) {
132 execstr = oldestr;
133 return(status);
134 }
135 }
136
137 /* and match the token to see if it exists */
138 if ((fnc = fncmatch(tkn)) == NULL) {
139
140 /* construct the buffer name */
141 strcpy(bufn, "[");
142 strcat(bufn, tkn);
143 strcat(bufn, "]");
144
145 /* find the pointer to that buffer */
146 if ((bp=bfind(bufn, FALSE, 0)) == NULL) {
147 mlwrite(TEXT16);
148 /* "[No such Function]" */
149 execstr = oldestr;
150 return(FALSE);
151 }
152
153 /* execute the buffer */
154 oldcle = clexec; /* save old clexec flag */
155 clexec = TRUE; /* in cline execution */
156 while (n-- > 0)
157 if ((status = dobuf(bp)) != TRUE)
158 break;
159 cmdstatus = status; /* save the status */
160 clexec = oldcle; /* restore clexec flag */
161 execstr = oldestr;
162 return(status);
163 }
164
165 /* save the arguments and go execute the command */
166 oldcle = clexec; /* save old clexec flag */
167 clexec = TRUE; /* in cline execution */
168 status = (*fnc)(f, n); /* call the function */
169 cmdstatus = status; /* save the status */
170 clexec = oldcle; /* restore clexec flag */
171 execstr = oldestr;
172 return(status);
173 }
174
175 /* token: chop a token off a string
176 return a pointer past the token
177 */
178
token(src,tok,size)179 char *PASCAL NEAR token(src, tok, size)
180
181 char *src, *tok; /* source string, destination token string */
182 int size; /* maximum size of token */
183
184 {
185 register int quotef; /* is the current string quoted? */
186 register char c; /* temporary character */
187
188 /* first scan past any whitespace in the source string */
189 while (*src == ' ' || *src == '\t')
190 ++src;
191
192 /* scan through the source string */
193 quotef = FALSE;
194 while (*src) {
195 /* process special characters */
196 if (*src == '~') {
197 ++src;
198 if (*src == 0)
199 break;
200 switch (*src++) {
201 case 'r': c = 13; break;
202 case 'n': c = 13; break;
203 case 'l': c = 10; break;
204 case 't': c = 9; break;
205 case 'b': c = 8; break;
206 case 'f': c = 12; break;
207 case 'e': c = 27; break;
208 default: c = *(src-1);
209 }
210 if (--size > 0) {
211 *tok++ = c;
212 }
213 } else {
214 /* check for the end of the token */
215 if (quotef) {
216 if (*src == '"')
217 break;
218 } else {
219 if (*src == ' ' || *src == '\t')
220 break;
221 }
222
223 /* set quote mode if quote found */
224 if (*src == '"')
225 quotef = TRUE;
226
227 /* record the character */
228 c = *src++;
229 if (--size > 0)
230 *tok++ = c;
231 }
232 }
233
234 /* terminate the token and exit */
235 if (*src)
236 ++src;
237 *tok = 0;
238 return(src);
239 }
240
macarg(tok)241 PASCAL NEAR macarg(tok) /* get a macro line argument */
242
243 char *tok; /* buffer to place argument */
244
245 {
246 int savcle; /* buffer to store original clexec */
247 int status;
248
249 savcle = clexec; /* save execution mode */
250 clexec = TRUE; /* get the argument */
251 status = nextarg("", tok, NSTRING, ctoec('\r'));
252 clexec = savcle; /* restore execution mode */
253 return(status);
254 }
255
256 /* nextarg: get the next argument */
257
nextarg(prompt,buffer,size,terminator)258 PASCAL NEAR nextarg(prompt, buffer, size, terminator)
259
260 char *prompt; /* prompt to use if we must be interactive */
261 char *buffer; /* buffer to put token into */
262 int size; /* size of the buffer */
263 int terminator; /* terminating char to be used on interactive fetch */
264
265 {
266 register char *sp; /* return pointer from getval() */
267
268 /* if we are interactive, go get it! */
269 if (clexec == FALSE) {
270 /* prompt the user for the input string */
271 if (discmd) {
272 if (prompt) mlwrite(prompt);
273 }
274 else
275 movecursor(term.t_nrow, 0);
276
277 return(getstring(buffer, size, terminator));
278 }
279
280 /* grab token and advance past */
281 execstr = token(execstr, buffer, size);
282
283 /* evaluate it */
284 if ((sp = getval(buffer)) == NULL)
285 return(FALSE);
286 strcpy(buffer, sp);
287 return(TRUE);
288 }
289
290 /* storeproc: Set up a procedure buffer and flag to store all
291 executed command lines there */
292
storeproc(f,n)293 PASCAL NEAR storeproc(f, n)
294
295 int f; /* default flag */
296 int n; /* macro number to use */
297
298 {
299 register struct BUFFER *bp; /* pointer to macro buffer */
300 PARG *last_arg; /* last macro argument */
301 PARG *cur_arg; /* current macro argument */
302 char bname[NBUFN]; /* name of buffer to use */
303
304 /* this commands makes no sense interactively */
305 if (clexec == FALSE)
306 return(FALSE);
307
308 /* get the name of the procedure */
309 execstr = token(execstr, &bname[1], NBUFN-2);
310
311 /* construct the macro buffer name */
312 bname[0] = '[';
313 strcat(bname, "]");
314
315 /* set up the new macro buffer */
316 if ((bp = bfind(bname, TRUE, BFINVS)) == NULL) {
317 mlwrite(TEXT113);
318 /* "Can not create macro" */
319 return(FALSE);
320 }
321
322 /* and make sure it is empty */
323 bclear(bp);
324
325 /* retrieve and store any formal parameters */
326 last_arg = (PARG *)NULL;
327 bp->b_numargs = 0;
328 execstr = token(execstr, bname, NVSIZE);
329
330 while (*bname && *bname != ';') {
331
332 /* allocate an argument */
333 cur_arg = (PARG *)room(sizeof(PARG));
334 if (cur_arg == (PARG *)NULL) {
335 mlwrite(TEXT113);
336 /* "Can not create macro" */
337 return(FALSE);
338 }
339
340 /* and add it to the linked list of arguments for this buffer */
341 strcpy(cur_arg->name, bname);
342 cur_arg->next = (PARG *)NULL;
343 if (last_arg == (PARG *)NULL)
344 bp->b_args = cur_arg;
345 else
346 last_arg->next = cur_arg;
347
348 /* and let the buffer total these */
349 bp->b_numargs++;
350 last_arg = cur_arg;
351
352 /* on to the next parameter */
353 execstr = token(execstr, bname, NVSIZE);
354 }
355
356 /* and set the macro store pointers to it */
357 mstore = TRUE;
358 bstore = bp;
359 return(TRUE);
360 }
361
362 /* execproc: Execute a procedure */
363
execproc(f,n)364 PASCAL NEAR execproc(f, n)
365
366 int f, n; /* default flag and numeric arg */
367
368 {
369 register BUFFER *bp; /* ptr to buffer to execute */
370 register int status; /* status return */
371 char bufn[NBUFN+2]; /* name of buffer to execute */
372
373 /* find out what buffer the user wants to execute */
374 if ((status = mlreply(TEXT115, &bufn[1], NBUFN)) != TRUE)
375 /* "Execute procedure: " */
376 return(status);
377
378 /* construct the buffer name */
379 bufn[0] = '[';
380 strcat(bufn, "]");
381
382 /* find the pointer to that buffer */
383 if ((bp=bfind(bufn, FALSE, 0)) == NULL) {
384 mlwrite(TEXT116);
385 /* "No such procedure" */
386 return(FALSE);
387 }
388
389 /* and now execute it as asked */
390 while (n-- > 0)
391 if ((status = dobuf(bp)) != TRUE)
392 return(status);
393 return(TRUE);
394 }
395
396 /* execbuf: Execute the contents of a buffer of commands */
397
execbuf(f,n)398 PASCAL NEAR execbuf(f, n)
399
400 int f, n; /* default flag and numeric arg */
401
402 {
403 register BUFFER *bp; /* ptr to buffer to execute */
404 register int status; /* status return */
405
406 /* find out what buffer the user wants to execute */
407 if ((bp = getcbuf(TEXT117, curbp->b_bname, FALSE)) == NULL)
408 /* "Execute buffer: " */
409 return(ABORT);
410
411 /* and now execute it as asked */
412 while (n-- > 0)
413 if ((status = dobuf(bp)) != TRUE)
414 return(status);
415 return(TRUE);
416 }
417
418 /* dobuf: execute the contents of the buffer pointed to
419 by the passed BP
420
421 Directives start with a "!" and include:
422
423 !endm End a macro
424 !if (cond) conditional execution
425 !else
426 !endif
427 !return <rval> Return (terminating current macro/
428 set $rval to and return <rval>)
429 !goto <label> Jump to a label in the current macro
430 !force Force macro to continue...even if command fails
431 !while (cond) Execute a loop if the condition is true
432 !endwhile
433
434 Line Labels begin with a "*" as the first nonblank char, like:
435
436 *LBL01
437 */
438
dobuf(bp)439 PASCAL NEAR dobuf(bp)
440
441 BUFFER *bp; /* buffer to execute */
442
443 {
444 register int status; /* status return */
445 register LINE *lp; /* pointer to line to execute */
446 register LINE *hlp; /* pointer to line header */
447 register LINE *glp; /* line to goto */
448 LINE *mp; /* Macro line storage temp */
449 int dirnum; /* directive index */
450 int linlen; /* length of line to execute */
451 int i; /* index */
452 int force; /* force TRUE result? */
453 EWINDOW *wp; /* ptr to windows to scan */
454 WHBLOCK *whlist; /* ptr to !WHILE list */
455 WHBLOCK *scanner; /* ptr during scan */
456 WHBLOCK *whtemp; /* temporary ptr to a WHBLOCK */
457 char *einit; /* initial value of eline */
458 char *eline; /* text of line to execute */
459 char tkn[NSTRING]; /* buffer to evaluate an expresion in */
460 int num_locals; /* number of local variables used in procedure */
461 UTABLE *ut; /* new local user variable table */
462 #if LOGFLG
463 FILE *fp; /* file handle for log file */
464 #endif
465 int skipflag; /* are we skipping debugging a function? */
466 PARG *cur_arg; /* current argument being filled */
467 int cur_index; /* index into current user table */
468 VDESC vd; /* variable num/type */
469 char value[NSTRING]; /* evaluated argument */
470
471 /* clear IF level flags/while ptr */
472 execlevel = 0;
473 whlist = NULL;
474 scanner = NULL;
475 num_locals = 0;
476
477 /* flag we are executing the buffer */
478 bp->b_exec += 1;
479
480 /* we are not skipping a function yet (for the debugger) */
481 skipflag = FALSE;
482
483 /* scan the buffer to execute, building WHILE header blocks
484 and counting local variables */
485 hlp = bp->b_linep;
486 lp = lforw(hlp);
487 while (lp != hlp) {
488
489 /* scan the current line */
490 eline = ltext(lp);
491 i = lused(lp);
492
493 /* trim leading whitespace */
494 while (i > 0 && (*eline == ' ' || *eline == '\t')) {
495 i--;
496 ++eline;
497 }
498
499 /* if theres nothing here, don't bother */
500 if (i <= 0)
501 goto nxtscan;
502
503 /* if we are already in a stored-procedure */
504 if (mstore) {
505 if (strncmp(eline, "!endm", 5) == 0)
506 mstore = FALSE;
507 goto nxtscan;
508 }
509
510 /* stored procedure? */
511 if (strncmp(eline, "store-procedure", 15) == 0) {
512 mstore = TRUE;
513 goto nxtscan;
514 }
515
516 /* local variable declaration? */
517 if (strncmp(eline, "local", 5) == 0)
518 ++num_locals;
519
520 /* if is a while directive, make a block... */
521 if (eline[0] == '!' && eline[1] == 'w' && eline[2] == 'h') {
522 whtemp = (WHBLOCK *)room(sizeof(WHBLOCK));
523 if (whtemp == NULL) {
524 noram: errormesg(TEXT119, bp, lp);
525 /* "%%Out of memory during while scan" */
526 failexit: freewhile(scanner);
527 goto eabort;
528 }
529 whtemp->w_begin = lp;
530 whtemp->w_type = BTWHILE;
531 whtemp->w_next = scanner;
532 scanner = whtemp;
533 }
534
535 /* if is a BREAK directive, make a block... */
536 if (eline[0] == '!' && eline[1] == 'b' && eline[2] == 'r') {
537 if (scanner == NULL) {
538 errormesg(TEXT120, bp, lp);
539 /* "%%!BREAK outside of any !WHILE loop" */
540 goto failexit;
541 }
542 whtemp = (WHBLOCK *)room(sizeof(WHBLOCK));
543 if (whtemp == NULL)
544 goto noram;
545 whtemp->w_begin = lp;
546 whtemp->w_type = BTBREAK;
547 whtemp->w_next = scanner;
548 scanner = whtemp;
549 }
550
551 /* if it is an endwhile directive, record the spot... */
552 if (eline[0] == '!' && strncmp(&eline[1], "endw", 4) == 0) {
553 if (scanner == NULL) {
554 errormesg(TEXT121, bp, lp);
555 /* "%%!ENDWHILE with no preceding !WHILE" */
556 goto failexit;
557 }
558 /* move top records from the scanner list to the
559 whlist until we have moved all BREAK records
560 and one WHILE record */
561 do {
562 scanner->w_end = lp;
563 whtemp = whlist;
564 whlist = scanner;
565 scanner = scanner->w_next;
566 whlist->w_next = whtemp;
567 } while (whlist->w_type == BTBREAK);
568 }
569
570 nxtscan: /* on to the next line */
571 lp = lforw(lp);
572 }
573
574 /* while and endwhile should match! */
575 if (scanner != NULL) {
576 errormesg(TEXT122, bp, lp);
577 /* "%%!WHILE with no matching !ENDWHILE" */
578 goto failexit;
579 }
580
581 /* let the first command inherit the flags from the last one..*/
582 thisflag = lastflag;
583
584 /* remember we need room for the procedure arguments
585 among the locals */
586 if (bp->b_numargs == NOTPROC)
587 bp->b_numargs = 0;
588 num_locals += bp->b_numargs;
589
590 /* allocate a local user variable table */
591 ut = (UTABLE *)room(sizeof(UTABLE) + num_locals * sizeof(UVAR));
592 if (ut == (UTABLE *)NULL) {
593 errormesg("%%Out of memory allocating locals", bp, lp);
594 execlevel = 0;
595 freewhile(whlist);
596 bp->b_exec -= 1;
597 return(FALSE);
598 }
599 ut->next = uv_head;
600 ut->size = num_locals;
601 ut->bufp = bp;
602 uv_init(ut);
603 uv_head = ut;
604
605 /* and evaluate the arguments passed, placing them in
606 the local variable table */
607 cur_index = 0;
608 cur_arg = bp->b_args;
609 while (cur_arg != (PARG *)NULL) {
610
611 /* ask for argument names */
612 if ((status = mlreply("Argument: ", value, NSTRING)) != TRUE)
613 /* "Argument: " */
614 return(status);
615
616 /* and create and set these in the local user var table */
617 findvar(cur_arg->name, &vd, NVSIZE + 1, VT_LOCAL);
618 svar(&vd, value);
619
620 /* on to the next argument */
621 cur_arg = cur_arg->next;
622 cur_index++;
623 }
624
625 /* starting at the beginning of the buffer */
626 hlp = bp->b_linep;
627 lp = lforw(hlp);
628 while (lp != hlp && eexitflag == FALSE) {
629
630 /* allocate eline and copy macro line to it */
631 linlen = lused(lp);
632 if ((einit = eline = room(linlen+1)) == NULL) {
633 errormesg(TEXT123, bp, lp);
634 /* "%%Out of Memory during macro execution" */
635 freewhile(whlist);
636 bp->b_exec -= 1;
637 goto freeut;
638 }
639 bytecopy(eline, ltext(lp), linlen);
640 eline[linlen] = 0; /* make sure it ends */
641
642 /* trim leading whitespace */
643 while (*eline == ' ' || *eline == '\t')
644 ++eline;
645
646 /* dump comments and blank lines */
647 if (*eline == ';' || *eline == 0)
648 goto onward;
649
650 #if LOGFLG
651 /* append the current command to the log file */
652 fp = fopen("emacs.log", "a");
653 strcpy(outline, eline);
654 fprintf(fp, "%s", outline);
655 fclose(fp);
656 #endif
657
658 /* only do this if we are debugging */
659 if (macbug && !mstore && (execlevel == 0))
660 if (debug(bp, eline, &skipflag) == FALSE) {
661 errormesg(TEXT54, bp, lp);
662 /* "[Macro aborted]" */
663 goto eabort;
664 }
665
666 /* Parse directives here.... */
667 dirnum = -1;
668 if (*eline == '!') {
669 /* Find out which directive this is */
670 ++eline;
671 for (dirnum = 0; dirnum < NUMDIRS; dirnum++)
672 if (strncmp(eline, dname[dirnum],
673 dname_len[dirnum]) == 0)
674 break;
675
676 /* and bitch if it's illegal */
677 if (dirnum == NUMDIRS) {
678 errormesg(TEXT124, bp, lp);
679 /* "%%Unknown Directive" */
680 goto eabort;
681 }
682
683 /* service only the !ENDM macro here */
684 if (dirnum == DENDM) {
685 mstore = FALSE;
686 bstore = NULL;
687 goto onward;
688 }
689
690 /* restore the original eline....*/
691 --eline;
692 }
693
694 /* if macro store is on, just salt this away */
695 if (mstore) {
696 /* allocate the space for the line */
697 linlen = strlen(eline);
698 if ((mp=lalloc(linlen)) == NULL) {
699 errormesg(TEXT125, bp, lp);
700 /* "Out of memory while storing macro" */
701 goto eabort;
702 }
703
704 /* copy the text into the new line */
705 for (i=0; i<linlen; ++i)
706 lputc(mp, i, eline[i]);
707
708 /* attach the line to the end of the buffer */
709 bstore->b_linep->l_bp->l_fp = mp;
710 mp->l_bp = bstore->b_linep->l_bp;
711 bstore->b_linep->l_bp = mp;
712 mp->l_fp = bstore->b_linep;
713 goto onward;
714 }
715
716 force = FALSE;
717
718 /* dump comments */
719 if (*eline == '*')
720 goto onward;
721
722 /* now, execute directives */
723 if (dirnum != -1) {
724 /* skip past the directive */
725 while (*eline && *eline != ' ' && *eline != '\t')
726 ++eline;
727 execstr = eline;
728
729 switch (dirnum) {
730 case DIF: /* IF directive */
731 /* grab the value of the logical exp */
732 if (execlevel == 0) {
733 if (macarg(tkn) != TRUE) {
734 free(einit);
735 goto eexec;
736 }
737 if (stol(tkn) == FALSE)
738 ++execlevel;
739 } else
740 ++execlevel;
741 goto onward;
742
743 case DWHILE: /* WHILE directive */
744 /* grab the value of the logical exp */
745 if (execlevel == 0) {
746 if (macarg(tkn) != TRUE) {
747 free(einit);
748 goto eexec;
749 }
750 if (stol(tkn) == TRUE)
751 goto onward;
752 }
753 /* drop down and act just like !BREAK */
754
755 case DBREAK: /* BREAK directive */
756 if (dirnum == DBREAK && execlevel)
757 goto onward;
758
759 /* jump down to the endwhile */
760 /* find the right while loop */
761 whtemp = whlist;
762 while (whtemp) {
763 if (whtemp->w_begin == lp)
764 break;
765 whtemp = whtemp->w_next;
766 }
767
768 if (whtemp == NULL) {
769 errormesg(TEXT126, bp, lp);
770 /* "%%Internal While loop error" */
771 goto eabort;
772 }
773
774 /* reset the line pointer back.. */
775 lp = whtemp->w_end;
776 goto onward;
777
778 case DELSE: /* ELSE directive */
779 if (execlevel == 1)
780 --execlevel;
781 else if (execlevel == 0 )
782 ++execlevel;
783 goto onward;
784
785 case DENDIF: /* ENDIF directive */
786 if (execlevel)
787 --execlevel;
788 goto onward;
789
790 case DGOTO: /* GOTO directive */
791 /* .....only if we are currently executing */
792 if (execlevel == 0) {
793
794 #if WINDOW_MSWIN
795 longop(TRUE);
796 #endif
797 /* grab label to jump to */
798 eline = token(eline, golabel, NPAT);
799 linlen = strlen(golabel);
800 glp = lforw(hlp);
801 while (glp != hlp) {
802 if ((lused(glp) >= linlen) &&
803 (lgetc(glp, 0) == '*') &&
804 (strncmp(((char *)ltext(glp)) + 1,
805 golabel, linlen) == 0)) {
806 lp = glp;
807 goto onward;
808 }
809 glp = lforw(glp);
810 }
811 errormesg(TEXT127, bp, lp);
812 /* "%%No such label" */
813 goto eabort;
814 }
815 goto onward;
816
817 case DRETURN: /* RETURN directive */
818 /* if we are executing.... */
819 if (execlevel == 0) {
820
821 /* check for a return value */
822 if (macarg(tkn) == TRUE)
823 strcpy(rval, tkn);
824
825 /* and free the line resources */
826 free(einit);
827 goto eexec;
828 }
829 goto onward;
830
831 case DENDWHILE: /* ENDWHILE directive */
832 if (execlevel) {
833 --execlevel;
834 goto onward;
835 } else {
836 #if WINDOW_MSWIN
837 longop(TRUE);
838 #endif
839 /* find the right while loop */
840 whtemp = whlist;
841 while (whtemp) {
842 if (whtemp->w_type == BTWHILE &&
843 whtemp->w_end == lp)
844 break;
845 whtemp = whtemp->w_next;
846 }
847
848 if (whtemp == NULL) {
849 errormesg(TEXT126, bp, lp);
850 /* "%%Internal While loop error" */
851 goto eabort;
852 }
853
854 /* reset the line pointer back.. */
855 lp = lback(whtemp->w_begin);
856 goto onward;
857 }
858
859 case DFORCE: /* FORCE directive */
860 force = TRUE;
861
862 }
863 }
864
865 /* execute the statement */
866 status = docmd(eline);
867 if (force) /* force the status */
868 status = TRUE;
869
870 #if LOGFLG
871 /* append the current command to the log file */
872 fp = fopen("emacs.log", "a");
873 fprintf(fp, ". . . done\n");
874 fclose(fp);
875 #endif
876
877 /* check for a command error */
878 if (status != TRUE) {
879
880 /* look if buffer is showing */
881 wp = wheadp;
882 while (wp != NULL) {
883 if (wp->w_bufp == bp) {
884 /* and point it */
885 wp->w_dotp = lp;
886 wp->w_doto = 0;
887 wp->w_flag |= WFHARD;
888 }
889 wp = wp->w_wndp;
890 }
891
892 /* in any case set the buffer . */
893 bp->b_dotp = lp;
894 bp->b_doto = 0;
895
896 errormesg(TEXT219, bp, lp);
897 /* "%%Macro Failed" */
898
899 execlevel = 0;
900 freewhile(whlist);
901 bp->b_exec -= 1;
902 free(einit);
903
904 /* discard the local user variable table */
905 uv_head = ut->next;
906 uv_clean(ut);
907 free(ut);
908
909 return(status);
910 }
911
912 onward: /* on to the next line */
913 free(einit);
914 lp = lforw(lp);
915 if (skipflag)
916 macbug = TRUE;
917 }
918
919 eexec: /* exit the current function */
920 execlevel = 0;
921 freewhile(whlist);
922 bp->b_exec -= 1;
923
924 /* discard the local user variable table */
925 uv_head = ut->next;
926 uv_clean(ut);
927 free(ut);
928 return(TRUE);
929
930 eabort: /* exit the current function with a failure */
931 execlevel = 0;
932 freewhile(whlist);
933 bp->b_exec -= 1;
934 free(einit);
935
936 /* discard the local user variable table */
937 freeut: uv_head = ut->next;
938 uv_clean(ut);
939 free(ut);
940 return(FALSE);
941 }
942
943 /* errormesg: display a macro execution error along with the buffer and
944 line currently being executed */
945
errormesg(mesg,bp,lp)946 VOID PASCAL NEAR errormesg(mesg, bp, lp)
947
948 char *mesg; /* error message to display */
949 BUFFER *bp; /* buffer error occured in */
950 LINE *lp; /* line " */
951
952 {
953 char buf[NSTRING];
954
955 exec_error = TRUE;
956
957 /* build error message line */
958 strcpy(buf, "\n");
959 strcat(buf, mesg);
960 strcat(buf, TEXT229);
961 /* " in < " */
962 strcat(buf, bp->b_bname);
963 strcat(buf, TEXT230);
964 /* "> at line " */
965 strcat(buf, long_asc(getlinenum(bp, lp)));
966 mlforce(buf);
967 }
968
969 /* Interactive debugger
970
971 if $debug == TRUE, The interactive debugger is invoked
972 commands are listed out with the ? key */
973
debug(bp,eline,skipflag)974 PASCAL NEAR debug(bp, eline, skipflag)
975
976 BUFFER *bp; /* buffer to execute */
977 char *eline; /* text of line to debug */
978 int *skipflag; /* are we skipping debugging? */
979
980 {
981 register int oldcmd; /* original command display flag */
982 register int oldinp; /* original connamd input flag */
983 register int oldstatus; /* status of last command */
984 register int c; /* temp character */
985 register KEYTAB *key; /* ptr to a key entry */
986 static char track[NSTRING] = "";/* expression to track value of */
987 char temp[NSTRING]; /* command or expression */
988
989 dbuild: /* Build the information line to be presented to the user */
990
991 strcpy(outline, "<<<");
992
993 /* display the tracked expression */
994 if (track[0] != 0) {
995 oldstatus = cmdstatus;
996 docmd(track);
997 cmdstatus = oldstatus;
998 strcat(outline, "[=");
999 strcat(outline, gtusr("track"));
1000 strcat(outline, "]");
1001 }
1002
1003 /* debug macro name */
1004 strcat(outline, bp->b_bname);
1005 strcat(outline, ":");
1006
1007 /* and lastly the line */
1008 strcat(outline, eline);
1009 strcat(outline, ">>>");
1010
1011 /* write out the debug line */
1012 dinput: outline[term.t_ncol - 1] = 0;
1013 mlforce(outline);
1014 update(TRUE);
1015
1016 /* and get the keystroke */
1017 c = get_key();
1018
1019 /* ignore the mouse here */
1020 if (c & MOUS)
1021 goto dinput;
1022
1023 /* META key turns off debugging */
1024 key = getbind(c);
1025 if (key && key->k_type == BINDFNC && key && key->k_ptr.fp == meta)
1026 macbug = FALSE;
1027
1028 else if (c == abortc) {
1029 return(FALSE);
1030
1031 } else switch (c) {
1032
1033 case '?': /* list commands */
1034 strcpy(outline, TEXT128);
1035 /*"(e)val exp, (c/x)ommand, (t)rack exp, (^G)abort, <SP>exec, <META> stop debug"*/
1036 goto dinput;
1037
1038 case 'c': /* execute statement */
1039 oldcmd = discmd;
1040 discmd = TRUE;
1041 oldinp = disinp;
1042 disinp = TRUE;
1043 execcmd(FALSE, 1);
1044 discmd = oldcmd;
1045 disinp = oldinp;
1046 goto dbuild;
1047
1048 case 'x': /* execute extended command */
1049 oldcmd = discmd;
1050 discmd = TRUE;
1051 oldinp = disinp;
1052 disinp = TRUE;
1053 oldstatus = cmdstatus;
1054 namedcmd(FALSE, 1);
1055 cmdstatus = oldstatus;
1056 discmd = oldcmd;
1057 disinp = oldinp;
1058 goto dbuild;
1059
1060 case 'e': /* evaluate expresion */
1061 strcpy(temp, "set %track ");
1062 oldinp = disinp;
1063 disinp = TRUE;
1064 mlwrite("Exp:");
1065 getstring(&temp[11], NSTRING, ctoec(RETCHAR));
1066 disinp = oldinp;
1067 oldstatus = cmdstatus;
1068 docmd(temp);
1069 cmdstatus = oldstatus;
1070 strcpy(temp, " = [");
1071 strcat(temp, gtusr("track"));
1072 strcat(temp, "]");
1073 mlforce(temp);
1074 c = get_key();
1075 goto dinput;
1076
1077 case 't': /* track expresion */
1078 oldinp = disinp;
1079 disinp = TRUE;
1080 mlwrite("Exp: ");
1081 getstring(temp, NSTRING, ctoec(RETCHAR));
1082 disinp = oldinp;
1083 strcpy(track, "set %track ");
1084 strcat(track, temp);
1085 goto dbuild;
1086
1087 case 's': /* execute a function */
1088 *skipflag = TRUE;
1089 macbug = FALSE;
1090 break;
1091
1092 case ' ': /* execute a statement */
1093 break;
1094
1095 default: /* illegal command */
1096 TTbeep();
1097 goto dbuild;
1098 }
1099 return(TRUE);
1100 }
1101
freewhile(wp)1102 VOID PASCAL NEAR freewhile(wp) /* free a list of while block pointers */
1103
1104 WHBLOCK *wp; /* head of structure to free */
1105
1106 {
1107 if (wp != NULL) {
1108 freewhile(wp->w_next);
1109 free((char *) wp);
1110 }
1111 }
1112
execfile(f,n)1113 PASCAL NEAR execfile(f, n) /* execute a series of commands in a file */
1114
1115 int f, n; /* default flag and numeric arg to pass on to file */
1116
1117 {
1118 register int status; /* return status of name query */
1119 char fname[NSTRING]; /* name of file to execute */
1120 char *fspec; /* full file spec */
1121
1122 #if WINDOW_MSWIN
1123 /* special case: we want filenamedlg to refrain from stuffing a
1124 full pathname so that flook() can be put to use a few lines
1125 down the road... */
1126 if ((status = filenamedlg(TEXT129, fname, NSTRING -1, FALSE)) != TRUE)
1127 #else
1128 if ((status = mlreply(TEXT129, fname, NSTRING -1)) != TRUE)
1129 #endif
1130 return(status);
1131
1132 /* look up the path for the file */
1133 fspec = flook(fname, TRUE);
1134
1135 /* if it isn't around */
1136 if (fspec == NULL) {
1137
1138 /* try to default the extension */
1139 if (sindex(fname, ".") == 0) {
1140 strcat(fname, ".cmd");
1141 fspec = flook(fname, TRUE);
1142 if (fspec != NULL)
1143 goto exec1;
1144 }
1145
1146 /* complain if we are interactive */
1147 if (clexec == FALSE)
1148 mlwrite(TEXT214, fname);
1149 /* "%%No such file as %s" */
1150 return(FALSE);
1151 }
1152
1153 exec1: /* otherwise, execute it */
1154 while (n-- > 0)
1155 if ((status=dofile(fspec)) != TRUE)
1156 return(status);
1157
1158 return(TRUE);
1159 }
1160
1161 /* dofile: yank a file into a buffer and execute it
1162 if there are no errors, delete the buffer on exit */
1163
dofile(fname)1164 PASCAL NEAR dofile(fname)
1165
1166 char *fname; /* file name to execute */
1167
1168 {
1169 register BUFFER *bp; /* buffer to place file to exeute */
1170 register BUFFER *cb; /* temp to hold current buf while we read */
1171 register int status; /* results of various calls */
1172 char bname[NBUFN]; /* name of buffer */
1173
1174 makename(bname, fname); /* derive the name of the buffer */
1175 unqname(bname); /* make sure we don't stomp things */
1176 if ((bp = bfind(bname, TRUE, 0)) == NULL) /* get the needed buffer */
1177 return(FALSE);
1178
1179 bp->b_mode = MDVIEW; /* mark the buffer as read only */
1180 cb = curbp; /* save the old buffer */
1181 curbp = bp; /* make this one current */
1182 /* and try to read in the file to execute */
1183 if ((status = readin(fname, FALSE)) != TRUE) {
1184 curbp = cb; /* restore the current buffer */
1185 return(status);
1186 }
1187
1188 /* go execute it! */
1189 curbp = cb; /* restore the current buffer */
1190 if ((status = dobuf(bp)) != TRUE)
1191 return(status);
1192
1193 /* if not displayed, remove the now unneeded buffer and exit */
1194 if (bp->b_nwnd == 0)
1195 zotbuf(bp);
1196 return(TRUE);
1197 }
1198