home *** CD-ROM | disk | FTP | other *** search
-
- /*
- * SCRIPTCMDS.C
- * (c) 1992-3 J.Harper
- */
-
- #include "jed.h"
- #include "jed_protos.h"
-
- Prototype VALUE * cmd_script (LONG, VALUE *);
- Prototype VALUE * cmd_nargs (LONG, VALUE *);
- Prototype VALUE * cmd_arg (LONG, VALUE *);
- Prototype VALUE * cmd_if (LONG, VALUE *);
- Prototype VALUE * cmd_while (LONG, VALUE *);
- Prototype VALUE * cmd_select (LONG, VALUE *);
- Prototype VALUE * cmd_dowhile (LONG, VALUE *);
- Prototype VALUE * cmd_return (LONG, VALUE *);
- Prototype VALUE * cmd_break (LONG, VALUE *);
- Prototype VALUE * cmd_addsym (LONG, VALUE *);
- Prototype VALUE * cmd_remsym (LONG, VALUE *);
- Prototype VALUE * cmd_renamesym (LONG, VALUE *);
- Prototype VALUE * cmd_export (LONG, VALUE *);
- Prototype VALUE * cmd_type (LONG, VALUE *);
- Prototype VALUE * cmd_plus (LONG, VALUE *);
- Prototype VALUE * cmd_minus (LONG, VALUE *);
- Prototype VALUE * cmd_product (LONG, VALUE *);
- Prototype VALUE * cmd_divide (LONG, VALUE *);
- Prototype VALUE * cmd_mod (LONG, VALUE *);
- Prototype VALUE * cmd_b_not (LONG, VALUE *);
- Prototype VALUE * cmd_l_not (LONG, VALUE *);
- Prototype VALUE * cmd_b_or (LONG, VALUE *);
- Prototype VALUE * cmd_l_or (LONG, VALUE *);
- Prototype VALUE * cmd_b_and (LONG, VALUE *);
- Prototype VALUE * cmd_l_and (LONG, VALUE *);
- Prototype VALUE * cmd_b_eor (LONG, VALUE *);
- Prototype VALUE * cmd_l_eor (LONG, VALUE *);
- Prototype VALUE * cmd_lshift (LONG, VALUE *);
- Prototype VALUE * cmd_rshift (LONG, VALUE *);
- Prototype VALUE * cmd_equals (LONG, VALUE *);
- Prototype VALUE * cmd_equality (LONG, VALUE *);
- Prototype VALUE * cmd_inequality (LONG, VALUE *);
- Prototype VALUE * cmd_gtthan (LONG, VALUE *);
- Prototype VALUE * cmd_ltthan (LONG, VALUE *);
- Prototype VALUE * cmd_gethan (LONG, VALUE *);
- Prototype VALUE * cmd_lethan (LONG, VALUE *);
- Prototype VALUE * cmd_nop (LONG, VALUE *);
-
- /*
- * (script `sectType')
- * (script `x' `file') - x stands for external (f is a section type)
- */
- VALUE *
- cmd_script(LONG argc, VALUE *argv)
- {
- if(TPLATE2(VTF_STRING, VTF_ANY))
- {
- if(*(ARG1.val_Value.String) == 'x')
- {
- if(ARG2.val_Type == VTF_STRING)
- {
- STRPTR file;
- if(!(file = squirrelfile(ARG2.val_Value.String)))
- {
- UBYTE othername[200];
- strcpy(othername, "s:jed/");
- AddPart(othername, ARG2.val_Value.String, 200);
- file = squirrelfile(othername);
- }
- if(file)
- {
- if(!execstr(file, &RES, FALSE, 0, NULL))
- {
- freestring(file);
- return(FALSE);
- }
- freestring(file);
- }
- else
- doserror();
- }
- else
- settitle("syntax error: argument 2 should be a string.");
- }
- else if(*(ARG1.val_Value.String) == 's')
- {
- if(ARG2.val_Type == VTF_STRING)
- {
- if(!execstr(ARG2.val_Value.String, &RES, FALSE, 0, NULL))
- return(FALSE);
- }
- else
- settitle("syntax error: argument 2 should be a string.");
- }
- else
- {
- POS temp = CurrVW->vw_CursorPos;
- POS endpos;
- if(getsection(ARG1.val_Value.String, &endpos))
- {
- POS startpos = CurrVW->vw_CursorPos;
- LONG length;
- STRPTR text;
- CurrVW->vw_CursorPos = temp;
- length = sectionlength(&startpos, &endpos);
- if(text = AllocVec(length + 1, 0L))
- {
- copysection(&startpos, &endpos, text);
- text[length] = 0;
- if(!execstr(text, &RES, FALSE, 0, NULL))
- {
- FreeVec(text);
- return(FALSE);
- }
- FreeVec(text);
- }
- else
- settitle(NoMemMsg);
- }
- }
- }
- return(&RES);
- }
-
- /*
- * returns the number of arguments passed to the innermost macro
- * (nargs)
- */
- VALUE *
- cmd_nargs(LONG argc, VALUE *argv)
- {
- LONG xargc;
- VALUE *xargv;
- if(findsargs(&xargc, &xargv))
- {
- setnumres(xargc);
- }
- return(&RES);
- }
-
- /*
- * returns an argument (prompts for it if it wasn't given)
- * (arg n `type' [`prompt'])
- *
- * type defines the type of value required -- `s' = string, `n' = number.
- * `e' = either
- * if an argument of the proper type can't be got then the macro is
- * aborted.
- */
- VALUE *
- cmd_arg(LONG argc, VALUE *argv)
- {
- VALUE *res = &RES;
- if(TPLATE2(VTF_NUMBER, VTF_STRING))
- {
- LONG xargc;
- VALUE *xargv;
- if(findsargs(&xargc, &xargv))
- {
- LONG argnum = ARG1.val_Value.Number;
- switch(*(ARG2.val_Value.String))
- {
- case 'e':
- dupvalue(&RES, &xargv[argnum]);
- break;
- case 's':
- STRPTR arg = NULL;
- if(xargv[argnum].val_Type == VTF_STRING)
- dupvalue(&RES, &xargv[argnum]);
- else
- {
- if(ARG3.val_Type == VTF_STRING)
- arg = docmdline(ARG3.val_Value.String);
- else
- arg = docmdline("string> ");
- if(argc)
- {
- setstrres(arg);
- }
- }
- break;
- case 'n':
- STRPTR str;
- if(xargv[argnum].val_Type == VTF_NUMBER)
- dupvalue(&RES, &xargv[argnum]);
- else
- {
- if(ARG3.val_Type == VTF_STRING)
- str = docmdline(ARG3.val_Value.String);
- else
- str = docmdline("number> ");
- if(str)
- {
- if(isdigit(*str) || (*str == '-'))
- {
- APTR dummy;
- setnumres(strtol(str, &dummy, 0));
- }
- freestring(str);
- }
- }
- break;
- }
- if(RES.val_Type == VTF_NONE)
- {
- settitlefmt("syntax error: no arg %ld provided", ARG1.val_Value.Number);
- res = FALSE;
- }
- }
- else
- {
- settitle("error: not in macro - can't use arg command");
- res = FALSE;
- }
- }
- else
- res = FALSE;
- return(res);
- }
-
- /*
- * (if condition-clause `true-clause' `false-clause')
- *
- * result is value of evaluated clause.
- */
- VALUE *
- cmd_if(LONG argc, VALUE *argv)
- {
- if(TPLATE3(VTF_NUMBER, VTF_ANY, VTF_ANY))
- {
- if(ARG1.val_Value.Number)
- {
- if(ARG2.val_Type == VTF_STRING)
- {
- if(!execstr(ARG2.val_Value.String, &RES, FALSE, 0, NULL))
- return(FALSE);
- }
- }
- else
- {
- if(ARG3.val_Type == VTF_STRING)
- {
- if(!execstr(ARG3.val_Value.String, &RES, FALSE, 0, NULL))
- return(FALSE);
- }
- }
- }
- return(&RES);
- }
-
- /*
- * (while `condition-clause' `true-clause')
- *
- * result is number of iterations before stopping.
- * loop will be broken after MAX_ITS number of iterations or a ^C break
- * signal is received.
- */
- #define MAX_ITS (1000000)
-
- VALUE *
- cmd_while(LONG argc, VALUE *argv)
- {
- if(TPLATE2(VTF_STRING, VTF_STRING))
- {
- LONG i;
- for(i = 0; i < MAX_ITS; i++)
- {
- VALUE value;
- if(!execstr(ARG1.val_Value.String, &value, FALSE, 0, NULL))
- {
- releasevalue(&value);
- return(FALSE);
- }
- if(!value.val_Value.Number)
- {
- releasevalue(&value);
- setnumres(i);
- return(&RES);
- }
- releasevalue(&value);
- if(!execstr(ARG2.val_Value.String, &value, FALSE, 0, NULL))
- {
- releasevalue(&value);
- return(FALSE);
- }
- releasevalue(&value);
- if(CheckSignal(SIGBREAKF_CTRL_C))
- {
- settitle("^C: while aborted");
- break;
- }
- }
- if(i == MAX_ITS)
- settitle("wow... a million iterations, while loop aborted");
- }
- return(FALSE);
- }
-
- /*
- * (select
- * (cond1)
- * `reaction1'
- * (cond2)
- * `reaction2'
- * ...
- * `default'
- * )
- */
- VALUE *
- cmd_select(LONG argc, VALUE *argv)
- {
- VALUE *res;
- WORD i;
- for(i = 0; i < argc; i += 2)
- {
- if((argv[i + 1].val_Type == VTF_NUMBER) && (argv[i + 2].val_Type == VTF_STRING))
- {
- if(argv[i + 1].val_Value.Number)
- return(execstr(argv[i + 2].val_Value.String, &RES, FALSE, 0, NULL));
- }
- else if(argv[i + 1].val_Type == VTF_STRING)
- return(execstr(argv[i + 1].val_Value.String, &RES, FALSE, 0, NULL));
- }
- return(&RES);
- }
-
- /*
- * (dowhile `command' `condition')
- *
- * similar to a C 'do...while' loop.
- */
- VALUE *
- cmd_dowhile(LONG argc, VALUE *argv)
- {
- if(TPLATE2(VTF_STRING, VTF_STRING))
- {
- LONG i;
- for(i = 0; i < MAX_ITS; i++)
- {
- VALUE value;
- if(!execstr(ARG1.val_Value.String, &value, FALSE, 0, NULL))
- {
- releasevalue(&value);
- return(FALSE);
- }
- releasevalue(&value);
- if(!execstr(ARG2.val_Value.String, &value, FALSE, 0, NULL))
- {
- releasevalue(&value);
- return(FALSE);
- }
- if(!value.val_Value.Number)
- {
- releasevalue(&value);
- setnumres(i);
- return(&RES);
- }
- if(CheckSignal(SIGBREAKF_CTRL_C))
- {
- settitle("^C: dowhile aborted");
- break;
- }
- }
- if(i == MAX_ITS)
- settitle("wow... a million iterations, dowhile loop aborted");
- }
- return(FALSE);
- }
-
- /*
- * breaks from the macro, returns ARG1
- */
- VALUE *
- cmd_return(LONG argc, VALUE *argv)
- {
- dupvalue(&RES, &ARG1);
- return(FALSE);
- }
-
- /*
- * (break n)
- * Breaks out of n depths of strings that are currently being executed.
- */
- VALUE *
- cmd_break(LONG argc, VALUE *argv)
- {
- RES.val_Type = VTF_BREAK;
- if(ARG1.val_Type == VTF_NUMBER)
- {
- if((RES.val_Value.Number = ARG1.val_Value.Number) <= 0)
- {
- RES.val_Type = VTF_NONE;
- return(&RES);
- }
- }
- else
- RES.val_Value.Number = 1;
- return(FALSE);
- }
-
- /*
- * (addsym {`sym-name' value symbol-type})
- *
- * symbol-type is,
- * 1 -- global command
- * 2 -- global variable
- * 3 -- local command
- * 4 -- local variable
- */
- VALUE *
- cmd_addsym(LONG argc, VALUE *argv)
- {
- VALUE *res = &RES;
- BOOL rc = TRUE;
- while(rc && (argc >= 3))
- {
- if(TPLATE3(VTF_STRING, VTF_ANY, VTF_NUMBER))
- {
- if(ARG3.val_Value.Number <= 2)
- {
- if(!addgsym(ARG1.val_Value.String, ARG3.val_Value.Number, &ARG2))
- rc = FALSE;
- }
- else
- {
- if(!addlsym(ARG1.val_Value.String, ARG3.val_Value.Number - 2, &ARG2))
- rc = FALSE;
- }
- if(!rc)
- settitlefmt("error: can't create variable %s", (LONG)ARG1.val_Value.String);
- }
- else
- goto abort;
- argc -= 3;
- argv += 3;
- }
- res->val_Type = VTF_NUMBER;
- res->val_Value.Number = rc;
- abort:
- return(res);
- }
-
- /*
- * (remsym {`sym-name'})
- *
- * note that if you want you can remove the primitive commands!
- */
- VALUE *
- cmd_remsym(LONG argc, VALUE *argv)
- {
- VALUE *res = &RES;
- BOOL rc = TRUE;
- while(rc && (argc >= 1))
- {
- if(TPLATE1(VTF_STRING))
- {
- if(!remsym(ARG1.val_Value.String))
- {
- settitlefmt("error: can't remove symbol %s", (LONG)ARG1.val_Value.String);
- rc = FALSE;
- }
- }
- else
- goto abort;
- argc--;
- argv++;
- }
- res->val_Type = VTF_NUMBER;
- res->val_Value.Number = rc;
- abort:
- return(res);
- }
-
- /*
- * (renamesym {`old-name' `new-name'})
- *
- * This can be used to rename primitive commands so that a macro can sit
- * on top of it.
- */
- VALUE *
- cmd_renamesym(LONG argc, VALUE *argv)
- {
- VALUE *res = &RES;
- BOOL rc = TRUE;
- while(rc && (argc >= 2))
- {
- if(TPLATE2(VTF_STRING, VTF_STRING))
- {
- GSYM *sym;
- if(sym = findgsym(ARG1.val_Value.String))
- {
- STRPTR newname;
- if(newname = savestring(ARG2.val_Value.String))
- {
- removehash(SymbolTab, &sym->gs_Node, GSYMTABSIZE);
- freestring(sym->gs_Node.h_Name);
- sym->gs_Node.h_Name = newname;
- inserthash(SymbolTab, &sym->gs_Node, GSYMTABSIZE);
- }
- else
- {
- settitle(NoMemMsg);
- rc = FALSE;
- }
- }
- else
- {
- settitlefmt("error: no symbol %s", (LONG)ARG1.val_Value.String);
- rc = FALSE;
- }
- }
- else
- goto abort;
- argc -= 2;
- argv += 2;
- }
- res->val_Type = VTF_NUMBER;
- res->val_Value.Number = rc;
- abort:
- return(res);
- }
-
- /*
- * (export {`lsym' how-far})
- *
- * moves lsym from its current depth to (current_depth - how_far)
- */
- VALUE *
- cmd_export(LONG argc, VALUE *argv)
- {
- VALUE *res = &RES;
- BOOL rc = TRUE;
- while(rc && (argc >= 2))
- {
- if(TPLATE2(VTF_STRING, VTF_NUMBER))
- {
- LSYM *ls = NULL;
- WORD i;
- for(i = CSDepth; !ls && i; i--)
- {
- for(ls = (LSYM *)CSList[i].cs_Locals.lh_Head; ls->ls_Node.ln_Succ; ls = (LSYM *)ls->ls_Node.ln_Succ)
- {
- if(!strcmp(ARG1.val_Value.String, ls->ls_Node.ln_Name))
- break;
- }
- }
- i -= ARG2.val_Value.Number;
- if(ls && (i > 0))
- {
- Remove(&ls->ls_Node);
- AddTail(&CSList[i].cs_Locals, &ls->ls_Node);
- }
- else
- {
- settitlefmt("error: no local symbol %s", (LONG)ARG1.val_Value.String);
- rc = FALSE;
- }
- }
- else
- goto abort;
- argc -= 2;
- argv += 2;
- }
- res->val_Type = VTF_NUMBER;
- res->val_Value.Number = rc;
- abort:
- return(res);
- }
-
- /*
- * (type <value>)
- */
- VALUE *
- cmd_type(LONG argc, VALUE *argv)
- {
- setnumres(ARG1.val_Type);
- return(&RES);
- }
-
- /*
- * some arithmetic commands
- */
-
- /* (+ 1 2) */
- VALUE *
- cmd_plus(LONG argc, VALUE *argv)
- {
- setnumres(ARG1.val_Value.Number + ARG2.val_Value.Number);
- return(&RES);
- }
-
- /* (- 1 [2]) */
- VALUE *
- cmd_minus(LONG argc, VALUE *argv)
- {
- if(argc == 1)
- setnumres(-(ARG1.val_Value.Number));
- else
- setnumres(ARG1.val_Value.Number - ARG2.val_Value.Number);
- return(&RES);
- }
-
- /* (* 1 2) */
- VALUE *
- cmd_product(LONG argc, VALUE *argv)
- {
- setnumres(ARG1.val_Value.Number * ARG2.val_Value.Number);
- return(&RES);
- }
-
- /* (/ 1 2) */
- VALUE *
- cmd_divide(LONG argv, VALUE *argv)
- {
- setnumres(ARG1.val_Value.Number / ARG2.val_Value.Number);
- return(&RES);
- }
-
- /* (% 1 2) */
- VALUE *
- cmd_mod(LONG argc, VALUE *argv)
- {
- setnumres(ARG1.val_Value.Number % ARG2.val_Value.Number);
- return(&RES);
- }
-
- /* (~ 1) */
- VALUE *
- cmd_b_not(LONG argc, VALUE *argv)
- {
- setnumres(~ARG1.val_Value.Number);
- return(&RES);
- }
-
- /* (! 1) */
- VALUE *
- cmd_l_not(LONG argc, VALUE *argv)
- {
- setnumres(!ARG1.val_Value.Number);
- return(&RES);
- }
-
- /* (| 1 2) */
- VALUE *
- cmd_b_or(LONG argc, VALUE *argv)
- {
- setnumres(ARG1.val_Value.Number | ARG2.val_Value.Number);
- return(&RES);
- }
-
- /* (|| 1 2) */
- VALUE *
- cmd_l_or(LONG argc, VALUE *argv)
- {
- setnumres(ARG1.val_Value.Number || ARG2.val_Value.Number);
- return(&RES);
- }
-
- /* (& 1 2) */
- VALUE *
- cmd_b_and(LONG argc, VALUE *argv)
- {
- setnumres(ARG1.val_Value.Number & ARG2.val_Value.Number);
- return(&RES);
- }
-
- /* (&& 1 2) */
- VALUE *
- cmd_l_and(LONG argc, VALUE *argv)
- {
- setnumres(ARG1.val_Value.Number && ARG2.val_Value.Number);
- return(&RES);
- }
-
- /* (^ 1 2) */
- VALUE *
- cmd_b_eor(LONG argc, VALUE *argv)
- {
- setnumres(ARG1.val_Value.Number ^ ARG2.val_Value.Number);
- return(&RES);
- }
-
- /* (^^ 1 2) */
- VALUE *
- cmd_l_eor(LONG argc, VALUE *argv)
- {
- if(ARG1.val_Value.Number)
- {
- if(ARG2.val_Value.Number)
- setnumres(FALSE);
- else
- setnumres(TRUE);
- }
- else
- setnumres(TRUE);
- return(&RES);
- }
-
- /* (<< 1 2) */
- VALUE *
- cmd_lshift(LONG argc, VALUE *argv)
- {
- setnumres(ARG1.val_Value.Number << ARG2.val_Value.Number);
- return(&RES);
- }
-
- /* (>> 1 2) */
- VALUE *
- cmd_rshift(LONG argc, VALUE *argv)
- {
- setnumres(ARG1.val_Value.Number >> ARG2.val_Value.Number);
- return(&RES);
- }
-
- /*
- * (= `varname' value)
- */
- VALUE *
- cmd_equals(LONG argc, VALUE *argv)
- {
- if(TPLATE2(VTF_STRING, VTF_ANY))
- {
- LSYM *lsym;
- GSYM *gsym;
- BOOL rc = TRUE;
- if(lsym = findlsym(ARG1.val_Value.String))
- {
- releasevalue(&lsym->ls_Sym.sym_Value);
- if(!dupvalue(&lsym->ls_Sym.sym_Value, &ARG2))
- rc = FALSE;
- }
- else if(gsym = findgsym(ARG1.val_Value.String))
- {
- releasevalue(&gsym->gs_Sym.sym_Value);
- if(!dupvalue(&gsym->gs_Sym.sym_Value, &ARG2))
- rc = FALSE;
- }
- else
- {
- if(!addlsym(ARG1.val_Value.String, STF_VARIABLE, &ARG2))
- rc = FALSE;
- }
- if(!rc)
- settitlefmt("error: can't set symbol %s", (LONG)ARG1.val_Value.String);
- setnumres(rc);
- }
- return(&RES);
- }
-
- /*
- * comparison operators
- */
-
- /*
- * (== `string1' `STRING2')
- * (== 1 2)
- */
- VALUE *
- cmd_equality(LONG argc, VALUE *argv)
- {
- if((ARG1.val_Type == VTF_STRING) && (ARG2.val_Type == VTF_STRING))
- setnumres(!stricmp(ARG1.val_Value.String, ARG2.val_Value.String));
- else if((ARG1.val_Type == VTF_NUMBER) && (ARG2.val_Type == VTF_NUMBER))
- setnumres(ARG1.val_Value.Number == ARG2.val_Value.Number);
- else
- settitle("syntax error: incorrect arguments to ==");
- return(&RES);
- }
-
- /*
- * (!= `string1' `STRING2')
- * (!= 1 2)
- */
- VALUE *
- cmd_inequality(LONG argc, VALUE *argv)
- {
- if((ARG1.val_Type == VTF_STRING) && (ARG2.val_Type == VTF_STRING))
- setnumres(stricmp(ARG1.val_Value.String, ARG2.val_Value.String));
- else if((ARG1.val_Type == VTF_NUMBER) && (ARG2.val_Type == VTF_NUMBER))
- setnumres(ARG1.val_Value.String != ARG2.val_Value.String);
- else
- settitle("syntax error: incorrect arguments to !=");
- return(&RES);
- }
-
- /* (> 1 2) */
- VALUE *
- cmd_gtthan(LONG argc, VALUE *argv)
- {
- setnumres(ARG1.val_Value.Number > ARG2.val_Value.Number);
- return(&RES);
- }
-
- /* (< 1 2) */
- VALUE *
- cmd_ltthan(LONG argc, VALUE *argv)
- {
- setnumres(ARG1.val_Value.Number < ARG2.val_Value.Number);
- return(&RES);
- }
-
- /* (>= 1 2) */
- VALUE *
- cmd_gethan(LONG argc, VALUE *argv)
- {
- setnumres(ARG1.val_Value.Number >= ARG2.val_Value.Number);
- return(&RES);
- }
-
- /* (<= 1 2) */
- VALUE *
- cmd_lethan(LONG argc, VALUE *argv)
- {
- setnumres(ARG1.val_Value.Number <= ARG2.val_Value.Number);
- return(&RES);
- }
-
- /*
- * (nop)
- */
- VALUE *
- cmd_nop(LONG argc, VALUE *argv)
- {
- setnumres(FALSE);
- return(&RES);
- }
-