/* 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 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 <sys/stat.h>
#include <sys/file.h>
#include <errno.h>
+#include <setjmp.h>
#include "lisp.h"
#include "intervals.h"
#include "buffer.h"
#include <epaths.h>
#include "commands.h"
#include "keyboard.h"
+#include "frame.h"
#include "termhooks.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 */
These macros correctly read/unread multibyte characters. */
-#define READCHAR readchar (readcharfun)
+#define READCHAR readchar (readcharfun, NULL)
#define UNREAD(c) unreadchar (readcharfun, c)
+/* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
+#define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
+
/* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
Qlambda, or a cons, we use this to keep an unread character because
a file stream can't handle multibyte-char unreading. The value -1
static int unread_char;
static int
-readchar (readcharfun)
+readchar (readcharfun, multibyte)
Lisp_Object readcharfun;
+ int *multibyte;
{
Lisp_Object tem;
register int c;
int i, len;
int emacs_mule_encoding = 0;
+ if (multibyte)
+ *multibyte = 0;
+
readchar_count++;
if (BUFFERP (readcharfun))
unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte);
BUF_INC_POS (inbuffer, pt_byte);
c = STRING_CHAR (p, pt_byte - orig_pt_byte);
+ if (multibyte)
+ *multibyte = 1;
}
else
{
unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos);
BUF_INC_POS (inbuffer, bytepos);
c = STRING_CHAR (p, bytepos - orig_bytepos);
+ if (multibyte)
+ *multibyte = 1;
}
else
{
{
if (read_from_string_index >= read_from_string_limit)
c = -1;
+ else if (STRING_MULTIBYTE (readcharfun))
+ {
+ if (multibyte)
+ *multibyte = 1;
+ FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, readcharfun,
+ read_from_string_index,
+ read_from_string_index_byte);
+ }
else
- FETCH_STRING_CHAR_ADVANCE (c, readcharfun,
- read_from_string_index,
- read_from_string_index_byte);
-
+ {
+ c = SREF (readcharfun, read_from_string_index_byte);
+ read_from_string_index++;
+ read_from_string_index_byte++;
+ }
return c;
}
return c;
}
c = (*readbyte) (-1, readcharfun);
- if (c < 0 || ASCII_BYTE_P (c) || load_each_byte)
+ if (c < 0 || load_each_byte)
+ return c;
+ if (multibyte)
+ *multibyte = 1;
+ if (ASCII_BYTE_P (c))
return c;
if (emacs_mule_encoding)
return read_emacs_mule_char (c, readbyte, readcharfun);
\f
/* Get a character from the tty. */
-extern Lisp_Object read_char ();
-
/* Read input events until we get one that's acceptable for our purposes.
If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
EMACS_ADD_TIME (end_time, end_time, wait_time);
}
- /* Read until we get an acceptable event. */
+/* Read until we get an acceptable event. */
retry:
- val = read_char (0, 0, 0, (input_method ? Qnil : Qt), 0,
- NUMBERP (seconds) ? &end_time : NULL);
+ do
+ val = read_char (0, 0, 0, (input_method ? Qnil : Qt), 0,
+ NUMBERP (seconds) ? &end_time : NULL);
+ while (INTEGERP (val) && XINT (val) == -2); /* wrong_kboard_jmpbuf */
if (BUFFERP (val))
goto retry;
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;
+ int c;
+
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);
+ c = XINT (val);
+ return make_number (char_resolve_modifier_mask (c));
}
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;
+ int c;
+
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);
+ c = XINT (val);
+ return make_number (char_resolve_modifier_mask (c));
}
DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
\f
/* Value is a version number of byte compiled code if the file
- asswociated with file descriptor FD is a compiled Lisp file that's
+ associated with file descriptor FD is a compiled Lisp file that's
safe to load. Only files compiled with Emacs are safe to load.
Files compiled with XEmacs can lead to a crash in Fbyte_code
because of an incompatible change in the byte compiler. */
if (!NILP (Vold_style_backquotes))
{
Lisp_Object args[2];
- args[0] = build_string ("!! File %s uses old-style backquotes !!");
+ args[0] = build_string ("Loading `%s': old-style backquotes detected!");
args[1] = file;
Fmessage (2, args);
}
doc: /* Execute a file of Lisp code named FILE.
First try FILE with `.elc' appended, then try with `.el',
then try FILE unmodified (the exact suffixes in the exact order are
-determined by `load-suffixes'). Environment variable references in
+determined by `load-suffixes'). Environment variable references in
FILE are replaced with their values by calling `substitute-in-file-name'.
This function searches the directories in `load-path'.
version = -1;
- /* Check fore the presence of old-style quotes and warn about them. */
+ /* Check for the presence of old-style quotes and warn about them. */
specbind (Qold_style_backquotes, Qnil);
record_unwind_protect (load_warn_old_style_backquotes, file);
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;
{
#ifndef WINDOWSNT
Lisp_Object tail;
- for (tail = load_descriptor_list; !NILP (tail); tail = XCDR (tail))
+ for (tail = load_descriptor_list; CONSP (tail); tail = XCDR (tail))
emacs_close (XFASTINT (XCAR (tail)));
#endif
}
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 */
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);
{
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. */
+ behavior for \u, and change this value in the case that \U is seen. */
int unicode_hex_count = 4;
switch (c)
{
register int c;
int uninterned_symbol = 0;
+ int multibyte;
*pch = 0;
load_each_byte = 0;
retry:
- c = READCHAR;
+ c = READCHAR_REPORT_MULTIBYTE (&multibyte);
if (c < 0)
end_of_file_error ();
tmp = read_vector (readcharfun, 0);
if (XVECTOR (tmp)->size < CHAR_TABLE_STANDARD_SLOTS)
error ("Invalid size char-table");
- XSETCHAR_TABLE (tmp, XCHAR_TABLE (tmp));
+ XSETPVECTYPE (XVECTOR (tmp), PVEC_CHAR_TABLE);
return tmp;
}
else if (c == '^')
size = XVECTOR (tmp)->size - 2;
if (chartab_size [depth] != size)
error ("Invalid size char-table");
- XSETSUB_CHAR_TABLE (tmp, XSUB_CHAR_TABLE (tmp));
+ XSETPVECTYPE (XVECTOR (tmp), PVEC_SUB_CHAR_TABLE);
return tmp;
}
invalid_syntax ("#^^", 3);
}
default:
default_label:
- if (c <= 040) goto retry;
+ if (c <= 040) goto retry;
if (c == 0x8a0) /* NBSP */
goto retry;
{
quoted = 1;
}
- p += CHAR_STRING (c, p);
+ if (multibyte)
+ p += CHAR_STRING (c, p);
+ else
+ *p++ = c;
c = READCHAR;
}
}
}
{
- Lisp_Object result = uninterned_symbol ? make_symbol (read_buffer)
- : intern (read_buffer);
+ 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))
Vread_symbol_positions_list =
}
/* 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 sym;
sym = intern (sname->symbol_name);
+ XSETPVECTYPE (sname, PVEC_SUBR);
XSETSUBR (XSYMBOL (sym)->function, sname);
}
#endif /* NOTDEF */
/* Define an "integer variable"; a symbol whose value is forwarded
- to a C variable of type int. Sample call: */
- /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
+ to a C variable of type int. Sample call:
+ DEFVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
void
defvar_int (namestring, address)
char *namestring;
}
/* Similar but define a variable whose value is t if address contains 1,
- nil if address contains 0 */
+ nil if address contains 0. */
void
defvar_bool (namestring, address)
char *namestring;
staticpro (address);
}
-/* Similar but define a variable whose value is the Lisp Object stored in
- the current buffer. address is the address of the slot in the buffer
- that is current now. */
-
-void
-defvar_per_buffer (namestring, address, type, doc)
- char *namestring;
- Lisp_Object *address;
- Lisp_Object type;
- char *doc;
-{
- Lisp_Object sym, val;
- int offset;
-
- sym = intern (namestring);
- val = allocate_misc ();
- offset = (char *)address - (char *)current_buffer;
-
- XMISCTYPE (val) = Lisp_Misc_Buffer_Objfwd;
- XBUFFER_OBJFWD (val)->offset = offset;
- SET_SYMBOL_VALUE (sym, val);
- PER_BUFFER_SYMBOL (offset) = sym;
- PER_BUFFER_TYPE (offset) = type;
-
- if (PER_BUFFER_IDX (offset) == 0)
- /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
- slot of buffer_local_flags */
- abort ();
-}
-
-
/* Similar but define a variable whose value is the Lisp Object stored
at a particular offset in the current kboard object. */
Vload_path = Fcons (tem, Vload_path);
}
- /* Add site-list under the installation dir, if it exists. */
+ /* Add site-lisp under the installation dir, if it exists. */
tem = Fexpand_file_name (build_string ("site-lisp"),
Vinstallation_directory);
tem1 = Ffile_exists_p (tem);
/* NORMAL refers to the lisp dir in the source directory. */
/* We used to add ../lisp at the front here, but
that caused trouble because it was copied from dump_path
- into Vload_path, aboe, when Vinstallation_directory was non-nil.
+ into Vload_path, above, when Vinstallation_directory was non-nil.
It should be unnecessary. */
Vload_path = decode_env_path (0, normal);
dump_path = Vload_path;
}
#endif
-#if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON))))
+#if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON)) || (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
}
}
}
-#endif /* !(WINDOWSNT || HAVE_CARBON) */
+#endif /* !(WINDOWSNT || HAVE_CARBON || HAVE_NS) */
/* If the EMACSLOADPATH environment variable is set, use its value.
This doesn't apply if we're dumping. */
}
/* Print a warning, using format string FORMAT, that directory DIRNAME
- does not exist. Print it on stderr and put it in *Message*. */
+ does not exist. Print it on stderr and put it in *Messages*. */
void
dir_warning (format, dirname)