/*

* parse.c logo parser module dvb

*

* Copyright (C) 1993 by the Regents of the University of California

*

* This program is free software; you can redistribute it and/or modify

* it under the terms of the GNU General Public License as published by

* the Free Software Foundation; either version 2 of the License, or

* (at your option) any later version.

*

* This program is distributed in the hope that it will be useful,

* but WITHOUT ANY WARRANTY; without even the implied warranty of

* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

* GNU General Public License for more details.

*

* You should have received a copy of the GNU General Public License

* along with this program; if not, write to the Free Software

* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

*

*/

#ifdef HAVE_WX

#ifdef WIN32

#define NEW_WIN32

#endif

#undef WIN32

#endif

#ifdef WIN32

#include <windows.h>

#endif

#include "logo.h"

#include "globals.h"

#ifdef HAVE_TERMIO_H

#ifdef HAVE_WX

#ifndef NEW_WIN32

#include <termios.h>

#endif

#else

#include <termio.h>

#endif

#else

#ifdef HAVE_SGTTY_H

#include <sgtty.h>

#endif

#endif

#include <ctype.h>

#ifdef ibm

#ifndef _MSC_VER

#include <bios.h>

extern int getch(void);

#endif /* _MSC_VER */

#endif

#ifdef __RZTC__

#include <disp.h>

#endif

# ifdef HAVE_WX

#ifdef getc

#undef getc

#endif

#define getc getFromWX_2

#define getch getFromWX

extern int check_wx_stop(int force_yield);

extern void wx_enable_scrolling();

extern void wx_refresh();

#endif

FILE *readstream;

FILE *writestream;

FILE *loadstream;

FILE *dribblestream = NULL;

int input_blocking = 0;

NODE *deepend_proc_name = NIL;

#if 0

char *cmdHistory[HIST_MAX] = {0};

char **hist_inptr, **hist_outptr;

#endif

int readingInstruction = 0;

int rd_getc(FILE *strm) {

int c;

#ifdef WIN32

MSG msg;

#endif

#ifndef WIN32 /* skip this section ... */

#ifdef __RZTC__

if (strm == stdin) zflush();

c = ztc_getc(strm);

#else

c = getc(strm);

#endif

if (strm == stdin && c != EOF) update_coords(c);

#ifndef mac

if (c == '\r') return rd_getc(strm);

#endif

#ifdef ibm

if (c == 17 && interactive && strm==stdin) { /* control-q */

to_pending = 0;

err_logo(STOP_ERROR,NIL);

if (input_blocking) {

#ifdef SIG_TAKES_ARG

logo_stop(0);

#else

logo_stop();

#endif

}

}

if (c == 23 && interactive && strm==stdin) { /* control-w */

#ifndef __RZTC__

getc(strm); /* eat up the return */

#endif

#ifdef SIG_TAKES_ARG

logo_pause(0);

#else

logo_pause();

#endif

return(rd_getc(strm));

}

#endif

#else /* WIN32 */

if (strm == stdin) {

if (winPasteText && !line_avail) winDoPaste();

if (!line_avail) {

win32_text_cursor();

while (GetMessage(&msg, NULL, 0, 0)) {

TranslateMessage(&msg);

DispatchMessage(&msg);

if (line_avail)

break;

}

}

c = read_line[read_index++];

if (c == 17 && interactive && strm==stdin) { /* control-q */

to_pending = 0;

err_logo(STOP_ERROR,NIL);

line_avail = 0;

free(read_line);

if (input_blocking) logo_stop(0);

return('\n');

}

if (c == 23 && interactive && strm==stdin) { /* control-w */

line_avail = 0;

free(read_line);

logo_pause(0);

return(rd_getc(strm));

}

if (c == '\n') {

line_avail = 0;

free(read_line);

}

}

else /* reading from a file */

c = getc(strm);

#endif /* WIN32 */

#ifdef ecma

return((c == EOF) ? c : ecma_clear(c));

#else

return(c);

#endif

}

void rd_print_prompt(char *str) {

#ifdef ibm

#if defined(__RZTC__) || defined(WIN32)

if (in_graphics_mode && !in_splitscreen)

#else

#ifndef _MSC_VER

if (in_graphics_mode && ibm_screen_top == 0)

#endif /* _MSC_VER */

#endif

lsplitscreen(NIL);

#endif

#ifdef HAVE_WX

if(in_graphics_mode && !in_splitscreen)

lsplitscreen(NIL);

#endif

#ifdef mac

extern int in_fscreen(void);

if (in_fscreen())

lsplitscreen(NIL);

#endif

ndprintf(stdout,"%t",str);

#if defined(__RZTC__) && !defined(WIN32) /* sowings */

zflush();

#endif

}

#if defined(__RZTC__) && !defined(WIN32) /* sowings */

void zrd_print_prompt(char *str) {

newline_bugfix();

rd_print_prompt(str);

}

#else

#define zrd_print_prompt rd_print_prompt

#endif

#define into_line(chr) {if (phys_line >= p_end) { \

p_len += MAX_PHYS_LINE; \

p_pos = phys_line - p_line; \

p_line = realloc(p_line, p_len); \

p_end = &p_line[p_len-1]; \

phys_line = &p_line[p_pos]; \

} \

*phys_line++ = (chr);}

char *p_line = 0, *p_end;

int p_len = MAX_PHYS_LINE;

char ender[100];

NODE *reader(FILE *strm, char *prompt) {

int c = 0, dribbling, vbar = 0, paren = 0;

int bracket = 0, brace = 0, p_pos, contin=1, insemi=0, raw=0;

char *phys_line, *lookfor = ender;

NODETYPES this_type = STRING;

NODE *ret;

char *old_stringptr = print_stringptr;

int old_stringlen = print_stringlen;

fix_turtle_shownness();

//readingInstruction = !strcmp(prompt, "? ");

readingInstruction = (strm == stdin);

#ifdef HAVE_WX

wx_refresh();

if(readingInstruction) {

wx_enable_scrolling();

}

#endif

print_stringptr = ender;

print_stringlen = 99;

ndprintf(NULL, "\n%p\n", theName(Name_end));

*print_stringptr = '\0';

print_stringptr = old_stringptr;

print_stringlen = old_stringlen;

if (!strcmp(prompt, "RW")) { /* called by readword */

prompt = "";

contin = 0;

}

if (!strcmp(prompt, "RAW")) { /* called by readrawline */

prompt = "";

contin = 0;

raw = 1;

}

charmode_off();

#ifdef WIN32

dribbling = 0;

#else

dribbling = (dribblestream != NULL && strm == stdin);

#endif

if (p_line == 0) {

p_line = malloc(MAX_PHYS_LINE);

if (p_line == NULL) {

err_logo(OUT_OF_MEM, NIL);

return UNBOUND;

}

p_end = &p_line[MAX_PHYS_LINE-1];

}

phys_line = p_line;

if (strm == stdin && *prompt) {

if (interactive) {

rd_print_prompt(prompt);

#ifdef WIN32

win32_update_text();

#endif

}

}

if (strm == stdin) {

input_blocking++;

erract_errtype = FATAL;

}

#ifndef TIOCSTI

if (!setjmp(iblk_buf)) {

#endif

c = rd_getc(strm);

/* if ((c=='\b' || c=='\127') && strm==stdin && interactive) {

silent_load(LogoLogo, logolib);

c = rd_getc(strm);

} */ /* 6.0 */

#ifdef mac

if (c == '\r') c = '\n'; /* seen in raw mode by keyp, never read */

#endif

while (c != EOF && (vbar || paren || bracket || brace || c != '\n')

&& NOT_THROWING) {

if (dribbling) rd_putc(c, dribblestream);

if (!raw && c == '\\' && (c = rd_getc(strm)) != EOF) {

if (dribbling) rd_putc(c, dribblestream);

c = setparity(c);

this_type = BACKSLASH_STRING;

if (c == setparity('\n') && strm == stdin) {

if (interactive) zrd_print_prompt("\\ ");

}

}

if (c != EOF) into_line(c);

if (raw) {

c = rd_getc(strm);

continue;

}

if (*prompt && (c&0137) == ((*lookfor)&0137)) {

lookfor++;

if (*lookfor == 0) {

if (deepend_proc_name != NIL)

err_logo(DEEPEND, deepend_proc_name);

else

err_logo(DEEPEND_NONAME, NIL);

break;

}

} else lookfor = ender;

if (c == '|' && !insemi) {

vbar = !vbar;

this_type = VBAR_STRING;

} else if (contin && !vbar && !insemi) {

if (c == '(') paren++;

else if (paren && c == ')') paren--;

else if (c == '[') bracket++;

else if (bracket && c == ']') bracket--;

else if (c == '{') brace++;

else if (brace && c == '}') brace--;

else if (c == ';') insemi++;

}

if (this_type == STRING && strchr(special_chars, c))

this_type = VBAR_STRING;

if (/* (vbar || paren ...) && */ c == '\n') {

insemi = 0;

if (strm == stdin) {

if (interactive) zrd_print_prompt(vbar ? "| " : "~ ");

}

}

while (!vbar && c == '~' && (c = rd_getc(strm)) != EOF) {

int gotspc = 0;

while (c == ' ' || c == '\t') {

gotspc = 1;

c = rd_getc(strm);

}

if (dribbling) rd_putc(c, dribblestream);

if (c != '\n' && gotspc) into_line(' ');

into_line(c);

if (c == '\n') {

insemi = 0;

if (interactive && strm == stdin) zrd_print_prompt("~ ");

}

else if (c == '(') paren++;

else if (paren && c == ')') paren--;

else if (c == '[') bracket++;

else if (bracket && c == ']') bracket--;

else if (c == '{') brace++;

else if (brace && c == '}') brace--;

else if (c == ';') insemi++;

}

if (c != EOF) c = rd_getc(strm);

}

#ifndef TIOCSTI

}

#endif

*phys_line = '\0';

input_blocking = 0;

#if defined(__RZTC__) && !defined(WIN32) /* sowings */

fix_cursor();

if (interactive && strm == stdin) newline_bugfix();

#endif

if (dribbling)

rd_putc('\n', dribblestream);

if (c == EOF && strm == stdin) {

if (interactive) clearerr(stdin);

rd_print_prompt("\n");

}

if (phys_line == p_line) return(Null_Word); /* so emptyp works */

ret = make_strnode(p_line, (struct string_block *)NULL, (int)strlen(p_line),

this_type, strnzcpy);

#if 0

if (strm == stdin && !strcmp(prompt, "? ")){

char *histline = malloc(1+strlen(p_line));

strcpy(histline, p_line);

*hist_inptr++ = histline;

if (hist_inptr >= &cmdHistory[HIST_MAX]) {

hist_inptr = cmdHistory;

}

if (*hist_inptr) {

free(*hist_inptr);

*hist_inptr = 0;

}

hist_outptr = hist_inptr;

}

#endif

//added (evan)

readingInstruction = 0;

return(ret);

}

NODE *list_to_array(NODE *list) {

NODE *np = list, *result;

FIXNUM len = 0, i;

for (; np; np = cdr(np)) len++;

result = make_array(len);

setarrorg(result,1);

for (i = 0, np = list; np; np = cdr(np))

(getarrptr(result))[i++] = car(np);

return(result);

}

#define parens(ch) (ch == '(' || ch == ')' || ch == ';')

#define infixs(ch) (ch == '*' || ch == '/' || ch == '+' || ch == '-' || ch == '=' || ch == '<' || ch == '>')

#define white_space(ch) (ch == ' ' || ch == '\t' || ch == '\n' || ch == '\0')

NODE *parser_iterate(char **inln, char *inlimit, struct string_block *inhead,

BOOLEAN semi, int endchar) {

char ch, *wptr = NULL;

static char terminate = '\0'; /* KLUDGE */

NODE *outline = NIL, *lastnode = NIL, *tnode = NIL;

int windex = 0, vbar = 0;

NODETYPES this_type = STRING;

BOOLEAN broken = FALSE;

do {

/* get the current character and increase pointer */

ch = **inln;

if (!vbar && windex == 0) wptr = *inln;

if (++(*inln) >= inlimit) *inln = &terminate;

/* skip through comments and line continuations */

while (!vbar && ((semi && ch == ';') ||

#ifdef WIN32

(ch == '~' && (**inln == 012 || **inln == 015)))) {

while (ch == '~' && (**inln == 012 || **inln == 015)) {

#else

(ch == '~' && **inln == '\n'))) {

while (ch == '~' && **inln == '\n') {

#endif

if (++(*inln) >= inlimit) *inln = &terminate;

ch = **inln;

if (windex == 0) wptr = *inln;

else {

if (**inln == ']' || **inln == '[' ||

**inln == '{' || **inln == '}') {

ch = ' ';

break;

} else {

broken = TRUE;

}

}

if (++(*inln) >= inlimit) *inln = &terminate;

}

if (semi && ch == ';') {

#ifdef WIN32

if (**inln != 012 && **inln != 015)

#else

if (**inln != '\n')

#endif

do {

ch = **inln;

if (windex == 0) wptr = *inln;

else broken = TRUE;

if (++(*inln) >= inlimit) *inln = &terminate;

}

#ifdef WIN32

while (ch != '\0' && ch != '~' && **inln != 012 && **inln != 015);

#else /* !Win32 */

while (ch != '\0' && ch != '~' && **inln != '\n');

#endif

if (ch != '\0' && ch != '~') ch = '\n';

}

}

/* flag that this word will be of BACKSLASH_STRING type */

if (getparity(ch)) this_type = BACKSLASH_STRING;

if (ch == '|') {

vbar = !vbar;

this_type = VBAR_STRING;

broken = TRUE; /* so we'll copy the chars */

}

else if (vbar || (!white_space(ch) && ch != ']' &&

ch != '{' && ch != '}' && ch != '['))

windex++;

if (vbar) continue;

else if (ch == endchar) break;

else if (ch == ']') err_logo(UNEXPECTED_BRACKET, NIL);

else if (ch == '}') err_logo(UNEXPECTED_BRACE, NIL);

/* if this is a '[', parse a new list */

else if (ch == '[') {

tnode = cons(parser_iterate(inln,inlimit,inhead,semi,']'), NIL);

if (**inln == '\0') ch = '\0';

}

else if (ch == '{') {

tnode = cons(list_to_array

(parser_iterate(inln,inlimit,inhead,semi,'}')), NIL);

if (**inln == '@') {

int i = 0, sign = 1;

(*inln)++;

if (**inln == '-') {

sign = -1;

(*inln)++;

}

while ((ch = **inln) >= '0' && ch <= '9') {

i = (i*10) + ch - '0';

(*inln)++;

}

setarrorg(car(tnode),sign*i);

}

if (**inln == '\0') ch = '\0';

}

/* if this character or the next one will terminate string, make the word */

else if (white_space(ch) || **inln == ']' || **inln == '[' ||

**inln == '{' || **inln == '}') {

if (windex > 0 || this_type == VBAR_STRING) {

if (broken == FALSE)

tnode = cons(make_strnode(wptr, inhead, windex,

this_type, strnzcpy),

NIL);

else {

tnode = cons(make_strnode(wptr,

(struct string_block *)NULL, windex,

this_type, (semi ? mend_strnzcpy : mend_nosemi)),

NIL);

broken = FALSE;

}

this_type = STRING;

windex = 0;

}

}

/* put the word onto the end of the return list */

if (tnode != NIL) {

if (outline == NIL) outline = tnode;

else setcdr(lastnode, tnode);

lastnode = tnode;

tnode = NIL;

}

} while (ch);

return(outline);

}

NODE *parser(NODE *nd, BOOLEAN semi) {

NODE *rtn;

int slen;

char *lnsav;

rtn = cnv_node_to_strnode(nd);

slen = getstrlen(rtn);

lnsav = getstrptr(rtn);

rtn = parser_iterate(&lnsav,lnsav + slen,getstrhead(rtn),semi,-1);

return(rtn);

}

NODE *lparse(NODE *args) {

NODE *arg, *val = UNBOUND;

arg = string_arg(args);

if (NOT_THROWING) {

val = parser(arg, FALSE);

}

return(val);

}

NODE *runparse_node(NODE *nd, NODE **ndsptr) {

NODE *outline = NIL, *tnode = NIL, *lastnode = NIL, *snd;

char *wptr, *tptr;

struct string_block *whead;

int wlen, wcnt, tcnt, isnumb, gotdot;

NODETYPES wtyp;

BOOLEAN monadic_minus = FALSE;

if (nd == Minus_Tight) return cons(nd, NIL);

snd = cnv_node_to_strnode(nd);

wptr = getstrptr(snd);

wlen = getstrlen(snd);

wtyp = nodetype(snd);

wcnt = 0;

whead = getstrhead(snd);

while (wcnt < wlen) {

if (*wptr == ';') {

*ndsptr = NIL;

break;

}

if (*wptr == '"') {

tcnt = 0;

tptr = ++wptr;

wcnt++;

while (wcnt < wlen && !parens(*wptr)) {

if (wtyp == BACKSLASH_STRING && getparity(*wptr))

wtyp = PUNBOUND; /* flag for "\( case */

wptr++, wcnt++, tcnt++;

}

if (wtyp == PUNBOUND) {

wtyp = BACKSLASH_STRING;

tnode = cons(make_quote(intern(make_strnode(tptr, NULL,

tcnt, wtyp, noparity_strnzcpy))), NIL);

} else

tnode = cons(make_quote(intern(make_strnode(tptr, whead, tcnt,

wtyp, strnzcpy))), NIL);

} else if (*wptr == ':') {

tcnt = 0;

tptr = ++wptr;

wcnt++;

while (wcnt < wlen && !parens(*wptr) && !infixs(*wptr))

wptr++, wcnt++, tcnt++;

tnode = cons(make_colon(intern(make_strnode(tptr, whead, tcnt,

wtyp, strnzcpy))), NIL);

} else if (wcnt == 0 && *wptr == '-' && monadic_minus == FALSE &&

wcnt+1 < wlen && !white_space(*(wptr+1))) {

/* minus sign with space before and no space after is unary */

tnode = cons(make_intnode((FIXNUM)0), NIL);

monadic_minus = TRUE;

} else if (parens(*wptr) || infixs(*wptr)) {

if (monadic_minus)

tnode = cons(Minus_Tight, NIL);

else if (wcnt+1 < wlen &&

((*wptr == '<' && (*(wptr+1) == '=' || *(wptr+1) == '>'))

|| (*wptr == '>' && *(wptr+1) == '='))) {

tnode = cons(intern(make_strnode(wptr, whead, 2,

STRING, strnzcpy)), NIL);

wptr++, wcnt++;

} else

tnode = cons(intern(make_strnode(wptr, whead, 1,

STRING, strnzcpy)), NIL);

monadic_minus = FALSE;

wptr++, wcnt++;

} else {

tcnt = 0;

tptr = wptr;

/* isnumb 4 means nothing yet;

* 0 means digits so far, 1 means just saw

* 'e' so minus can be next, 2 means no longer

* eligible even if an 'e' comes along */

isnumb = 4;

gotdot = 0;

if (*wptr == '?') {

isnumb = 3; /* turn ?5 to (? 5) */

wptr++, wcnt++, tcnt++;

}

while (wcnt < wlen && !parens(*wptr) &&

(!infixs(*wptr) || (isnumb == 1 && (*wptr == '-' || *wptr == '+')))) {

if (isnumb == 4 && isdigit(*wptr)) isnumb = 0;

if (isnumb == 0 && tcnt > 0 && (*wptr == 'e' || *wptr == 'E'))

isnumb = 1;

else if (!(isdigit(*wptr) || (!gotdot && *wptr == '.')) || isnumb == 1)

isnumb = 2;

if (*wptr == '.') gotdot++;

wptr++, wcnt++, tcnt++;

}

if (isnumb == 3 && tcnt > 1) { /* ?5 syntax */

NODE *qmtnode;

qmtnode = cons_list(0, Left_Paren, Query,

cnv_node_to_numnode

(make_strnode(tptr+1, whead,

tcnt-1, wtyp, strnzcpy)),

END_OF_LIST);

if (outline == NIL) {

outline = qmtnode;

} else {

setcdr(lastnode, qmtnode);

}

lastnode = cddr(qmtnode);

tnode = cons(Right_Paren, NIL);

} else if (isnumb < 2 && tcnt > 0) {

tnode = cons(cnv_node_to_numnode(make_strnode(tptr, whead, tcnt,

wtyp, strnzcpy)),

NIL);

} else

tnode = cons(intern(make_strnode(tptr, whead, tcnt,

wtyp, strnzcpy)),

NIL);

}

if (outline == NIL) outline = tnode;

else setcdr(lastnode, tnode);

lastnode = tnode;

}

return(outline);

}

NODE *runparse(NODE *ndlist) {

NODE *curnd = NIL, *outline = NIL, *tnode = NIL, *lastnode = NIL;

char *str;

if (nodetype(ndlist) == RUN_PARSE)

return parsed__runparse(ndlist);

if (!is_list(ndlist)) {

err_logo(BAD_DATA_UNREC, ndlist);

return(NIL);

}

if (ndlist != NIL && is_word(curnd=car(ndlist)) && getstrlen(curnd) >= 2 &&

(str=getstrptr(curnd)) && *str++ == '#' && *str == '!')

return NIL; /* shell-script #! treated as comment line */

while (ndlist != NIL) {

curnd = car(ndlist);

ndlist = cdr(ndlist);

if (!is_word(curnd))

tnode = cons(curnd, NIL);

else {

if (!numberp(curnd))

tnode = runparse_node(curnd, &ndlist);

else

tnode = cons(cnv_node_to_numnode(curnd), NIL);

}

if (tnode != NIL) {

if (outline == NIL) outline = tnode;

else setcdr(lastnode, tnode);

lastnode = tnode;

while (cdr(lastnode) != NIL) {

lastnode = cdr(lastnode);

if (check_throwing) break;

}

}

if (check_throwing) break;

}

return(outline);

}

NODE *lrunparse(NODE *args) {

NODE *arg;

arg = car(args);

while (nodetype(arg) == ARRAY && NOT_THROWING) {

setcar(args, err_logo(BAD_DATA, arg));

arg = car(args);

}

if (NOT_THROWING && !aggregate(arg))

arg = parser(arg, TRUE);

if (NOT_THROWING)

return runparse(arg);

return UNBOUND;

}