changeset 11683:355d0b23a080

(read1): New arg FIRST_IN_LIST; all callers changed. Special handling for backquote and comma. (Qbackquote, Qcomma, Qcomma_at, Qcomma_dot): New variables. (syms_of_lread): Initialize and staticpro them. (Fread, Fread_from_string): Initialize new_backquote_flag.

--- a/src/lread.c	Thu May 04 16:27:01 1995 +0000
+++ b/src/lread.c	Thu May 04 17:13:20 1995 +0000
@@ -68,6 +68,7 @@
 Lisp_Object Qread_char, Qget_file_char, Qstandard_input, Qcurrent_load_list;
 Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input, Vafter_load_alist;
 Lisp_Object Qascii_character, Qload, Qload_file_name;
+Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot;
 
 extern Lisp_Object Qevent_symbol_element_mask;
 
@@ -102,6 +103,12 @@
 /* For use within read-from-string (this reader is non-reentrant!!) */
 static int read_from_string_index;
 static int read_from_string_limit;
+
+/* Nonzero means inside a new-style backquote
+   with no surrounding parentheses.
+   Fread initializes this to zero, so we need not specbind it
+   or worry about what happens to it when there is an error.  */
+static int new_backquote_flag;
 
 /* Handle unreading and rereading of characters.
    Write READCHAR to read a character,
@@ -892,6 +899,8 @@
   if (EQ (readcharfun, Qt))
     readcharfun = Qread_char;
 
+  new_backquote_flag = 0;
+
 #ifndef standalone
   if (EQ (readcharfun, Qread_char))
     return Fread_minibuffer (build_string ("Lisp expression: "), Qnil);
@@ -937,6 +946,8 @@
   read_from_string_index = startval;
   read_from_string_limit = endval;
 
+  new_backquote_flag = 0;
+
   tem = read0 (string);
   return Fcons (tem, make_number (read_from_string_index));
 }
@@ -950,7 +961,7 @@
   register Lisp_Object val;
   char c;
 
-  val = read1 (readcharfun, &c);
+  val = read1 (readcharfun, &c, 0);
   if (c)
     Fsignal (Qinvalid_read_syntax, Fcons (make_string (&c, 1), Qnil));
 
@@ -1117,11 +1128,15 @@
 
 /* If the next token is ')' or ']' or '.', we store that character
    in *PCH and the return value is not interesting.  Else, we store
-   zero in *PCH and we read and return one lisp object.  */
+   zero in *PCH and we read and return one lisp object.
+
+   FIRST_IN_LIST is nonzero if this is the first element of a list.  */
+
 static Lisp_Object
-read1 (readcharfun, pch)
+read1 (readcharfun, pch, first_in_list)
      register Lisp_Object readcharfun;
      char *pch;
+     int first_in_list;
 {
   register int c;
   *pch = 0;
@@ -1165,7 +1180,7 @@
 	  char ch;
 
 	  /* Read the string itself.  */
-	  tmp = read1 (readcharfun, &ch);
+	  tmp = read1 (readcharfun, &ch, 0);
 	  if (ch != 0 || !STRINGP (tmp))
 	    Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil));
 	  GCPRO1 (tmp);
@@ -1174,13 +1189,13 @@
 	    {
 	      Lisp_Object beg, end, plist;
 
-	      beg = read1 (readcharfun, &ch);
+	      beg = read1 (readcharfun, &ch, 0);
 	      if (ch == ')')
 		break;
 	      if (ch == 0)
-		end = read1 (readcharfun, &ch);
+		end = read1 (readcharfun, &ch, 0);
 	      if (ch == 0)
-		plist = read1 (readcharfun, &ch);
+		plist = read1 (readcharfun, &ch, 0);
 	      if (ch)
 		Fsignal (Qinvalid_read_syntax,
 			 Fcons (build_string ("invalid string property list"),
@@ -1228,6 +1243,45 @@
 	return Fcons (Qquote, Fcons (read0 (readcharfun), Qnil));
       }
 
+    case '`':
+      if (first_in_list)
+	goto default_label;
+      else
+	{
+	  Lisp_Object value;
+
+	  new_backquote_flag = 1;
+	  value = read0 (readcharfun);
+	  new_backquote_flag = 0;
+
+	  return Fcons (Qbackquote, Fcons (value, Qnil));
+	}
+
+    case ',':
+      if (new_backquote_flag)
+	{
+	  Lisp_Object comma_type = Qnil;
+	  Lisp_Object value;
+	  int ch = READCHAR;
+
+	  if (ch == '@')
+	    comma_type = Qcomma_at;
+	  else if (ch == '.')
+	    comma_type = Qcomma_dot;
+	  else
+	    {
+	      if (ch >= 0) UNREAD (ch);
+	      comma_type = Qcomma;
+	    }
+
+	  new_backquote_flag = 0;
+	  value = read0 (readcharfun);
+	  new_backquote_flag = 1;
+	  return Fcons (comma_type, Fcons (value, Qnil));
+	}
+      else
+	goto default_label;
+
     case '?':
       {
 	register Lisp_Object val;
@@ -1319,6 +1373,7 @@
 	   try to UNREAD two characters in a row.  */
       }
     default:
+    default_label:
       if (c <= 040) goto retry;
       {
 	register char *p = read_buffer;
@@ -1506,6 +1561,9 @@
   struct gcpro gcpro1, gcpro2;
   int cancel = 0;
 
+  /* Initialize this to 1 if we are reading a list.  */
+  int first_in_list = flag <= 0;
+
   val = Qnil;
   tail = Qnil;
 
@@ -1513,9 +1571,11 @@
     {
       char ch;
       GCPRO2 (val, tail);
-      elt = read1 (readcharfun, &ch);
+      elt = read1 (readcharfun, &ch, first_in_list);
       UNGCPRO;
 
+      first_in_list = 0;
+
 	/* If purifying, and the list starts with #$,
 	   return 0 instead.  This is a doc string reference
 	   and it will be replaced anyway by Snarf-documentation,
@@ -1541,7 +1601,7 @@
 		XCONS (tail)->cdr = read0 (readcharfun);
 	      else
 		val = read0 (readcharfun);
-	      read1 (readcharfun, &ch);
+	      read1 (readcharfun, &ch, 0);
 	      UNGCPRO;
 	      if (ch == ')')
 		return (cancel ? make_number (0) : val);
@@ -2191,6 +2251,15 @@
   Qget_file_char = intern ("get-file-char");
   staticpro (&Qget_file_char);
 
+  Qbackquote = intern ("`");
+  staticpro (&Qbackquote);
+  Qcomma = intern (",");
+  staticpro (&Qcomma);
+  Qcomma_at = intern (",@");
+  staticpro (&Qcomma_at);
+  Qcomma_dot = intern (",.");
+  staticpro (&Qcomma_dot);
+
   Qascii_character = intern ("ascii-character");
   staticpro (&Qascii_character);