(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.

1 files changed, 78 insertions, 9 deletions

diff --git a/src/lread.c b/src/lread.c
index 57231df36e6..81670ebe048 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -68,6 +68,7 @@ extern int errno;
 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 @@ static int read_pure;
 /* 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 @@ STREAM or the value of `standard-input' may be:\n\
   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 @@ START and END optionally delimit a substring of STRING from which to read;\n\
   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 @@ read0 (readcharfun)
   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 @@ read_escape (readcharfun)
 
 /* 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 @@ read1 (readcharfun, pch)
           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 @@ read1 (readcharfun, pch)
             {
               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 @@ read1 (readcharfun, pch)
         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 @@ read1 (readcharfun, pch)
            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 @@ read_list (flag, readcharfun)
   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 @@ read_list (flag, readcharfun)
     {
       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 @@ read_list (flag, readcharfun)
                 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 @@ The default is nil, which means use the function `read'.");
   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);