[Emacs-diffs] Changes to emacs/src/lread.c

[Colin Walters]

Index: emacs/src/lread.c
diff -c emacs/src/lread.c:1.284 emacs/src/lread.c:1.285
*** emacs/src/lread.c:1.284     Mon May 20 04:06:11 2002
--- emacs/src/lread.c   Tue May 28 12:24:55 2002
***************
*** 133,138 ****
--- 133,145 ----
  /* List of all DEFVAR_BOOL variables.  Used by the byte optimizer.  */
  Lisp_Object Vbyte_boolean_vars;
  
+ /* Whether or not to add a `read-positions' property to symbols
+    read. */
+ Lisp_Object Vread_with_symbol_positions;
+ 
+ /* List of (SYMBOL . POSITION) accumulated so far. */
+ Lisp_Object Vread_symbol_positions_list;
+ 
  /* List of descriptors now open for Fload.  */
  static Lisp_Object load_descriptor_list;
  
***************
*** 150,155 ****
--- 157,165 ----
  /* Number of bytes left to read in the buffer character
     that `readchar' has already advanced over.  */
  static int readchar_backlog;
+ /* Number of characters read in the current call to Fread or
+    Fread_from_string. */
+ static int readchar_count;
  
  /* This contains the last string skipped with address@hidden  */
  static char *saved_doc_string;
***************
*** 202,209 ****
     Write READCHAR to read a character,
     UNREAD(c) to unread c to be read again.
  
!    These macros actually read/unread a byte code, multibyte characters
!    are not handled here.  The caller should manage them if necessary.
   */
  
  #define READCHAR readchar (readcharfun)
--- 212,225 ----
     Write READCHAR to read a character,
     UNREAD(c) to unread c to be read again.
  
!    The READCHAR and UNREAD macros are meant for reading/unreading a
!    byte code; they do not handle multibyte characters.  The caller
!    should manage them if necessary.
!    
!    [ Actually that seems to be a lie; READCHAR will definitely read
!      multibyte characters from buffer sources, at least.  Is the
!      comment just out of date?
!      -- Colin Walters <address@hidden>, 22 May 2002 16:36:50 -0400 ]
   */
  
  #define READCHAR readchar (readcharfun)
***************
*** 216,221 ****
--- 232,239 ----
    Lisp_Object tem;
    register int c;
  
+   readchar_count++;
+   
    if (BUFFERP (readcharfun))
      {
        register struct buffer *inbuffer = XBUFFER (readcharfun);
***************
*** 335,340 ****
--- 353,359 ----
       Lisp_Object readcharfun;
       int c;
  {
+   readchar_count--;
    if (c == -1)
      /* Don't back up the pointer if we're unreading the end-of-input mark,
         since readchar didn't advance it when we read it.  */
***************
*** 389,398 ****
      call1 (readcharfun, make_number (c));
  }
  
! static Lisp_Object read0 (), read1 (), read_list (), read_vector ();
! static int read_multibyte ();
! static Lisp_Object substitute_object_recurse ();
! static void        substitute_object_in_subtree (), substitute_in_interval ();
  
  
  /* Get a character from the tty.  */
--- 408,427 ----
      call1 (readcharfun, make_number (c));
  }
  
! static Lisp_Object read_internal_start P_ ((Lisp_Object, Lisp_Object,
!                                           Lisp_Object));
! static Lisp_Object read0 P_ ((Lisp_Object));
! static Lisp_Object read1 P_ ((Lisp_Object, int *, int)); 
! 
! static Lisp_Object read_list P_ ((int, Lisp_Object));
! static Lisp_Object read_vector P_ ((Lisp_Object, int));
! static int read_multibyte P_ ((int, Lisp_Object));
! 
! static Lisp_Object substitute_object_recurse P_ ((Lisp_Object, Lisp_Object,
!                                                 Lisp_Object));
! static void substitute_object_in_subtree P_ ((Lisp_Object,
!                                             Lisp_Object));
! static void substitute_in_interval P_ ((INTERVAL, Lisp_Object));
  
  
  /* Get a character from the tty.  */
***************
*** 1310,1316 ****
          else if (! NILP (Vload_read_function))
            val = call1 (Vload_read_function, readcharfun);
          else
!           val = read0 (readcharfun);
        }
  
        val = (*evalfun) (val);
--- 1339,1345 ----
          else if (! NILP (Vload_read_function))
            val = call1 (Vload_read_function, readcharfun);
          else
!           val = read_internal_start (readcharfun, Qnil, Qnil);
        }
  
        val = (*evalfun) (val);
***************
*** 1432,1454 ****
       Lisp_Object stream;
  {
    extern Lisp_Object Fread_minibuffer ();
! 
    if (NILP (stream))
      stream = Vstandard_input;
    if (EQ (stream, Qt))
      stream = Qread_char;
- 
-   readchar_backlog = -1;
-   new_backquote_flag = 0;
-   read_objects = Qnil;
- 
    if (EQ (stream, Qread_char))
      return Fread_minibuffer (build_string ("Lisp expression: "), Qnil);
  
!   if (STRINGP (stream))
!     return Fcar (Fread_from_string (stream, Qnil, Qnil));
! 
!   return read0 (stream);
  }
  
  DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0,
--- 1461,1475 ----
       Lisp_Object stream;
  {
    extern Lisp_Object Fread_minibuffer ();
!   Lisp_Object tem;
    if (NILP (stream))
      stream = Vstandard_input;
    if (EQ (stream, Qt))
      stream = Qread_char;
    if (EQ (stream, Qread_char))
      return Fread_minibuffer (build_string ("Lisp expression: "), Qnil);
  
!   return read_internal_start (stream, Qnil, Qnil);
  }
  
  DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0,
***************
*** 1459,1498 ****
       (string, start, end)
       Lisp_Object string, start, end;
  {
-   int startval, endval;
-   Lisp_Object tem;
- 
    CHECK_STRING (string);
  
!   if (NILP (end))
!     endval = XSTRING (string)->size;
!   else
!     {
!       CHECK_NUMBER (end);
!       endval = XINT (end);
!       if (endval < 0 || endval > XSTRING (string)->size)
!       args_out_of_range (string, end);
!     }
! 
!   if (NILP (start))
!     startval = 0;
!   else
!     {
!       CHECK_NUMBER (start);
!       startval = XINT (start);
!       if (startval < 0 || startval > endval)
!       args_out_of_range (string, start);
!     }
! 
!   read_from_string_index = startval;
!   read_from_string_index_byte = string_char_to_byte (string, startval);
!   read_from_string_limit = endval;
  
    new_backquote_flag = 0;
    read_objects = Qnil;
  
!   tem = read0 (string);
!   return Fcons (tem, make_number (read_from_string_index));
  }
  
  /* Use this for recursive reads, in contexts where internal tokens
--- 1480,1540 ----
       (string, start, end)
       Lisp_Object string, start, end;
  {
    CHECK_STRING (string);
+   return Fcons (read_internal_start (string, start, end),
+               make_number (read_from_string_index));
+ }
  
! /* Function to set up the global context we need in toplevel read
!    calls. */
! static Lisp_Object
! read_internal_start (stream, start, end)
!      Lisp_Object stream;
!      Lisp_Object start; /* Only used when stream is a string. */
!      Lisp_Object end; /* Only used when stream is a string. */
! {
!   Lisp_Object retval;
  
+   readchar_backlog = -1;
+   readchar_count = 0;
    new_backquote_flag = 0;
    read_objects = Qnil;
+   if (EQ (Vread_with_symbol_positions, Qt)
+       || EQ (Vread_with_symbol_positions, stream))
+     Vread_symbol_positions_list = Qnil;
+ 
+   if (STRINGP (stream))
+     {
+       int startval, endval;
+       if (NILP (end))
+       endval = XSTRING (stream)->size;
+       else
+       {
+         CHECK_NUMBER (end);
+         endval = XINT (end);
+         if (endval < 0 || endval > XSTRING (stream)->size)
+           args_out_of_range (stream, end);
+       }
  
!       if (NILP (start))
!       startval = 0;
!       else
!       {
!         CHECK_NUMBER (start);
!         startval = XINT (start);
!         if (startval < 0 || startval > endval)
!           args_out_of_range (stream, start);
!       }
!       read_from_string_index = startval;
!       read_from_string_index_byte = string_char_to_byte (stream, startval);
!       read_from_string_limit = endval;
!     }
!       
!   retval = read0 (stream);
!   if (EQ (Vread_with_symbol_positions, Qt)
!       || EQ (Vread_with_symbol_positions, stream))
!     Vread_symbol_positions_list = Fnreverse (Vread_symbol_positions_list);
!   return retval;
  }
  
  /* Use this for recursive reads, in contexts where internal tokens
***************
*** 1532,1541 ****
    int len = 0;
    int bytes;
  
    str[len++] = c;
    while ((c = READCHAR) >= 0xA0
         && len < MAX_MULTIBYTE_LENGTH)
!     str[len++] = c;
    UNREAD (c);
    if (UNIBYTE_STR_AS_MULTIBYTE_P (str, len, bytes))
      return STRING_CHAR (str, len);
--- 1574,1589 ----
    int len = 0;
    int bytes;
  
+   if (c < 0)
+     return c;
+ 
    str[len++] = c;
    while ((c = READCHAR) >= 0xA0
         && len < MAX_MULTIBYTE_LENGTH)
!     {
!       str[len++] = c;
!       readchar_count--;
!     }
    UNREAD (c);
    if (UNIBYTE_STR_AS_MULTIBYTE_P (str, len, bytes))
      return STRING_CHAR (str, len);
***************
*** 2314,2319 ****
--- 2362,2372 ----
             separate characters, treat them as separate characters now.  */
          ;
  
+       /* We want readchar_count to be the number of characters, not
+          bytes.  Hence we adjust for multibyte characters in the
+          string.  ... But it doesn't seem to be necessary, because
+          READCHAR *does* read multibyte characters from buffers. */
+       /* readchar_count -= (p - read_buffer) - nchars; */
        if (read_pure)
          return make_pure_string (read_buffer, nchars, p - read_buffer,
                                   is_multibyte);
***************
*** 2449,2459 ****
                return make_float (negative ? - value : value);
              }
          }
! 
!       if (uninterned_symbol)
!         return make_symbol (read_buffer);
!       else
!         return intern (read_buffer);
        }
      }
  }
--- 2502,2520 ----
                return make_float (negative ? - value : value);
              }
          }
!       {
!         Lisp_Object result = uninterned_symbol ? make_symbol (read_buffer)
!           : intern (read_buffer);
!         if (EQ (Vread_with_symbol_positions, Qt)
!             || EQ (Vread_with_symbol_positions, readcharfun))
!           Vread_symbol_positions_list = 
!             /* Kind of a hack; this will probably fail if characters
!                in the symbol name were escaped.  Not really a big
!                deal, though.  */
!             Fcons (Fcons (result, readchar_count - Flength (Fsymbol_name 
(result))),
!                    Vread_symbol_positions_list);
!         return result;
!       }
        }
      }
  }
***************
*** 3632,3637 ****
--- 3693,3727 ----
               doc: /* Stream for read to get input from.
  See documentation of `read' for possible values.  */);
    Vstandard_input = Qt;
+ 
+   DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions,
+              doc: /* If non-nil, add position of read symbols to 
`read-symbol-positions-list'.
+ 
+ If this variable is a buffer, then only forms read from that buffer
+ will be added to `read-symbol-positions-list'.
+ If this variable is t, then all read forms will be added.
+ The effect of all other values other than nil are not currently
+ defined, although they may be in the future.
+ 
+ The positions are relative to the last call to `read' or
+ `read-from-string'.  It is probably a bad idea to set this variable at
+ the toplevel; bind it instead. */);
+   Vread_with_symbol_positions = Qnil;
+ 
+   DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list,
+              doc: /* An list mapping read symbols to their positions.
+ This variable is modified during calls to `read' or
+ `read-from-string', but only when `read-with-symbol-positions' is
+ non-nil.
+ 
+ Each element of the list looks like (SYMBOL . CHAR-POSITION), where
+ CHAR-POSITION is an integer giving the offset of that occurence of the
+ symbol from the position where `read' or `read-from-string' started.
+ 
+ Note that a symbol will appear multiple times in this list, if it was
+ read multiple times.  The list is in the same order as the symbols
+ were read in. */);
+   Vread_symbol_positions_list = Qnil;  
  
    DEFVAR_LISP ("load-path", &Vload_path,
               doc: /* *List of directories to search for files to load.