mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-30 17:10:51 -08:00
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.
This commit is contained in:
Colin Walters
parent
b44ec8e346
commit
abb13b09f4
1 changed files with 141 additions and 51 deletions
192
src/lread.c
192
src/lread.c
|
|
@ -133,6 +133,13 @@ Lisp_Object Vload_source_file_function;
|
|||
/* 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 @@ static int read_from_string_limit;
|
|||
/* 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 @@ static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object));
|
|||
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 <walters@gnu.org>, 22 May 2002 16:36:50 -0400 ]
|
||||
*/
|
||||
|
||||
#define READCHAR readchar (readcharfun)
|
||||
|
|
@ -216,6 +232,8 @@ readchar (readcharfun)
|
|||
Lisp_Object tem;
|
||||
register int c;
|
||||
|
||||
readchar_count++;
|
||||
|
||||
if (BUFFERP (readcharfun))
|
||||
{
|
||||
register struct buffer *inbuffer = XBUFFER (readcharfun);
|
||||
|
|
@ -335,6 +353,7 @@ unreadchar (readcharfun, c)
|
|||
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 @@ unreadchar (readcharfun, c)
|
|||
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 @@ readevalloop (readcharfun, stream, sourcename, evalfun, printflag, unibyte, read
|
|||
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 @@ STREAM or the value of `standard-input' may be:
|
|||
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 @@ START and END optionally delimit a substring of STRING from which to read;
|
|||
(string, start, end)
|
||||
Lisp_Object string, start, end;
|
||||
{
|
||||
int startval, endval;
|
||||
Lisp_Object tem;
|
||||
|
||||
CHECK_STRING (string);
|
||||
return Fcons (read_internal_start (string, start, end),
|
||||
make_number (read_from_string_index));
|
||||
}
|
||||
|
||||
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;
|
||||
/* 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;
|
||||
|
||||
tem = read0 (string);
|
||||
return Fcons (tem, make_number (read_from_string_index));
|
||||
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 @@ read_multibyte (c, readcharfun)
|
|||
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 @@ read1 (readcharfun, pch, first_in_list)
|
|||
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 @@ read1 (readcharfun, pch, first_in_list)
|
|||
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 @@ Order is reverse chronological. */);
|
|||
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).
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue