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