Mercurial > hg > xemacs-beta
diff src/lread.c @ 50:ee648375d8d6 r19-16b91
Import from CVS: tag r19-16b91
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:56:41 +0200 |
parents | 56c54cf7c5b6 |
children | 131b0175ea99 |
line wrap: on
line diff
--- a/src/lread.c Mon Aug 13 08:56:06 2007 +0200 +++ b/src/lread.c Mon Aug 13 08:56:41 2007 +0200 @@ -70,6 +70,13 @@ int puke_on_fsf_keys; +/* This symbol is also used in fns.c */ +#define FEATUREP_SYNTAX + +#ifdef FEATUREP_SYNTAX +static Lisp_Object Qfeaturep; +#endif + /* non-zero if inside `load' */ int load_in_progress; @@ -2265,6 +2272,26 @@ return Fsignal (Qinvalid_read_syntax, list1 (build_string ("Cannot read unreadable object"))); } +#ifdef FEATUREP_SYNTAX + case '+': + case '-': + { + Lisp_Object fexp, obj, tem; + struct gcpro gcpro1, gcpro2; + + fexp = read0(readcharfun); + obj = read0(readcharfun); + + /* the call to `featurep' may GC. */ + GCPRO2(fexp, obj); + tem = call1(Qfeaturep, fexp); + UNGCPRO; + + if (c == '+' && NILP(tem)) goto retry; + if (c == '-' && !NILP(tem)) goto retry; + return obj; + } +#endif default: { @@ -2479,10 +2506,12 @@ return (state); else unreadchar (readcharfun, ch); +#ifdef FEATUREP_SYNTAX if (ch == ']') syntax_error ("\"]\" in a list"); else if (ch == ')') syntax_error ("\")\" in a vector"); +#endif state = ((conser) (readcharfun, state, len)); } } @@ -2514,6 +2543,18 @@ free_cons (XCONS (tem)); tem = Qnil; ch = XCHAR (elt); +#ifdef FEATUREP_SYNTAX + if (ch == s->terminator) /* deal with #+, #- reader macros */ + { + unreadchar (readcharfun, s->terminator); + goto done; + } + else if (ch == ']') + syntax_error ("']' in a list"); + else if (ch == ')') + syntax_error ("')' in a vector"); + else +#endif if (ch != '.') signal_simple_error ("BUG! Internal reader error", elt); else if (!s->allow_dotted_lists) @@ -3021,6 +3062,11 @@ /* So that early-early stuff will work */ Ffset (Qload, intern ("load-internal")); +#ifdef FEATUREP_SYNTAX + Qfeaturep = intern("featurep"); + staticpro(&Qfeaturep); + Fprovide(intern("xemacs")); +#endif #ifdef LISP_BACKQUOTES old_backquote_flag = new_backquote_flag = 0; #endif