Mercurial > hg > xemacs-beta
diff src/lread.c @ 140:585fb297b004 r20-2b4
Import from CVS: tag r20-2b4
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:32:43 +0200 |
parents | 7d55a9ba150c |
children | 1856695b1fa9 |
line wrap: on
line diff
--- a/src/lread.c Mon Aug 13 09:31:48 2007 +0200 +++ b/src/lread.c Mon Aug 13 09:32:43 2007 +0200 @@ -73,6 +73,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; @@ -2369,7 +2376,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: { unreadchar (readcharfun, c); @@ -2583,10 +2609,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)); } } @@ -2618,6 +2646,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) @@ -3130,6 +3170,12 @@ /* 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