diff --git a/configure.ac b/configure.ac index 3b593dc327f..8c2e6b421d9 100644 --- a/configure.ac +++ b/configure.ac @@ -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]) diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 2c80231f18a..34ecfb040ec 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -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 diff --git a/etc/NEWS b/etc/NEWS index f3e07481af8..b790c7e318c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -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 diff --git a/lisp/net/imap.el b/lisp/net/imap.el index 17f54e8d519..f705da317e5 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el @@ -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) diff --git a/src/bytecode.c b/src/bytecode.c index 1da2ecba071..debb08c2347 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -20,12 +20,8 @@ along with GNU Emacs. If not, see . */ #include #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, diff --git a/src/keyboard.c b/src/keyboard.c index b389d98feaa..5feb0fe231e 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -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 and , 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 diff --git a/src/lread.c b/src/lread.c index 54b74b18782..57d3239e283 100644 --- a/src/lread.c +++ b/src/lread.c @@ -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 and , 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"); diff --git a/test/src/keyboard-tests.el b/test/src/keyboard-tests.el index 05c35340149..3a36446ac83 100644 --- a/test/src/keyboard-tests.el +++ b/test/src/keyboard-tests.el @@ -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 diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 421c0c0ed4a..4dc8938b973 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -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))