Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 17:24:23 +00:00
Code Issues Projects Releases Packages Wiki Activity

Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs

Browse source
This commit is contained in:
Michael Albinus 2025-07-31 07:44:11 +02:00
commit 0b449b4f38
9 changed files with 394 additions and 403 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

37
configure.ac
View file

@ -2214,32 +2214,27 @@ esac
C_SWITCH_MACHINE=
AC_CACHE_CHECK([for flag to work around GCC bug 119085],
[emacs_cv_gcc_bug_119085_CFLAGS],
[emacs_cv_gcc_bug_119085_CFLAGS='none needed'
AC_CACHE_CHECK([for flag to work around GCC union bugs],
[emacs_cv_gcc_union_bugs_CFLAGS],
[emacs_cv_gcc_union_bugs_CFLAGS='none needed'
AS_IF([test "$GCC" = yes],
[old_CFLAGS=$CFLAGS
# Use -fno-tree-sra if GCC 4 through 15.
for emacs_cv_gcc_bug_119085_CFLAGS in \
# Use -fno-tree-sra if GCC 4 through 15.1.
for emacs_cv_gcc_union_bugs_CFLAGS in \
'none needed' -fno-tree-sra
do
AS_CASE([$emacs_cv_gcc_bug_119085_CFLAGS],
AS_CASE([$emacs_cv_gcc_union_bugs_CFLAGS],
['none needed'], [],
[-fno-tree-sra], [break],
[CFLAGS="$old_CFLAGS $emacs_cv_gcc_bug_119085_CFLAGS"])
[CFLAGS="$old_CFLAGS $emacs_cv_gcc_union_bugs_CFLAGS"])
AC_COMPILE_IFELSE(
[AC_LANG_DEFINES_PROVIDED
[/* Work around GCC bug 119085 with unions containing holes:
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=119085
Although GCC bug 119085 is present in GCC 15.1,
as of 2025-07-23 a patch is in the works for GCC 16;
for now, assume the bug exists in GCC versions 4 through 15.
Working around GCC bug 119095 also works around GCC bug 117423
[/* Work around GCC bugs 117423 and 119085 re holes in unions:
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=117423
which as of 2025-07-23 is planned to be fixed in GCC 15.2.
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=119085
These are fixed in GCC 15.2.
Working wround GCC bug 119085 also works around GCC bug 58416
Working wround them also works around GCC bug 58416
with double in unions on x86, where the generated insns
copy non-floating-point data via fldl/fstpl instruction pairs.
This can misbehave if the data's bit pattern looks like a NaN.
@ -2249,16 +2244,18 @@ AC_CACHE_CHECK([for flag to work around GCC bug 119085],
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=93271
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114659
GCC bug 58416 is fixed in GCC 15.1. */
#if 4 <= __GNUC__ && __GNUC__ <= 15 && !defined __clang__
# error "GCC bug 119085 possibly present"
#if 4 <= __GNUC__ && ! (15 < __GNUC__ + (1 < __GNUC_MINOR__))
#ifndef __clang__
#error "GCC union bugs possibly present"
#endif
#endif
]],
[break])
done
CFLAGS=$old_CFLAGS])])
AS_CASE([$emacs_cv_gcc_bug_119085_CFLAGS],
AS_CASE([$emacs_cv_gcc_union_bugs_CFLAGS],
[-*],
[C_SWITCH_MACHINE="$C_SWITCH_MACHINE $emacs_cv_gcc_bug_119085_CFLAGS"])
[C_SWITCH_MACHINE="$C_SWITCH_MACHINE $emacs_cv_gcc_union_bugs_CFLAGS"])
AC_SUBST([C_SWITCH_MACHINE])

7
doc/misc/gnus.texi
View file

@ -15357,7 +15357,7 @@ symbols in @code{imap-stream-alist}. Right now, this means
Which authenticator to use for authenticating to the server, this is
one of the symbols in @code{imap-authenticator-alist}. Right now,
this means @samp{gssapi}, @samp{kerberos4}, @samp{digest-md5},
@samp{cram-md5}, @samp{anonymous} or the default @samp{login}.
@samp{cram-md5}, @samp{plain}, @samp{anonymous} or the default @samp{login}.
@item :program
When using the @samp{shell} :stream, the contents of this variable is
@ -27096,14 +27096,15 @@ Gnus supports both encoding and decoding.
@item S/MIME---RFC 2633
RFC 2633 describes the @acronym{S/MIME} format.
@item IMAP---RFC 1730/2060, RFC 2195, RFC 2086, RFC 2359, RFC 2595, RFC 1731
@item IMAP---RFC 1730/2060, RFC 2195/4616, RFC 2086, RFC 2359, RFC 2595, RFC 1731
RFC 1730 is @acronym{IMAP} version 4, updated somewhat by RFC 2060
(@acronym{IMAP} 4 revision 1). RFC 2195 describes CRAM-MD5
authentication for @acronym{IMAP}. RFC 2086 describes access control
lists (ACLs) for @acronym{IMAP}. RFC 2359 describes a @acronym{IMAP}
protocol enhancement. RFC 2595 describes the proper @acronym{TLS}
integration (STARTTLS) with @acronym{IMAP}. RFC 1731 describes the
GSSAPI/Kerberos4 mechanisms for @acronym{IMAP}.
GSSAPI/Kerberos4 mechanisms for @acronym{IMAP}. RFC 4616 describes
AUTH=PLAIN authentication for @acronym{IMAP}.
@end table

10
etc/NEWS
View file

@ -1336,6 +1336,14 @@ This contains the list of regular expressions used to match "Re:" and
international variants of it when modifying the Subject field in
replies.
** Imap
---
*** 'imap-authenticate' can now use PLAIN authentication.
"AUTH=PLAIN" support is auto-enabled if the IMAP server supports it. Pass
a specific authentication type to 'imap-authenticate' or remove 'plain'
from 'imap-authenticators' if you do not wish to use "AUTH=PLAIN".
** Rmail
+++
@ -2446,7 +2454,7 @@ Use the byte-compiler instead; it provides more and more useful warnings.
** Newsticker
---
*** New user option 'newsticker-hide-old-feed-header-in-newsticker-buffer'.
*** New user option 'newsticker-hide-old-feed-header'.
It controls whether to automatically hide the header of feeds whose
items are all old or obsolete in the plainview *newsticker* buffer.
This is only visually interesting if the content of those feeds are also

19
lisp/net/imap.el
View file

@ -275,6 +275,7 @@ stream.")
digest-md5
cram-md5
;;sasl
plain
login
anonymous)
"Priority of authenticators to consider when authenticating to server.")
@ -284,6 +285,7 @@ stream.")
(kerberos4 imap-kerberos4-auth-p imap-kerberos4-auth)
(sasl imap-sasl-auth-p imap-sasl-auth)
(cram-md5 imap-cram-md5-p imap-cram-md5-auth)
(plain imap-plain-p imap-plain-auth)
(login imap-login-p imap-login-auth)
(anonymous imap-anonymous-p imap-anonymous-auth)
(digest-md5 imap-digest-md5-p imap-digest-md5-auth))
@ -853,6 +855,23 @@ t if it successfully authenticates, nil otherwise."
(imap-quote-specials passwd)
"\""))))))
(defun imap-plain-p (buffer)
(imap-capability 'AUTH=PLAIN buffer))
(defun imap-plain-auth (buffer)
"Login to server using the AUTH=PLAIN command."
(message "imap: PLAIN authentication...")
(imap-interactive-login
buffer
(lambda (user passwd)
(imap-ok-p
(imap-send-command-wait
(concat "AUTHENTICATE PLAIN "
(base64-encode-string
(format "\000%s\000%s"
(imap-quote-specials user)
(imap-quote-specials passwd)))))))))
(defun imap-anonymous-p (_buffer)
t)

4
src/bytecode.c
View file

@ -20,12 +20,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include "lisp.h"
#include "blockinput.h"
#include "sysstdio.h"
#include "character.h"
#include "buffer.h"
#include "keyboard.h"
#include "syntax.h"
#include "window.h"
/* Define BYTE_CODE_SAFE true to enable some minor sanity checking,

270
src/keyboard.c
View file

@ -10494,6 +10494,271 @@ void init_raw_keybuf_count (void)
raw_keybuf_count = 0;
}
/* Get a character from the tty. */
/* Read input events until we get one that's acceptable for our purposes.
If NO_SWITCH_FRAME, switch-frame events are stashed
until we get a character we like, and then stuffed into
unread_switch_frame.
If ASCII_REQUIRED, check function key events to see
if the unmodified version of the symbol has a Qascii_character
property, and use that character, if present.
If ERROR_NONASCII, signal an error if the input we
get isn't an ASCII character with modifiers. If it's false but
ASCII_REQUIRED is true, just re-read until we get an ASCII
character.
If INPUT_METHOD, invoke the current input method
if the character warrants that.
If SECONDS is a number, wait that many seconds for input, and
return Qnil if no input arrives within that time.
If text conversion is enabled and ASCII_REQUIRED, temporarily
disable any input method which wants to perform edits, unless
`disable-inhibit-text-conversion'. */
static Lisp_Object
read_filtered_event (bool no_switch_frame, bool ascii_required,
bool error_nonascii, bool input_method, Lisp_Object seconds)
{
Lisp_Object val, delayed_switch_frame;
struct timespec end_time;
#ifdef HAVE_TEXT_CONVERSION
specpdl_ref count;
#endif
#ifdef HAVE_WINDOW_SYSTEM
if (display_hourglass_p)
cancel_hourglass ();
#endif
#ifdef HAVE_TEXT_CONVERSION
count = SPECPDL_INDEX ();
/* Don't use text conversion when trying to just read a
character. */
if (ascii_required && !disable_inhibit_text_conversion)
{
disable_text_conversion ();
record_unwind_protect_void (resume_text_conversion);
}
#endif
delayed_switch_frame = Qnil;
/* Compute timeout. */
if (NUMBERP (seconds))
{
double duration = XFLOATINT (seconds);
struct timespec wait_time = dtotimespec (duration);
end_time = timespec_add (current_timespec (), wait_time);
}
/* Read until we get an acceptable event. */
retry:
do
val = read_char (0, Qnil, (input_method ? Qnil : Qt), 0,
NUMBERP (seconds) ? &end_time : NULL);
while (FIXNUMP (val) && XFIXNUM (val) == -2); /* wrong_kboard_jmpbuf */
if (BUFFERP (val))
goto retry;
/* `switch-frame' events are put off until after the next ASCII
character. This is better than signaling an error just because
the last characters were typed to a separate minibuffer frame,
for example. Eventually, some code which can deal with
switch-frame events will read it and process it. */
if (no_switch_frame
&& EVENT_HAS_PARAMETERS (val)
&& EQ (EVENT_HEAD_KIND (EVENT_HEAD (val)), Qswitch_frame))
{
delayed_switch_frame = val;
goto retry;
}
if (ascii_required && !(NUMBERP (seconds) && NILP (val)))
{
/* Convert certain symbols to their ASCII equivalents. */
if (SYMBOLP (val))
{
Lisp_Object tem, tem1;
tem = Fget (val, Qevent_symbol_element_mask);
if (!NILP (tem))
{
tem1 = Fget (Fcar (tem), Qascii_character);
/* Merge this symbol's modifier bits
with the ASCII equivalent of its basic code. */
if (FIXNUMP (tem1) && FIXNUMP (Fcar (Fcdr (tem))))
XSETFASTINT (val, XFIXNUM (tem1) | XFIXNUM (Fcar (Fcdr (tem))));
}
}
/* If we don't have a character now, deal with it appropriately. */
if (!FIXNUMP (val))
{
if (error_nonascii)
{
Vunread_command_events = list1 (val);
error ("Non-character input-event");
}
else
goto retry;
}
}
if (! NILP (delayed_switch_frame))
unread_switch_frame = delayed_switch_frame;
#if 0
#ifdef HAVE_WINDOW_SYSTEM
if (display_hourglass_p)
start_hourglass ();
#endif
#endif
#ifdef HAVE_TEXT_CONVERSION
return unbind_to (count, val);
#else
return val;
#endif
}
DEFUN ("read-char", Fread_char, Sread_char, 0, 3, 0,
doc: /* Read a character event from the command input (keyboard or macro).
Return the character as a number.
If the event has modifiers, they are resolved and reflected in the
returned character code if possible (e.g. C-SPC yields 0 and C-a yields 97).
If some of the modifiers cannot be reflected in the character code, the
returned value will include those modifiers, and will not be a valid
character code: it will fail the `characterp' test. Use `event-basic-type'
to recover the character code with the modifiers removed.
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-character events
can be read.
If you want to read non-character events, or ignore them, call
`read-event' or `read-char-exclusive' instead.
If the optional argument PROMPT is non-nil, display that as a prompt.
If PROMPT is nil or the string \"\", the key sequence/events that led
to the current command is used as the prompt.
If the optional argument INHERIT-INPUT-METHOD is non-nil and some
input method is turned on in the current buffer, that input method
is used for reading a character.
If the optional argument SECONDS is non-nil, it should be a number
specifying the maximum number of seconds to wait for input. If no
input arrives in that time, return nil. SECONDS may be a
floating-point value.
If `inhibit-interaction' is non-nil, this function will signal an
`inhibited-interaction' error. */)
(Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
{
Lisp_Object val;
barf_if_interaction_inhibited ();
if (! NILP (prompt))
{
cancel_echoing ();
message_with_string ("%s", prompt, 0);
}
val = read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds);
return (!FIXNUMP (val) ? Qnil
: make_fixnum (char_resolve_modifier_mask (XFIXNUM (val))));
}
DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0,
doc: /* Read and return an event object from the input stream.
If you want to read non-character events, consider calling `read-key'
instead. `read-key' will decode events via `input-decode-map' that
`read-event' will not. On a terminal this includes function keys such
as <F7> and <RIGHT>, or mouse events generated by `xterm-mouse-mode'.
If the optional argument PROMPT is non-nil, display that as a prompt.
If PROMPT is nil or the string \"\", the key sequence/events that led
to the current command is used as the prompt.
If the optional argument INHERIT-INPUT-METHOD is non-nil and some
input method is turned on in the current buffer, that input method
is used for reading a character.
If the optional argument SECONDS is non-nil, it should be a number
specifying the maximum number of seconds to wait for input. If no
input arrives in that time, return nil. SECONDS may be a
floating-point value.
If `inhibit-interaction' is non-nil, this function will signal an
`inhibited-interaction' error. */)
(Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
{
barf_if_interaction_inhibited ();
if (! NILP (prompt))
{
cancel_echoing ();
message_with_string ("%s", prompt, 0);
}
return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method), seconds);
}
DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 3, 0,
doc: /* Read a character event from the command input (keyboard or macro).
Return the character as a number. Non-character events are ignored.
If the event has modifiers, they are resolved and reflected in the
returned character code if possible (e.g. C-SPC yields 0 and C-a yields 97).
If some of the modifiers cannot be reflected in the character code, the
returned value will include those modifiers, and will not be a valid
character code: it will fail the `characterp' test. Use `event-basic-type'
to recover the character code with the modifiers removed.
If the optional argument PROMPT is non-nil, display that as a prompt.
If PROMPT is nil or the string \"\", the key sequence/events that led
to the current command is used as the prompt.
If the optional argument INHERIT-INPUT-METHOD is non-nil and some
input method is turned on in the current buffer, that input method
is used for reading a character.
If the optional argument SECONDS is non-nil, it should be a number
specifying the maximum number of seconds to wait for input. If no
input arrives in that time, return nil. SECONDS may be a
floating-point value.
If `inhibit-interaction' is non-nil, this function will signal an
`inhibited-interaction' error. */)
(Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
{
Lisp_Object val;
barf_if_interaction_inhibited ();
if (! NILP (prompt))
{
cancel_echoing ();
message_with_string ("%s", prompt, 0);
}
val = read_filtered_event (1, 1, 0, ! NILP (inherit_input_method), seconds);
return (!FIXNUMP (val) ? Qnil
: make_fixnum (char_resolve_modifier_mask (XFIXNUM (val))));
}
#ifdef HAVE_TEXT_CONVERSION
@ -13376,6 +13641,10 @@ syms_of_keyboard (void)
defsubr (&Sposn_at_point);
defsubr (&Sposn_at_x_y);
defsubr (&Sread_char);
defsubr (&Sread_char_exclusive);
defsubr (&Sread_event);
DEFVAR_LISP ("last-command-event", last_command_event,
doc: /* Last input event of a key sequence that called a command.
See Info node `(elisp)Command Loop Info'.*/);
@ -14117,6 +14386,7 @@ function is called to remap that sequence. */);
DEFSYM (Qsuspend_resume_hook, "suspend-resume-hook");
DEFSYM (Qcommand_error_default_function, "command-error-default-function");
DEFSYM (Qsigusr2, "sigusr2");
DEFSYM (Qascii_character, "ascii-character");
}
static void

438
src/lread.c
View file

@ -739,272 +739,6 @@ static Lisp_Object substitute_object_recurse (struct subst *, Lisp_Object);
static void substitute_in_interval (INTERVAL, void *);
/* Get a character from the tty. */
/* Read input events until we get one that's acceptable for our purposes.
If NO_SWITCH_FRAME, switch-frame events are stashed
until we get a character we like, and then stuffed into
unread_switch_frame.
If ASCII_REQUIRED, check function key events to see
if the unmodified version of the symbol has a Qascii_character
property, and use that character, if present.
If ERROR_NONASCII, signal an error if the input we
get isn't an ASCII character with modifiers. If it's false but
ASCII_REQUIRED is true, just re-read until we get an ASCII
character.
If INPUT_METHOD, invoke the current input method
if the character warrants that.
If SECONDS is a number, wait that many seconds for input, and
return Qnil if no input arrives within that time.
If text conversion is enabled and ASCII_REQUIRED, temporarily
disable any input method which wants to perform edits, unless
`disable-inhibit-text-conversion'. */
static Lisp_Object
read_filtered_event (bool no_switch_frame, bool ascii_required,
bool error_nonascii, bool input_method, Lisp_Object seconds)
{
Lisp_Object val, delayed_switch_frame;
struct timespec end_time;
#ifdef HAVE_TEXT_CONVERSION
specpdl_ref count;
#endif
#ifdef HAVE_WINDOW_SYSTEM
if (display_hourglass_p)
cancel_hourglass ();
#endif
#ifdef HAVE_TEXT_CONVERSION
count = SPECPDL_INDEX ();
/* Don't use text conversion when trying to just read a
character. */
if (ascii_required && !disable_inhibit_text_conversion)
{
disable_text_conversion ();
record_unwind_protect_void (resume_text_conversion);
}
#endif
delayed_switch_frame = Qnil;
/* Compute timeout. */
if (NUMBERP (seconds))
{
double duration = XFLOATINT (seconds);
struct timespec wait_time = dtotimespec (duration);
end_time = timespec_add (current_timespec (), wait_time);
}
/* Read until we get an acceptable event. */
retry:
do
val = read_char (0, Qnil, (input_method ? Qnil : Qt), 0,
NUMBERP (seconds) ? &end_time : NULL);
while (FIXNUMP (val) && XFIXNUM (val) == -2); /* wrong_kboard_jmpbuf */
if (BUFFERP (val))
goto retry;
/* `switch-frame' events are put off until after the next ASCII
character. This is better than signaling an error just because
the last characters were typed to a separate minibuffer frame,
for example. Eventually, some code which can deal with
switch-frame events will read it and process it. */
if (no_switch_frame
&& EVENT_HAS_PARAMETERS (val)
&& EQ (EVENT_HEAD_KIND (EVENT_HEAD (val)), Qswitch_frame))
{
delayed_switch_frame = val;
goto retry;
}
if (ascii_required && !(NUMBERP (seconds) && NILP (val)))
{
/* Convert certain symbols to their ASCII equivalents. */
if (SYMBOLP (val))
{
Lisp_Object tem, tem1;
tem = Fget (val, Qevent_symbol_element_mask);
if (!NILP (tem))
{
tem1 = Fget (Fcar (tem), Qascii_character);
/* Merge this symbol's modifier bits
with the ASCII equivalent of its basic code. */
if (FIXNUMP (tem1) && FIXNUMP (Fcar (Fcdr (tem))))
XSETFASTINT (val, XFIXNUM (tem1) | XFIXNUM (Fcar (Fcdr (tem))));
}
}
/* If we don't have a character now, deal with it appropriately. */
if (!FIXNUMP (val))
{
if (error_nonascii)
{
Vunread_command_events = list1 (val);
error ("Non-character input-event");
}
else
goto retry;
}
}
if (! NILP (delayed_switch_frame))
unread_switch_frame = delayed_switch_frame;
#if 0
#ifdef HAVE_WINDOW_SYSTEM
if (display_hourglass_p)
start_hourglass ();
#endif
#endif
#ifdef HAVE_TEXT_CONVERSION
return unbind_to (count, val);
#else
return val;
#endif
}
DEFUN ("read-char", Fread_char, Sread_char, 0, 3, 0,
doc: /* Read a character event from the command input (keyboard or macro).
Return the character as a number.
If the event has modifiers, they are resolved and reflected in the
returned character code if possible (e.g. C-SPC yields 0 and C-a yields 97).
If some of the modifiers cannot be reflected in the character code, the
returned value will include those modifiers, and will not be a valid
character code: it will fail the `characterp' test. Use `event-basic-type'
to recover the character code with the modifiers removed.
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-character events
can be read.
If you want to read non-character events, or ignore them, call
`read-event' or `read-char-exclusive' instead.
If the optional argument PROMPT is non-nil, display that as a prompt.
If PROMPT is nil or the string \"\", the key sequence/events that led
to the current command is used as the prompt.
If the optional argument INHERIT-INPUT-METHOD is non-nil and some
input method is turned on in the current buffer, that input method
is used for reading a character.
If the optional argument SECONDS is non-nil, it should be a number
specifying the maximum number of seconds to wait for input. If no
input arrives in that time, return nil. SECONDS may be a
floating-point value.
If `inhibit-interaction' is non-nil, this function will signal an
`inhibited-interaction' error. */)
(Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
{
Lisp_Object val;
barf_if_interaction_inhibited ();
if (! NILP (prompt))
{
cancel_echoing ();
message_with_string ("%s", prompt, 0);
}
val = read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds);
return (!FIXNUMP (val) ? Qnil
: make_fixnum (char_resolve_modifier_mask (XFIXNUM (val))));
}
DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0,
doc: /* Read and return an event object from the input stream.
If you want to read non-character events, consider calling `read-key'
instead. `read-key' will decode events via `input-decode-map' that
`read-event' will not. On a terminal this includes function keys such
as <F7> and <RIGHT>, or mouse events generated by `xterm-mouse-mode'.
If the optional argument PROMPT is non-nil, display that as a prompt.
If PROMPT is nil or the string \"\", the key sequence/events that led
to the current command is used as the prompt.
If the optional argument INHERIT-INPUT-METHOD is non-nil and some
input method is turned on in the current buffer, that input method
is used for reading a character.
If the optional argument SECONDS is non-nil, it should be a number
specifying the maximum number of seconds to wait for input. If no
input arrives in that time, return nil. SECONDS may be a
floating-point value.
If `inhibit-interaction' is non-nil, this function will signal an
`inhibited-interaction' error. */)
(Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
{
barf_if_interaction_inhibited ();
if (! NILP (prompt))
{
cancel_echoing ();
message_with_string ("%s", prompt, 0);
}
return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method), seconds);
}
DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 3, 0,
doc: /* Read a character event from the command input (keyboard or macro).
Return the character as a number. Non-character events are ignored.
If the event has modifiers, they are resolved and reflected in the
returned character code if possible (e.g. C-SPC yields 0 and C-a yields 97).
If some of the modifiers cannot be reflected in the character code, the
returned value will include those modifiers, and will not be a valid
character code: it will fail the `characterp' test. Use `event-basic-type'
to recover the character code with the modifiers removed.
If the optional argument PROMPT is non-nil, display that as a prompt.
If PROMPT is nil or the string \"\", the key sequence/events that led
to the current command is used as the prompt.
If the optional argument INHERIT-INPUT-METHOD is non-nil and some
input method is turned on in the current buffer, that input method
is used for reading a character.
If the optional argument SECONDS is non-nil, it should be a number
specifying the maximum number of seconds to wait for input. If no
input arrives in that time, return nil. SECONDS may be a
floating-point value.
If `inhibit-interaction' is non-nil, this function will signal an
`inhibited-interaction' error. */)
(Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
{
Lisp_Object val;
barf_if_interaction_inhibited ();
if (! NILP (prompt))
{
cancel_echoing ();
message_with_string ("%s", prompt, 0);
}
val = read_filtered_event (1, 1, 0, ! NILP (inherit_input_method), seconds);
return (!FIXNUMP (val) ? Qnil
: make_fixnum (char_resolve_modifier_mask (XFIXNUM (val))));
}
typedef enum {
Cookie_None, /* no cookie */
Cookie_Dyn, /* explicit dynamic binding */
@ -2823,30 +2557,6 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end,
return retval;
}
/* Grow a read buffer BUF that contains OFFSET useful bytes of data,
by at least MAX_MULTIBYTE_LENGTH bytes. Update *BUF_ADDR and
*BUF_SIZE accordingly; 0 <= OFFSET <= *BUF_SIZE. If *BUF_ADDR is
initially null, BUF is on the stack: copy its data to the new heap
buffer. Otherwise, BUF must equal *BUF_ADDR and can simply be
reallocated. Either way, remember the heap allocation (which is at
pdl slot COUNT) so that it can be freed when unwinding the stack.*/
static char *
grow_read_buffer (char *buf, ptrdiff_t offset,
char **buf_addr, ptrdiff_t *buf_size, specpdl_ref count)
{
char *p = xpalloc (*buf_addr, buf_size, MAX_MULTIBYTE_LENGTH, -1, 1);
if (!*buf_addr)
{
memcpy (p, buf, offset);
record_unwind_protect_ptr (xfree, p);
}
else
set_unwind_protect_ptr (count, xfree, p);
*buf_addr = p;
return p;
}
/* Return the scalar value that has the Unicode character name NAME.
Raise 'invalid-read-syntax' if there is no such character. */
static int
@ -3167,6 +2877,49 @@ invalid_radix_integer (EMACS_INT radix, source_t *source)
invalid_syntax (buf, source);
}
/* A character buffer that starts on the C stack and switches to heap
allocation if more space is needed. */
typedef struct {
char *start; /* start of buffer, on the C stack or heap */
char *end; /* just past end of buffer */
char *cur; /* where to put next char read */
char *heap; /* heap allocation or NULL */
specpdl_ref count; /* index for cleanup when a heap allocation is used */
} readbuf_t;
/* Make more room in the buffer, using heap allocation. */
static NO_INLINE void
readbuf_grow (readbuf_t *rb)
{
ptrdiff_t used = rb->cur - rb->start;
ptrdiff_t size = rb->end - rb->start;
char *p = xpalloc (rb->heap, &size, MAX_MULTIBYTE_LENGTH, -1, 1);
if (rb->heap == NULL)
{
/* Old buffer is on the stack; copy it to the heap. */
memcpy (p, rb->start, used);
rb->count = SPECPDL_INDEX ();
record_unwind_protect_ptr (xfree, p);
}
else
set_unwind_protect_ptr (rb->count, xfree, p); /* update cleanup entry */
rb->start = rb->heap = p;
rb->cur = rb->start + used;
rb->end = rb->start + size;
}
static inline void
add_char_to_buffer (readbuf_t *rb, int c, bool multibyte)
{
/* Make room for a multibyte char and a terminating NUL. */
if (rb->end - rb->cur < MAX_MULTIBYTE_LENGTH + 1)
readbuf_grow (rb);
if (multibyte)
rb->cur += CHAR_STRING (c, (unsigned char *) rb->cur);
else
*rb->cur++ = c;
}
/* Read an integer in radix RADIX using READCHARFUN to read
characters. RADIX must be in the interval [2..36].
Value is the integer read.
@ -3175,24 +2928,25 @@ invalid_radix_integer (EMACS_INT radix, source_t *source)
static Lisp_Object
read_integer (source_t *source, int radix)
{
char stackbuf[20];
char *read_buffer = stackbuf;
ptrdiff_t read_buffer_size = sizeof stackbuf;
char *p = read_buffer;
char *heapbuf = NULL;
int valid = -1; /* 1 if valid, 0 if not, -1 if incomplete. */
specpdl_ref count = SPECPDL_INDEX ();
char stackbuf[20];
readbuf_t rb = { .start = stackbuf,
.end = stackbuf + sizeof stackbuf,
.cur = stackbuf,
.heap = NULL };
int valid = -1; /* 1 if valid, 0 if not, -1 if incomplete. */
int c = readchar (source);
if (c == '-' || c == '+')
{
*p++ = c;
*rb.cur++ = c;
c = readchar (source);
}
if (c == '0')
{
*p++ = c;
*rb.cur++ = c;
valid = 1;
/* Ignore redundant leading zeros, so the buffer doesn't
@ -3208,16 +2962,7 @@ read_integer (source_t *source, int radix)
valid = 0;
if (valid < 0)
valid = 1;
/* Allow 1 extra byte for the \0. */
if (p + 1 == read_buffer + read_buffer_size)
{
ptrdiff_t offset = p - read_buffer;
read_buffer = grow_read_buffer (read_buffer, offset,
&heapbuf, &read_buffer_size,
count);
p = read_buffer + offset;
}
*p++ = c;
add_char_to_buffer (&rb, c, false);
c = readchar (source);
}
@ -3226,8 +2971,8 @@ read_integer (source_t *source, int radix)
if (valid != 1)
invalid_radix_integer (radix, source);
*p = '\0';
return unbind_to (count, string_to_number (read_buffer, radix, NULL));
*rb.cur++ = '\0';
return unbind_to (count, string_to_number (rb.start, radix, NULL));
}
@ -3280,13 +3025,13 @@ read_char_literal (source_t *source)
static Lisp_Object
read_string_literal (source_t *source)
{
char stackbuf[1024];
char *read_buffer = stackbuf;
ptrdiff_t read_buffer_size = sizeof stackbuf;
specpdl_ref count = SPECPDL_INDEX ();
char *heapbuf = NULL;
char *p = read_buffer;
char *end = read_buffer + read_buffer_size;
char stackbuf[1024];
readbuf_t rb = { .start = stackbuf,
.end = stackbuf + sizeof stackbuf,
.cur = stackbuf,
.heap = NULL };
/* True if we saw an escape sequence specifying
a multibyte character. */
bool force_multibyte = false;
@ -3298,16 +3043,6 @@ read_string_literal (source_t *source)
int ch;
while ((ch = readchar (source)) >= 0 && ch != '\"')
{
if (end - p < MAX_MULTIBYTE_LENGTH)
{
ptrdiff_t offset = p - read_buffer;
read_buffer = grow_read_buffer (read_buffer, offset,
&heapbuf, &read_buffer_size,
count);
p = read_buffer + offset;
end = read_buffer + read_buffer_size;
}
if (ch == '\\')
{
/* First apply string-specific escape rules: */
@ -3369,11 +3104,11 @@ read_string_literal (source_t *source)
/* Any modifiers remaining are invalid. */
if (modifiers)
invalid_syntax ("Invalid modifier in string", source);
p += CHAR_STRING (ch, (unsigned char *) p);
add_char_to_buffer (&rb, ch, true);
}
else
{
p += CHAR_STRING (ch, (unsigned char *) p);
add_char_to_buffer (&rb, ch, true);
if (CHAR_BYTE8_P (ch))
force_singlebyte = true;
else if (! ASCII_CHAR_P (ch))
@ -3389,14 +3124,14 @@ read_string_literal (source_t *source)
{
/* READ_BUFFER contains raw 8-bit bytes and no multibyte
forms. Convert it to unibyte. */
nchars = str_as_unibyte ((unsigned char *) read_buffer,
p - read_buffer);
p = read_buffer + nchars;
nchars = str_as_unibyte ((unsigned char *)rb.start, rb.cur - rb.start);
rb.cur = rb.start + nchars;
}
Lisp_Object obj = make_specified_string (read_buffer, nchars, p - read_buffer,
ptrdiff_t nbytes = rb.cur - rb.start;
Lisp_Object obj = make_specified_string (rb.start, nchars, nbytes,
(force_multibyte
|| (p - read_buffer != nchars)));
|| nbytes != nchars));
return unbind_to (count, obj);
}
@ -3959,36 +3694,6 @@ read_stack_reset (intmax_t sp)
rdstack.sp = sp;
}
typedef struct {
char *start; /* start of buffer, dynamic if equal to heapbuf */
char *end; /* just past end of buffer */
char *cur; /* where to put next char read */
char *heapbuf; /* start of heap allocation if any, or NULL */
specpdl_ref count; /* specpdl at start */
} readbuf_t;
static NO_INLINE void
readbuf_grow (readbuf_t *rb)
{
ptrdiff_t offset = rb->cur - rb->start;
ptrdiff_t size = rb->end - rb->start;
rb->start = grow_read_buffer (rb->start, offset, &rb->heapbuf, &size,
rb->count);
rb->cur = rb->start + offset;
rb->end = rb->start + size;
}
static inline void
add_char_to_buffer (readbuf_t *rb, int c, bool multibyte)
{
if (multibyte)
rb->cur += CHAR_STRING (c, (unsigned char *) rb->cur);
else
*rb->cur++ = c;
if (rb->end - rb->cur < MAX_MULTIBYTE_LENGTH + 1)
readbuf_grow (rb);
}
static AVOID
invalid_syntax_with_buffer (readbuf_t *rb, source_t *source)
{
@ -4019,8 +3724,7 @@ read0 (source_t *source, bool locate_syms)
readbuf_t rb = { .start = stackbuf,
.end = stackbuf + sizeof stackbuf,
.heapbuf = NULL,
.count = SPECPDL_INDEX () };
.heap = NULL };
bool uninterned_symbol;
bool skip_shorthand;
@ -5852,9 +5556,6 @@ syms_of_lread (void)
defsubr (&Sload);
defsubr (&Seval_buffer);
defsubr (&Seval_region);
defsubr (&Sread_char);
defsubr (&Sread_char_exclusive);
defsubr (&Sread_event);
defsubr (&Smapatoms);
defsubr (&Slocate_file_internal);
defsubr (&Sinternal__obarray_buckets);
@ -6166,7 +5867,6 @@ will use instead of `load-path' to look for the file to load. */);
#endif
DEFSYM (Qinhibit_file_name_operation, "inhibit-file-name-operation");
DEFSYM (Qascii_character, "ascii-character");
DEFSYM (Qfunction, "function");
DEFSYM (Qload, "load");
DEFSYM (Qload_file_name, "load-file-name");

6
test/src/keyboard-tests.el
View file

@ -75,5 +75,11 @@
;; (recursive-edit)
;; (should (equal msgs '("C-u 55-" "C-u 5-" "C-u-"))))))
(ert-deftest keyboard-inhibit-interaction ()
(let ((inhibit-interaction t))
(should-error (read-char "foo: "))
(should-error (read-event "foo: "))
(should-error (read-char-exclusive "foo: "))))
(provide 'keyboard-tests)
;;; keyboard-tests.el ends here

6
test/src/lread-tests.el
View file

@ -222,12 +222,6 @@ literals (Bug#20852)."
(ert-deftest lread-circular-hash ()
(should-error (read "#s(hash-table data #0=(#0# . #0#))")))
(ert-deftest test-inhibit-interaction ()
(let ((inhibit-interaction t))
(should-error (read-char "foo: "))
(should-error (read-event "foo: "))
(should-error (read-char-exclusive "foo: "))))
(ert-deftest lread-float ()
(should (equal (read "13") 13))
(should (equal (read "+13") 13))