# HG changeset patch # User Colin Walters # Date 1022603095 0 # Node ID cf7f041fd98eb5731a6b2e0cde6a2e65b334cfa0 # Parent fca54e194e4244ddc5980707763b600e71aea01b lread.c (readchar_count): New variable. (readchar): Increment it. (unreadchar): Decrement it. (read_multibyte): Decrement it. (Vread_with_symbol_positions): New variable. (Vread_symbol_positions_list): New variable. (read_internal_start): New function, created from Fread and Fread_from_string. Handle Vread_symbol_positions_list and Vread_with_symbol_positions. (readevalloop, Fread, Fread_from_string): Use it. (read1): Use readchar_count to add symbol positions to Vread_symbol_positions_list if Vread_with_symbol_positions is non-nil. (syms_of_lread): DEFVAR_LISP and initialize them. diff -r fca54e194e42 -r cf7f041fd98e src/lread.c --- a/src/lread.c Tue May 28 09:08:53 2002 +0000 +++ b/src/lread.c Tue May 28 16:24:55 2002 +0000 @@ -133,6 +133,13 @@ /* 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,6 +157,9 @@ /* 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 #@. */ static char *saved_doc_string; @@ -202,8 +212,14 @@ 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. + 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 , 22 May 2002 16:36:50 -0400 ] */ #define READCHAR readchar (readcharfun) @@ -216,6 +232,8 @@ Lisp_Object tem; register int c; + readchar_count++; + if (BUFFERP (readcharfun)) { register struct buffer *inbuffer = XBUFFER (readcharfun); @@ -335,6 +353,7 @@ 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,10 +408,20 @@ 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 (); +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,7 +1339,7 @@ else if (! NILP (Vload_read_function)) val = call1 (Vload_read_function, readcharfun); else - val = read0 (readcharfun); + val = read_internal_start (readcharfun, Qnil, Qnil); } val = (*evalfun) (val); @@ -1432,23 +1461,15 @@ Lisp_Object stream; { extern Lisp_Object Fread_minibuffer (); - + Lisp_Object tem; 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); + return read_internal_start (stream, Qnil, Qnil); } DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0, @@ -1459,40 +1480,61 @@ (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; - + 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; - - tem = read0 (string); - return Fcons (tem, make_number (read_from_string_index)); + 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,10 +1574,16 @@ int len = 0; int bytes; + if (c < 0) + return c; + str[len++] = c; while ((c = READCHAR) >= 0xA0 && len < MAX_MULTIBYTE_LENGTH) - str[len++] = c; + { + str[len++] = c; + readchar_count--; + } UNREAD (c); if (UNIBYTE_STR_AS_MULTIBYTE_P (str, len, bytes)) return STRING_CHAR (str, len); @@ -2314,6 +2362,11 @@ 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,11 +2502,19 @@ return make_float (negative ? - value : value); } } - - if (uninterned_symbol) - return make_symbol (read_buffer); - else - return intern (read_buffer); + { + 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; + } } } } @@ -3633,6 +3694,35 @@ 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. Each element is a string (directory name) or nil (try default directory).