/* Lisp parsing and input streams.
Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995,
1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
This file is part of GNU Emacs.
-GNU Emacs is free software; you can redistribute it and/or modify
+GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 3, or (at your option)
-any later version.
+the Free Software Foundation, either version 3 of the License, or
+(at your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
+along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include "coding.h"
#include "blockinput.h"
-#ifdef lint
-#include <sys/inode.h>
-#endif /* lint */
-
#ifdef MSDOS
#if __DJGPP__ < 2
#include <unistd.h> /* to get X_OK */
extern int errno;
#endif
+/* hash table read constants */
+Lisp_Object Qhash_table, Qdata;
+Lisp_Object Qtest, Qsize;
+Lisp_Object Qweakness;
+Lisp_Object Qrehash_size;
+Lisp_Object Qrehash_threshold;
+extern Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness;
+
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;
/* non-zero if inside `load' */
int load_in_progress;
+static Lisp_Object Qload_in_progress;
/* Directory in which the sources were found. */
Lisp_Object Vsource_directory;
/* Function to use for reading, in `load' and friends. */
Lisp_Object Vload_read_function;
+/* Non-nil means read recursive structures using #n= and #n# syntax. */
+Lisp_Object Vread_circle;
+
/* The association list of objects read with the #n=object form.
Each member of the list has the form (n . object), and is used to
look up the object for the corresponding #n# construct.
int load_dangerous_libraries;
+/* Non-zero means force printing messages when loading Lisp files. */
+
+int force_load_messages;
+
/* A regular expression used to detect files compiled with Emacs. */
static Lisp_Object Vbytecomp_version_regexp;
DEFUN ("read-char", Fread_char, Sread_char, 0, 3, 0,
doc: /* Read a character from the command input (keyboard or macro).
It is returned as a number.
+If the character has modifiers, they are resolved and reflected to the
+character code if possible (e.g. C-SPC -> 0).
+
If the user generates an event which is not a character (i.e. a mouse
click or function key event), `read-char' signals an error. As an
-exception, switch-frame events are put off until non-ASCII events can
-be read.
+exception, switch-frame events are put off until non-character events
+can be read.
If you want to read non-character events, or ignore them, call
`read-event' or `read-char-exclusive' instead.
(prompt, inherit_input_method, seconds)
Lisp_Object prompt, inherit_input_method, seconds;
{
+ Lisp_Object val;
+
if (! NILP (prompt))
message_with_string ("%s", prompt, 0);
- return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds);
+ val = read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds);
+
+ return (NILP (val) ? Qnil
+ : make_number (char_resolve_modifier_mask (XINT (val))));
}
DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0,
DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 3, 0,
doc: /* Read a character from the command input (keyboard or macro).
It is returned as a number. Non-character events are ignored.
+If the character has modifiers, they are resolved and reflected to the
+character code if possible (e.g. C-SPC -> 0).
If the optional argument PROMPT is non-nil, display that as a prompt.
If the optional argument INHERIT-INPUT-METHOD is non-nil and some
(prompt, inherit_input_method, seconds)
Lisp_Object prompt, inherit_input_method, seconds;
{
+ Lisp_Object val;
+
if (! NILP (prompt))
message_with_string ("%s", prompt, 0);
- return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method), seconds);
+
+ val = read_filtered_event (1, 1, 0, ! NILP (inherit_input_method), seconds);
+
+ return (NILP (val) ? Qnil
+ : make_number (char_resolve_modifier_mask (XINT (val))));
}
DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
If optional second arg NOERROR is non-nil,
report no error if FILE doesn't exist.
Print messages at start and end of loading unless
-optional third arg NOMESSAGE is non-nil.
+optional third arg NOMESSAGE is non-nil (but `force-load-messages'
+overrides that).
If optional fourth arg NOSUFFIX is non-nil, don't try adding
suffixes `.elc' or `.el' to the specified name FILE.
If optional fifth arg MUST-SUFFIX is non-nil, insist on
2000-09-21: It's not possible to just check for the file loaded
being a member of Vloads_in_progress. This fails because of the
way the byte compiler currently works; `provide's are not
- evaluted, see font-lock.el/jit-lock.el as an example. This
+ evaluated, see font-lock.el/jit-lock.el as an example. This
leads to a certain amount of ``normal'' recursion.
Also, just loading a file recursively is not always an error in
int count = 0;
Lisp_Object tem;
for (tem = Vloads_in_progress; CONSP (tem); tem = XCDR (tem))
- if (!NILP (Fequal (found, XCAR (tem))))
- count++;
- if (count > 3)
- {
- if (fd >= 0)
- emacs_close (fd);
- signal_error ("Recursive load", Fcons (found, Vloads_in_progress));
- }
+ if (!NILP (Fequal (found, XCAR (tem))) && (++count > 3))
+ {
+ if (fd >= 0)
+ emacs_close (fd);
+ signal_error ("Recursive load", Fcons (found, Vloads_in_progress));
+ }
record_unwind_protect (record_load_unwind, Vloads_in_progress);
Vloads_in_progress = Fcons (found, Vloads_in_progress);
}
error ("File `%s' was not compiled in Emacs",
SDATA (found));
}
- else if (!NILP (nomessage))
+ else if (!NILP (nomessage) && !force_load_messages)
message_with_string ("File `%s' not compiled in Emacs", found, 1);
}
newer = 1;
/* If we won't print another message, mention this anyway. */
- if (!NILP (nomessage))
+ if (!NILP (nomessage) && !force_load_messages)
{
Lisp_Object msg_file;
msg_file = Fsubstring (found, make_number (0), make_number (-1));
emacs_close (fd);
val = call4 (Vload_source_file_function, found, hist_file_name,
NILP (noerror) ? Qnil : Qt,
- NILP (nomessage) ? Qnil : Qt);
+ (NILP (nomessage) || force_load_messages) ? Qnil : Qt);
return unbind_to (count, val);
}
}
}
if (! NILP (Vpurify_flag))
- Vpreloaded_file_list = Fcons (file, Vpreloaded_file_list);
+ Vpreloaded_file_list = Fcons (Fpurecopy(file), Vpreloaded_file_list);
- if (NILP (nomessage))
+ if (NILP (nomessage) || force_load_messages)
{
if (!safe_p)
message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
specbind (Qinhibit_file_name_operation, Qnil);
load_descriptor_list
= Fcons (make_number (fileno (stream)), load_descriptor_list);
- load_in_progress++;
+ specbind (Qload_in_progress, Qt);
if (! version || version >= 22)
readevalloop (Qget_file_char, stream, hist_file_name,
Feval, 0, Qnil, Qnil, Qnil, Qnil);
unbind_to (count, Qnil);
/* Run any eval-after-load forms for this file */
- if (NILP (Vpurify_flag)
- && (!NILP (Ffboundp (Qdo_after_load_evaluation))))
+ if (!NILP (Ffboundp (Qdo_after_load_evaluation)))
call1 (Qdo_after_load_evaluation, hist_file_name) ;
UNGCPRO;
- if (saved_doc_string)
- free (saved_doc_string);
+ xfree (saved_doc_string);
saved_doc_string = 0;
saved_doc_string_size = 0;
- if (prev_saved_doc_string)
- xfree (prev_saved_doc_string);
+ xfree (prev_saved_doc_string);
prev_saved_doc_string = 0;
prev_saved_doc_string_size = 0;
- if (!noninteractive && NILP (nomessage))
+ if (!noninteractive && (NILP (nomessage) || force_load_messages))
{
if (!safe_p)
message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
message_with_string ("Loading %s...done", file, 1);
}
- if (!NILP (Fequal (build_string ("obsolete"),
- Ffile_name_nondirectory
- (Fdirectory_file_name (Ffile_name_directory (found))))))
- message_with_string ("Package %s is obsolete", file, 1);
-
return Qt;
}
fclose (stream);
UNBLOCK_INPUT;
}
- if (--load_in_progress < 0) load_in_progress = 0;
return Qnil;
}
register const unsigned char *s = SDATA (pathname);
return (IS_DIRECTORY_SEP (s[0])
|| (SCHARS (pathname) > 2
- && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2]))
-#ifdef ALTOS
- || *s == '@'
-#endif
-#ifdef VMS
- || index (s, ':')
-#endif /* VMS */
- );
+ && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2])));
}
DEFUN ("locate-file-internal", Flocate_file_internal, Slocate_file_internal, 2, 4, 0,
DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 5, "",
doc: /* Execute the current buffer as Lisp code.
-Programs can pass two arguments, BUFFER and PRINTFLAG.
+When called from a Lisp program (i.e., not interactively), this
+function accepts up to five optional arguments:
BUFFER is the buffer to evaluate (nil means use current buffer).
PRINTFLAG controls printing of output:
-A value of nil means discard it; anything else is stream for print.
-
-If the optional third argument FILENAME is non-nil,
-it specifies the file name to use for `load-history'.
-The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
-for this invocation.
-
-The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
-`print' and related functions should work normally even if PRINTFLAG is nil.
+ A value of nil means discard it; anything else is stream for print.
+FILENAME specifies the file name to use for `load-history'.
+UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
+ invocation.
+DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
+ functions should work normally even if PRINTFLAG is nil.
This function preserves the position of point. */)
(buffer, printflag, filename, unibyte, do_allow_print)
specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list));
specbind (Qstandard_output, tem);
record_unwind_protect (save_excursion_restore, save_excursion_save ());
- BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
+ BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
readevalloop (buf, 0, filename, Feval,
!NILP (printflag), unibyte, Qnil, Qnil, Qnil);
unbind_to (count, Qnil);
int stringp;
{
register int c = READCHAR;
- /* \u allows up to four hex digits, \U up to eight. Default to the
- behaviour for \u, and change this value in the case that \U is seen. */
+ /* \u allows up to four hex digits, \U up to eight. Default to the
+ behavior for \u, and change this value in the case that \U is seen. */
int unicode_hex_count = 4;
switch (c)
unicode_hex_count = 8;
case 'u':
- /* A Unicode escape. We only permit them in strings and characters,
+ /* A Unicode escape. We only permit them in strings and characters,
not arbitrarily in the source code, as in some other languages. */
{
- int i = 0;
+ unsigned int i = 0;
int count = 0;
while (++count <= unicode_hex_count)
break;
}
}
-
+ if (i > 0x10FFFF)
+ error ("Non-Unicode character: 0x%x", i);
return i;
}
int radix;
{
int ndigits = 0, invalid_p, c, sign = 0;
- EMACS_INT number = 0;
+ /* We use a floating point number because */
+ double number = 0;
if (radix < 2 || radix > 36)
invalid_p = 1;
invalid_syntax (buf, 0);
}
- return make_number (sign * number);
+ return make_fixnum_or_float (sign * number);
}
case '#':
c = READCHAR;
+ if (c == 's')
+ {
+ c = READCHAR;
+ if (c == '(')
+ {
+ /* Accept extended format for hashtables (extensible to
+ other types), e.g.
+ #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
+ Lisp_Object tmp = read_list (0, readcharfun);
+ Lisp_Object head = CAR_SAFE (tmp);
+ Lisp_Object data = Qnil;
+ Lisp_Object val = Qnil;
+ /* The size is 2 * number of allowed keywords to
+ make-hash-table. */
+ Lisp_Object params[10];
+ Lisp_Object ht;
+ Lisp_Object key = Qnil;
+ int param_count = 0;
+
+ if (!EQ (head, Qhash_table))
+ error ("Invalid extended read marker at head of #s list "
+ "(only hash-table allowed)");
+
+ tmp = CDR_SAFE (tmp);
+
+ /* This is repetitive but fast and simple. */
+ params[param_count] = QCsize;
+ params[param_count+1] = Fplist_get (tmp, Qsize);
+ if (!NILP (params[param_count+1]))
+ param_count+=2;
+
+ params[param_count] = QCtest;
+ params[param_count+1] = Fplist_get (tmp, Qtest);
+ if (!NILP (params[param_count+1]))
+ param_count+=2;
+
+ params[param_count] = QCweakness;
+ params[param_count+1] = Fplist_get (tmp, Qweakness);
+ if (!NILP (params[param_count+1]))
+ param_count+=2;
+
+ params[param_count] = QCrehash_size;
+ params[param_count+1] = Fplist_get (tmp, Qrehash_size);
+ if (!NILP (params[param_count+1]))
+ param_count+=2;
+
+ params[param_count] = QCrehash_threshold;
+ params[param_count+1] = Fplist_get (tmp, Qrehash_threshold);
+ if (!NILP (params[param_count+1]))
+ param_count+=2;
+
+ /* This is the hashtable data. */
+ data = Fplist_get (tmp, Qdata);
+
+ /* Now use params to make a new hashtable and fill it. */
+ ht = Fmake_hash_table (param_count, params);
+
+ while (CONSP (data))
+ {
+ key = XCAR (data);
+ data = XCDR (data);
+ if (!CONSP (data))
+ error ("Odd number of elements in hashtable data");
+ val = XCAR (data);
+ data = XCDR (data);
+ Fputhash (key, val, ht);
+ }
+
+ return ht;
+ }
+ }
if (c == '^')
{
c = READCHAR;
c = READCHAR;
}
/* #n=object returns object, but associates it with n for #n#. */
- if (c == '=')
+ if (c == '=' && !NILP (Vread_circle))
{
/* Make a placeholder for #n# to use temporarily */
Lisp_Object placeholder;
Lisp_Object cell;
- placeholder = Fcons(Qnil, Qnil);
+ placeholder = Fcons (Qnil, Qnil);
cell = Fcons (make_number (n), placeholder);
read_objects = Fcons (cell, read_objects);
return tem;
}
/* #n# returns a previously read object. */
- if (c == '#')
+ if (c == '#' && !NILP (Vread_circle))
{
tem = Fassq (make_number (n), read_objects);
if (CONSP (tem))
if (!quoted && !uninterned_symbol)
{
register char *p1;
- register Lisp_Object val;
p1 = read_buffer;
if (*p1 == '+' || *p1 == '-') p1++;
/* Is it an integer? */
{
if (p1[-1] == '.')
p1[-1] = '\0';
- /* Fixme: if we have strtol, use that, and check
- for overflow. */
- if (sizeof (int) == sizeof (EMACS_INT))
- XSETINT (val, atoi (read_buffer));
- else if (sizeof (long) == sizeof (EMACS_INT))
- XSETINT (val, atol (read_buffer));
- else
- abort ();
- return val;
+ {
+ /* EMACS_INT n = atol (read_buffer); */
+ char *endptr = NULL;
+ EMACS_INT n = (errno = 0,
+ strtol (read_buffer, &endptr, 10));
+ if (errno == ERANGE && endptr)
+ {
+ Lisp_Object args
+ = Fcons (make_string (read_buffer,
+ endptr - read_buffer),
+ Qnil);
+ xsignal (Qoverflow_error, args);
+ }
+ return make_fixnum_or_float (n);
+ }
}
}
if (isfloat_string (read_buffer))
}
}
{
- Lisp_Object name = make_specified_string (read_buffer, -1,
- p - read_buffer,
- multibyte);
- Lisp_Object result = (uninterned_symbol ? Fmake_symbol (name)
- : Fintern (name, Qnil));
+ Lisp_Object name, result;
+ EMACS_INT nbytes = p - read_buffer;
+ EMACS_INT nchars
+ = (multibyte ? multibyte_chars_in_text (read_buffer, nbytes)
+ : nbytes);
+
+ if (uninterned_symbol && ! NILP (Vpurify_flag))
+ name = make_pure_string (read_buffer, nchars, nbytes, multibyte);
+ else
+ name = make_specified_string (read_buffer, nchars, nbytes,multibyte);
+ result = (uninterned_symbol ? Fmake_symbol (name)
+ : Fintern (name, Qnil));
if (EQ (Vread_with_symbol_positions, Qt)
|| EQ (Vread_with_symbol_positions, readcharfun))
}
/* Feval doesn't get called from here, so no gc protection is needed. */
-#define SUBSTITUTE(get_val, set_val) \
-{ \
- Lisp_Object old_value = get_val; \
- Lisp_Object true_value \
- = substitute_object_recurse (object, placeholder,\
- old_value); \
- \
- if (!EQ (old_value, true_value)) \
- { \
- set_val; \
- } \
-}
+#define SUBSTITUTE(get_val, set_val) \
+ do { \
+ Lisp_Object old_value = get_val; \
+ Lisp_Object true_value \
+ = substitute_object_recurse (object, placeholder, \
+ old_value); \
+ \
+ if (!EQ (old_value, true_value)) \
+ { \
+ set_val; \
+ } \
+ } while (0)
static Lisp_Object
substitute_object_recurse (object, placeholder, subtree)
{
case Lisp_Vectorlike:
{
- int i;
- int length = XINT (Flength(subtree));
+ int i, length = 0;
+ if (BOOL_VECTOR_P (subtree))
+ return subtree; /* No sub-objects anyway. */
+ else if (CHAR_TABLE_P (subtree) || SUB_CHAR_TABLE_P (subtree)
+ || COMPILEDP (subtree))
+ length = ASIZE (subtree) & PSEUDOVECTOR_SIZE_MASK;
+ else if (VECTORP (subtree))
+ length = ASIZE (subtree);
+ else
+ /* An unknown pseudovector may contain non-Lisp fields, so we
+ can't just blindly traverse all its fields. We used to call
+ `Flength' which signaled `sequencep', so I just preserved this
+ behavior. */
+ wrong_type_argument (Qsequencep, subtree);
+
for (i = 0; i < length; i++)
- {
- Lisp_Object idx = make_number (i);
- SUBSTITUTE (Faref (subtree, idx),
- Faset (subtree, idx, true_value));
- }
+ SUBSTITUTE (AREF (subtree, i),
+ ASET (subtree, i, true_value));
return subtree;
}
case Lisp_Cons:
{
- SUBSTITUTE (Fcar_safe (subtree),
- Fsetcar (subtree, true_value));
- SUBSTITUTE (Fcdr_safe (subtree),
- Fsetcdr (subtree, true_value));
+ SUBSTITUTE (XCAR (subtree),
+ XSETCAR (subtree, true_value));
+ SUBSTITUTE (XCDR (subtree),
+ XSETCDR (subtree, true_value));
return subtree;
}
Lisp_Object object = Fcar (arg);
Lisp_Object placeholder = Fcdr (arg);
- SUBSTITUTE(interval->plist, interval->plist = true_value);
+ SUBSTITUTE (interval->plist, interval->plist = true_value);
}
\f
}
/* This is sometimes needed in the middle of GC. */
obsize &= ~ARRAY_MARK_FLAG;
- /* Combining next two lines breaks VMS C 2.3. */
- hash = hash_string (ptr, size_byte);
- hash %= obsize;
+ hash = hash_string (ptr, size_byte) % obsize;
bucket = XVECTOR (obarray)->contents[hash];
oblookup_last_bucket_number = hash;
if (EQ (bucket, make_number (0)))
}
#endif
-#if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON))))
+#if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
/* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
almost never correct, thereby causing a warning to be printed out that
confuses users. Since PATH_LOADSEARCH is always overridden by the
- EMACSLOADPATH environment variable below, disable the warning on NT.
- Also, when using the "self-contained" option for Carbon Emacs for MacOSX,
- the "standard" paths may not exist and would be overridden by
- EMACSLOADPATH as on NT. Since this depends on how the executable
- was build and packaged, turn off the warnings in general */
+ EMACSLOADPATH environment variable below, disable the warning on NT. */
/* Warn if dirs in the *standard* path don't exist. */
if (!turn_off_warning)
}
}
}
-#endif /* !(WINDOWSNT || HAVE_CARBON) */
+#endif /* !(WINDOWSNT || HAVE_NS) */
/* If the EMACSLOADPATH environment variable is set, use its value.
This doesn't apply if we're dumping. */
were read in. */);
Vread_symbol_positions_list = Qnil;
+ DEFVAR_LISP ("read-circle", &Vread_circle,
+ doc: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
+ Vread_circle = Qt;
+
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).
DEFVAR_BOOL ("load-in-progress", &load_in_progress,
doc: /* Non-nil if inside of `load'. */);
+ Qload_in_progress = intern ("load-in-progress");
+ staticpro (&Qload_in_progress);
DEFVAR_LISP ("after-load-alist", &Vafter_load_alist,
doc: /* An alist of expressions to be evalled when particular files are loaded.
them. */);
load_dangerous_libraries = 0;
+ DEFVAR_BOOL ("force-load-messages", &force_load_messages,
+ doc: /* Non-nil means force printing messages when loading Lisp files.
+This overrides the value of the NOMESSAGE argument to `load'. */);
+ force_load_messages = 0;
+
DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp,
doc: /* Regular expression matching safe to load compiled Lisp files.
When Emacs loads a compiled Lisp file, it reads the first 512 bytes
Vloads_in_progress = Qnil;
staticpro (&Vloads_in_progress);
+
+ Qhash_table = intern ("hash-table");
+ staticpro (&Qhash_table);
+ Qdata = intern ("data");
+ staticpro (&Qdata);
+ Qtest = intern ("test");
+ staticpro (&Qtest);
+ Qsize = intern ("size");
+ staticpro (&Qsize);
+ Qweakness = intern ("weakness");
+ staticpro (&Qweakness);
+ Qrehash_size = intern ("rehash-size");
+ staticpro (&Qrehash_size);
+ Qrehash_threshold = intern ("rehash-threshold");
+ staticpro (&Qrehash_threshold);
}
/* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d