/* 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 "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);
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,
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;
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;
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 ();
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 signalled `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;
}
HCoop / bpt / emacs.git / blobdiff