commit b3a3ed526d2c490c9c5605707f0cd7bff3c88693 (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Wed Jan 25 21:13:19 2017 -0800 Replace QUIT with maybe_quit There’s no longer need to have QUIT stand for a slug of C statements. Use the more-obvious function-call syntax instead. Also, use true and false when setting immediate_quit. These changes should not affect the generated machine code. * src/lisp.h (QUIT): Remove. All uses replaced by maybe_quit. diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 69d21bedaa..663d0fd92b 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -672,7 +672,7 @@ usage: (or CONDITIONS...) */) if (!NILP (val)) break; args = XCDR (args); - QUIT; + maybe_quit (); @} @end group @@ -792,8 +792,8 @@ their addresses after performing Lisp evaluation. Lisp evaluation can occur via calls to @code{eval_sub} or @code{Feval}, either directly or indirectly. -@cindex @code{QUIT}, use in Lisp primitives - Note the call to the @code{QUIT} macro inside the loop: this macro +@cindex @code{maybe_quit}, use in Lisp primitives + Note the call to @code{maybe_quit} inside the loop: this function checks whether the user pressed @kbd{C-g}, and if so, aborts the processing. You should do that in any loop that can potentially require a large number of iterations; in this case, the list of diff --git a/etc/DEBUG b/etc/DEBUG index acb08c660e..3719c3e6f6 100644 --- a/etc/DEBUG +++ b/etc/DEBUG @@ -225,7 +225,7 @@ this command: handle SIGINT stop nopass After this 'handle' command, SIGINT will return control to GDB. If -you want the C-g to cause a QUIT within Emacs as well, omit the 'nopass'. +you want the C-g to cause a quit within Emacs as well, omit the 'nopass'. See the GDB manual for more details about signal handling and the 'handle' command. diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el index 7b7a7208aa..e6af092063 100644 --- a/lisp/calc/calc-misc.el +++ b/lisp/calc/calc-misc.el @@ -623,7 +623,7 @@ loaded and the keystroke automatically re-typed." (unwind-protect (progn (sit-for 2) - (identity 1) ; this forces a call to QUIT; in bytecode.c. + (identity 1) ; This forces a call to maybe_quit in bytecode.c. (setq okay t)) (progn (delete-region savemax (point-max)) diff --git a/lisp/simple.el b/lisp/simple.el index bdc6abde1f..441713a18b 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -7572,7 +7572,7 @@ More precisely, a char with closeparen syntax is self-inserted.") ;; This executes C-g typed while Emacs is waiting for a command. ;; Quitting out of a program does not go through here; -;; that happens in the QUIT macro at the C code level. +;; that happens in the maybe_quit function at the C code level. (defun keyboard-quit () "Signal a `quit' condition. During execution of Lisp code, this character causes a quit directly. diff --git a/src/alloc.c b/src/alloc.c index f7da7e44f2..f7b6515f4e 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2880,7 +2880,7 @@ DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0, for (EMACS_INT size = XFASTINT (length); 0 < size; size--) { val = Fcons (init, val); - QUIT; + maybe_quit (); } return val; diff --git a/src/buffer.c b/src/buffer.c index fde23cace1..c00cc40d6f 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -415,19 +415,16 @@ followed by the rest of the buffers. */) } /* Like Fassoc, but use Fstring_equal to compare - (which ignores text properties), - and don't ever QUIT. */ + (which ignores text properties), and don't ever quit. */ static Lisp_Object -assoc_ignore_text_properties (register Lisp_Object key, Lisp_Object list) +assoc_ignore_text_properties (Lisp_Object key, Lisp_Object list) { - register Lisp_Object tail; + Lisp_Object tail; for (tail = list; CONSP (tail); tail = XCDR (tail)) { - register Lisp_Object elt, tem; - elt = XCAR (tail); - tem = Fstring_equal (Fcar (elt), key); - if (!NILP (tem)) + Lisp_Object elt = XCAR (tail); + if (!NILP (Fstring_equal (Fcar (elt), key))) return elt; } return Qnil; diff --git a/src/bytecode.c b/src/bytecode.c index a64bc171d1..499fb881e2 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -679,7 +679,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, { quitcounter = 1; maybe_gc (); - QUIT; + maybe_quit (); } pc += op; NEXT; diff --git a/src/callint.c b/src/callint.c index 565fac8a45..d96454883c 100644 --- a/src/callint.c +++ b/src/callint.c @@ -794,7 +794,7 @@ invoke it. If KEYS is omitted or nil, the return value of } unbind_to (speccount, Qnil); - QUIT; + maybe_quit (); args[0] = Qfuncall_interactively; args[1] = function; diff --git a/src/callproc.c b/src/callproc.c index 90c15de291..301ccf383b 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -198,11 +198,11 @@ call_process_cleanup (Lisp_Object buffer) { kill (-synch_process_pid, SIGINT); message1 ("Waiting for process to die...(type C-g again to kill it instantly)"); - immediate_quit = 1; - QUIT; + immediate_quit = true; + maybe_quit (); wait_for_termination (synch_process_pid, 0, 1); synch_process_pid = 0; - immediate_quit = 0; + immediate_quit = false; message1 ("Waiting for process to die...done"); } #endif /* !MSDOS */ @@ -726,8 +726,8 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, process_coding.src_multibyte = 0; } - immediate_quit = 1; - QUIT; + immediate_quit = true; + maybe_quit (); if (0 <= fd0) { @@ -769,7 +769,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, } /* Now NREAD is the total amount of data in the buffer. */ - immediate_quit = 0; + immediate_quit = false; if (!nread) ; @@ -843,7 +843,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, display_on_the_fly = true; } immediate_quit = true; - QUIT; + maybe_quit (); } give_up: ; @@ -860,7 +860,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, wait_for_termination (pid, &status, fd0 < 0); #endif - immediate_quit = 0; + immediate_quit = false; /* Don't kill any children that the subprocess may have left behind when exiting. */ diff --git a/src/ccl.c b/src/ccl.c index c172fc6681..90bd2f4679 100644 --- a/src/ccl.c +++ b/src/ccl.c @@ -1993,7 +1993,7 @@ programs. */) : 0); ccl_driver (&ccl, NULL, NULL, 0, 0, Qnil); - QUIT; + maybe_quit (); if (ccl.status != CCL_STAT_SUCCESS) error ("Error in CCL program at %dth code", ccl.ic); diff --git a/src/decompress.c b/src/decompress.c index f6628d5ddd..a53a66df18 100644 --- a/src/decompress.c +++ b/src/decompress.c @@ -186,7 +186,7 @@ This function can be called only in unibyte buffers. */) decompressed = avail_out - stream.avail_out; insert_from_gap (decompressed, decompressed, 0); unwind_data.nbytes += decompressed; - QUIT; + maybe_quit (); } while (inflate_status == Z_OK); diff --git a/src/dired.c b/src/dired.c index bf10f1710f..52e81fb380 100644 --- a/src/dired.c +++ b/src/dired.c @@ -139,7 +139,7 @@ read_dirent (DIR *dir, Lisp_Object dirname) #endif report_file_error ("Reading directory", dirname); } - QUIT; + maybe_quit (); } } @@ -248,13 +248,13 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, /* Now that we have unwind_protect in place, we might as well allow matching to be interrupted. */ - immediate_quit = 1; - QUIT; + immediate_quit = true; + maybe_quit (); bool wanted = (NILP (match) || re_search (bufp, SSDATA (name), len, 0, len, 0) >= 0); - immediate_quit = 0; + immediate_quit = false; if (wanted) { @@ -508,7 +508,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, ptrdiff_t len = dirent_namelen (dp); bool canexclude = 0; - QUIT; + maybe_quit (); if (len < SCHARS (encoded_file) || (scmp (dp->d_name, SSDATA (encoded_file), SCHARS (encoded_file)) diff --git a/src/editfns.c b/src/editfns.c index 634aa1f63b..82c6abb998 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2695,7 +2695,7 @@ called interactively, INHERIT is t. */) string[i] = str[i % len]; while (n > stringlen) { - QUIT; + maybe_quit (); if (!NILP (inherit)) insert_and_inherit (string, stringlen); else diff --git a/src/eval.c b/src/eval.c index 734f01d81a..62d4af15e2 100644 --- a/src/eval.c +++ b/src/eval.c @@ -858,7 +858,7 @@ usage: (let* VARLIST BODY...) */) for (varlist = XCAR (args); CONSP (varlist); varlist = XCDR (varlist)) { - QUIT; + maybe_quit (); elt = XCAR (varlist); if (SYMBOLP (elt)) @@ -925,7 +925,7 @@ usage: (let VARLIST BODY...) */) for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist)) { - QUIT; + maybe_quit (); elt = XCAR (varlist); if (SYMBOLP (elt)) temps [argnum++] = Qnil; @@ -978,7 +978,7 @@ usage: (while TEST BODY...) */) body = XCDR (args); while (!NILP (eval_sub (test))) { - QUIT; + maybe_quit (); prog_ignore (body); } @@ -1011,7 +1011,7 @@ definitions to shadow the loaded ones for use in file byte-compilation. */) until we get a symbol that is not an alias. */ while (SYMBOLP (def)) { - QUIT; + maybe_quit (); sym = def; tem = Fassq (sym, environment); if (NILP (tem)) @@ -1131,7 +1131,7 @@ unwind_to_catch (struct handler *catch, Lisp_Object value) /* Restore certain special C variables. */ set_poll_suppress_count (catch->poll_suppress_count); unblock_input_to (catch->interrupt_input_blocked); - immediate_quit = 0; + immediate_quit = false; do { @@ -1514,10 +1514,10 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) Lisp_Object string; Lisp_Object real_error_symbol = (NILP (error_symbol) ? Fcar (data) : error_symbol); - register Lisp_Object clause = Qnil; + Lisp_Object clause = Qnil; struct handler *h; - immediate_quit = 0; + immediate_quit = false; if (gc_in_progress || waiting_for_input) emacs_abort (); @@ -2135,7 +2135,7 @@ eval_sub (Lisp_Object form) if (!CONSP (form)) return form; - QUIT; + maybe_quit (); maybe_gc (); @@ -2721,7 +2721,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) Lisp_Object val; ptrdiff_t count; - QUIT; + maybe_quit (); if (++lisp_eval_depth > max_lisp_eval_depth) { @@ -2966,7 +2966,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, bool previous_optional_or_rest = false; for (; CONSP (syms_left); syms_left = XCDR (syms_left)) { - QUIT; + maybe_quit (); next = XCAR (syms_left); if (!SYMBOLP (next)) diff --git a/src/fileio.c b/src/fileio.c index 8c8cba9e49..ac6d781941 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -316,7 +316,7 @@ use the standard functions without calling themselves recursively. */) } } - QUIT; + maybe_quit (); } return result; } @@ -1960,9 +1960,9 @@ permissions. */) report_file_error ("Copying permissions to", newname); } #else /* not WINDOWSNT */ - immediate_quit = 1; + immediate_quit = true; ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0); - immediate_quit = 0; + immediate_quit = false; if (ifd < 0) report_file_error ("Opening input file", file); @@ -2024,8 +2024,8 @@ permissions. */) oldsize = out_st.st_size; } - immediate_quit = 1; - QUIT; + immediate_quit = true; + maybe_quit (); if (clone_file (ofd, ifd)) newsize = st.st_size; @@ -2047,7 +2047,7 @@ permissions. */) if (newsize < oldsize && ftruncate (ofd, newsize) != 0) report_file_error ("Truncating output file", newname); - immediate_quit = 0; + immediate_quit = false; #ifndef MSDOS /* Preserve the original file permissions, and if requested, also its @@ -3393,13 +3393,13 @@ read_non_regular (Lisp_Object state) { int nbytes; - immediate_quit = 1; - QUIT; + immediate_quit = true; + maybe_quit (); nbytes = emacs_read (XSAVE_INTEGER (state, 0), ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE + XSAVE_INTEGER (state, 1)), XSAVE_INTEGER (state, 2)); - immediate_quit = 0; + immediate_quit = false; /* Fast recycle this object for the likely next call. */ free_misc (state); return make_number (nbytes); @@ -3858,8 +3858,8 @@ by calling `format-decode', which see. */) report_file_error ("Setting file position", orig_filename); } - immediate_quit = 1; - QUIT; + immediate_quit = true; + maybe_quit (); /* Count how many chars at the start of the file match the text at the beginning of the buffer. */ while (1) @@ -3910,7 +3910,7 @@ by calling `format-decode', which see. */) goto handled; } immediate_quit = true; - QUIT; + maybe_quit (); /* Count how many chars at the end of the file match the text at the end of the buffer. But, if we have already found that decoding is necessary, don't waste time. */ @@ -3967,7 +3967,7 @@ by calling `format-decode', which see. */) if (nread == 0) break; } - immediate_quit = 0; + immediate_quit = false; if (! giveup_match_end) { @@ -4065,11 +4065,11 @@ by calling `format-decode', which see. */) quitting while reading a huge file. */ /* Allow quitting out of the actual I/O. */ - immediate_quit = 1; - QUIT; + immediate_quit = true; + maybe_quit (); this = emacs_read (fd, read_buf + unprocessed, READ_BUF_SIZE - unprocessed); - immediate_quit = 0; + immediate_quit = false; if (this <= 0) break; @@ -4284,13 +4284,13 @@ by calling `format-decode', which see. */) /* Allow quitting out of the actual I/O. We don't make text part of the buffer until all the reading is done, so a C-g here doesn't do any harm. */ - immediate_quit = 1; - QUIT; + immediate_quit = true; + maybe_quit (); this = emacs_read (fd, ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE + inserted), trytry); - immediate_quit = 0; + immediate_quit = false; } if (this <= 0) @@ -4602,7 +4602,7 @@ by calling `format-decode', which see. */) } } - QUIT; + maybe_quit (); p = XCDR (p); } @@ -4992,7 +4992,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, } } - immediate_quit = 1; + immediate_quit = true; if (STRINGP (start)) ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding); @@ -5016,7 +5016,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, save_errno = errno; } - immediate_quit = 0; + immediate_quit = false; /* fsync is not crucial for temporary files. Nor for auto-save files, since they might lose some work anyway. */ diff --git a/src/filelock.c b/src/filelock.c index 886ab61c7a..de65c52efa 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -505,7 +505,7 @@ read_lock_data (char *lfname, char lfinfo[MAX_LFINFO + 1]) /* readlinkat saw a non-symlink, but emacs_open saw a symlink. The former must have been removed and replaced by the latter. Try again. */ - QUIT; + maybe_quit (); } return nbytes; diff --git a/src/fns.c b/src/fns.c index c175dd935d..b8ebfe5b2e 100644 --- a/src/fns.c +++ b/src/fns.c @@ -96,7 +96,7 @@ static void rarely_quit (unsigned short int *quit_count) { if (! (++*quit_count & (QUIT_COUNT_HEURISTIC - 1))) - QUIT; + maybe_quit (); } /* Random data-structure functions. */ @@ -132,7 +132,7 @@ To get the number of bytes, use `string-bytes'. */) { if (MOST_POSITIVE_FIXNUM < i) error ("List too long"); - QUIT; + maybe_quit (); } sequence = XCDR (sequence); } @@ -178,7 +178,7 @@ which is at least the number of distinct elements. */) halftail = XCDR (halftail); if ((lolen & (QUIT_COUNT_HEURISTIC - 1)) == 0) { - QUIT; + maybe_quit (); if (lolen == 0) hilen += UINTMAX_MAX + 1.0; } diff --git a/src/gnutls.c b/src/gnutls.c index 65b83bad6b..d0d7f2dfc8 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -390,7 +390,7 @@ gnutls_try_handshake (struct Lisp_Process *proc) { ret = gnutls_handshake (state); emacs_gnutls_handle_error (state, ret); - QUIT; + maybe_quit (); } while (ret < 0 && gnutls_error_is_fatal (ret) == 0 diff --git a/src/indent.c b/src/indent.c index 34449955a6..23951a16eb 100644 --- a/src/indent.c +++ b/src/indent.c @@ -1200,8 +1200,8 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos, continuation_glyph_width = 0; /* In the fringe. */ #endif - immediate_quit = 1; - QUIT; + immediate_quit = true; + maybe_quit (); /* It's just impossible to be too paranoid here. */ eassert (from == BYTE_TO_CHAR (frombyte) && frombyte == CHAR_TO_BYTE (from)); @@ -1694,7 +1694,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos, /* Nonzero if have just continued a line */ val_compute_motion.contin = (contin_hpos && prev_hpos == 0); - immediate_quit = 0; + immediate_quit = false; return &val_compute_motion; } diff --git a/src/insdel.c b/src/insdel.c index b93606ced8..3f933b0ad8 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -129,7 +129,7 @@ gap_left (ptrdiff_t charpos, ptrdiff_t bytepos, bool newgap) Change BYTEPOS to be where we have actually moved the gap to. Note that this cannot happen when we are called to make the gap larger or smaller, since make_gap_larger and - make_gap_smaller prevent QUIT by setting inhibit-quit. */ + make_gap_smaller set inhibit-quit. */ if (QUITP) { bytepos = new_s1; @@ -151,7 +151,7 @@ gap_left (ptrdiff_t charpos, ptrdiff_t bytepos, bool newgap) GPT = charpos; eassert (charpos <= bytepos); if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */ - QUIT; + maybe_quit (); } /* Move the gap to a position greater than the current GPT. @@ -185,7 +185,7 @@ gap_right (ptrdiff_t charpos, ptrdiff_t bytepos) Change BYTEPOS to be where we have actually moved the gap to. Note that this cannot happen when we are called to make the gap larger or smaller, since make_gap_larger and - make_gap_smaller prevent QUIT by setting inhibit-quit. */ + make_gap_smaller set inhibit-quit. */ if (QUITP) { bytepos = new_s1; @@ -204,7 +204,7 @@ gap_right (ptrdiff_t charpos, ptrdiff_t bytepos) GPT_BYTE = bytepos; eassert (charpos <= bytepos); if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */ - QUIT; + maybe_quit (); } /* If the selected window's old pointm is adjacent or covered by the @@ -464,7 +464,7 @@ make_gap_larger (ptrdiff_t nbytes_added) enlarge_buffer_text (current_buffer, nbytes_added); - /* Prevent quitting in gap_left. We cannot allow a QUIT there, + /* Prevent quitting in gap_left. We cannot allow a quit there, because that would leave the buffer text in an inconsistent state, with 2 gap holes instead of just one. */ tem = Vinhibit_quit; @@ -512,7 +512,7 @@ make_gap_smaller (ptrdiff_t nbytes_removed) if (GAP_SIZE - nbytes_removed < GAP_BYTES_MIN) nbytes_removed = GAP_SIZE - GAP_BYTES_MIN; - /* Prevent quitting in gap_right. We cannot allow a QUIT there, + /* Prevent quitting in gap_right. We cannot allow a quit there, because that would leave the buffer text in an inconsistent state, with 2 gap holes instead of just one. */ tem = Vinhibit_quit; diff --git a/src/keyboard.c b/src/keyboard.c index 6aad0acc65..d41603b2e5 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -87,7 +87,7 @@ char const DEV_TTY[] = "/dev/tty"; volatile int interrupt_input_blocked; /* True means an input interrupt or alarm signal has arrived. - The QUIT macro checks this. */ + The maybe_quit function checks this. */ volatile bool pending_signals; #define KBD_BUFFER_SIZE 4096 @@ -1416,7 +1416,7 @@ command_loop_1 (void) if (!NILP (Vquit_flag)) { Vexecuting_kbd_macro = Qt; - QUIT; /* Make some noise. */ + maybe_quit (); /* Make some noise. */ /* Will return since macro now empty. */ } } @@ -3591,7 +3591,7 @@ kbd_buffer_store_buffered_event (union buffered_input_event *event, if (immediate_quit && NILP (Vinhibit_quit)) { immediate_quit = false; - QUIT; + maybe_quit (); } } } @@ -7426,7 +7426,7 @@ menu_bar_items (Lisp_Object old) USE_SAFE_ALLOCA; /* In order to build the menus, we need to call the keymap - accessors. They all call QUIT. But this function is called + accessors. They all call maybe_quit. But this function is called during redisplay, during which a quit is fatal. So inhibit quitting while building the menus. We do this instead of specbind because (1) errors will clear it anyway @@ -7987,7 +7987,7 @@ tool_bar_items (Lisp_Object reuse, int *nitems) *nitems = 0; /* In order to build the menus, we need to call the keymap - accessors. They all call QUIT. But this function is called + accessors. They all call maybe_quit. But this function is called during redisplay, during which a quit is fatal. So inhibit quitting while building the menus. We do this instead of specbind because (1) errors will clear it anyway and (2) this @@ -9806,7 +9806,7 @@ read_key_sequence_vs (Lisp_Object prompt, Lisp_Object continue_echo, if (!NILP (prompt)) CHECK_STRING (prompt); - QUIT; + maybe_quit (); specbind (Qinput_method_exit_on_first_char, (NILP (cmd_loop) ? Qt : Qnil)); @@ -9840,7 +9840,7 @@ read_key_sequence_vs (Lisp_Object prompt, Lisp_Object continue_echo, if (i == -1) { Vquit_flag = Qt; - QUIT; + maybe_quit (); } return unbind_to (count, @@ -10278,7 +10278,7 @@ clear_waiting_for_input (void) If we have a frame on the controlling tty, we assume that the SIGINT was generated by C-g, so we call handle_interrupt. - Otherwise, tell QUIT to kill Emacs. */ + Otherwise, tell maybe_quit to kill Emacs. */ static void handle_interrupt_signal (int sig) @@ -10289,7 +10289,7 @@ handle_interrupt_signal (int sig) { /* If there are no frames there, let's pretend that we are a well-behaving UN*X program and quit. We must not call Lisp - in a signal handler, so tell QUIT to exit when it is + in a signal handler, so tell maybe_quit to exit when it is safe. */ Vquit_flag = Qkill_emacs; } diff --git a/src/keymap.c b/src/keymap.c index 9e75947851..9caf55f98f 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -523,7 +523,7 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx, retval = Fcons (Qkeymap, Fcons (retval, retval_tail)); } } - QUIT; + maybe_quit (); } return EQ (Qunbound, retval) ? get_keyelt (t_binding, autoload) : retval; @@ -877,7 +877,7 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def) should be inserted before it. */ goto keymap_end; - QUIT; + maybe_quit (); } keymap_end: @@ -1250,7 +1250,7 @@ recognize the default bindings, just as `read-key-sequence' does. */) if (!CONSP (keymap)) return make_number (idx); - QUIT; + maybe_quit (); } } @@ -2466,7 +2466,7 @@ where_is_internal (Lisp_Object definition, Lisp_Object keymaps, non-ascii prefixes like `C-down-mouse-2'. */ continue; - QUIT; + maybe_quit (); data.definition = definition; data.noindirect = noindirect; @@ -3173,7 +3173,7 @@ describe_map (Lisp_Object map, Lisp_Object prefix, for (tail = map; CONSP (tail); tail = XCDR (tail)) { - QUIT; + maybe_quit (); if (VECTORP (XCAR (tail)) || CHAR_TABLE_P (XCAR (tail))) @@ -3426,7 +3426,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args, int range_beg, range_end; Lisp_Object val; - QUIT; + maybe_quit (); if (i == stop) { diff --git a/src/lisp.h b/src/lisp.h index 01a08a05f2..84d53bb1ee 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3119,18 +3119,18 @@ struct handler extern Lisp_Object memory_signal_data; -/* Check quit-flag and quit if it is non-nil. - Typing C-g does not directly cause a quit; it only sets Vquit_flag. - So the program needs to do QUIT at times when it is safe to quit. - Every loop that might run for a long time or might not exit - ought to do QUIT at least once, at a safe place. - Unless that is impossible, of course. - But it is very desirable to avoid creating loops where QUIT is impossible. - - Exception: if you set immediate_quit to true, - then the handler that responds to the C-g does the quit itself. - This is a good thing to do around a loop that has no side effects - and (in particular) cannot call arbitrary Lisp code. +/* Check quit-flag and quit if it is non-nil. Typing C-g does not + directly cause a quit; it only sets Vquit_flag. So the program + needs to call maybe_quit at times when it is safe to quit. Every + loop that might run for a long time or might not exit ought to call + maybe_quit at least once, at a safe place. Unless that is + impossible, of course. But it is very desirable to avoid creating + loops where maybe_quit is impossible. + + Exception: if you set immediate_quit, the handler that responds to + the C-g does the quit itself. This is a good thing to do around a + loop that has no side effects and (in particular) cannot call + arbitrary Lisp code. If quit-flag is set to `kill-emacs' the SIGINT handler has received a request to exit Emacs when it is safe to do. @@ -3138,7 +3138,6 @@ extern Lisp_Object memory_signal_data; When not quitting, process any pending signals. */ extern void maybe_quit (void); -#define QUIT maybe_quit () /* True if ought to quit now. */ diff --git a/src/lread.c b/src/lread.c index 284fd1aafb..ea2a1d1d85 100644 --- a/src/lread.c +++ b/src/lread.c @@ -451,7 +451,7 @@ readbyte_from_file (int c, Lisp_Object readcharfun) while (c == EOF && ferror (instream) && errno == EINTR) { unblock_input (); - QUIT; + maybe_quit (); block_input (); clearerr (instream); c = getc (instream); @@ -1702,14 +1702,14 @@ build_load_history (Lisp_Object filename, bool entire) Fcons (newelt, XCDR (tem)))); tem2 = XCDR (tem2); - QUIT; + maybe_quit (); } } } else prev = tail; tail = XCDR (tail); - QUIT; + maybe_quit (); } /* If we're loading an entire file, cons the new assoc onto the diff --git a/src/macros.c b/src/macros.c index 3b29cc67cf..f0ffda3f44 100644 --- a/src/macros.c +++ b/src/macros.c @@ -325,7 +325,7 @@ each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */) executing_kbd_macro_iterations = ++success_count; - QUIT; + maybe_quit (); } while (--repeat && (STRINGP (Vexecuting_kbd_macro) || VECTORP (Vexecuting_kbd_macro))); diff --git a/src/minibuf.c b/src/minibuf.c index d44bb44bae..1bbe276776 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1865,7 +1865,7 @@ single string, rather than a cons cell whose car is a string. */) case_fold); if (EQ (tem, Qt)) return elt; - QUIT; + maybe_quit (); } return Qnil; } diff --git a/src/print.c b/src/print.c index dfaa489a98..36d68a452e 100644 --- a/src/print.c +++ b/src/print.c @@ -279,7 +279,7 @@ printchar (unsigned int ch, Lisp_Object fun) unsigned char str[MAX_MULTIBYTE_LENGTH]; int len = CHAR_STRING (ch, str); - QUIT; + maybe_quit (); if (NILP (fun)) { @@ -1352,7 +1352,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) max (sizeof " . #" + INT_STRLEN_BOUND (printmax_t), 40))]; - QUIT; + maybe_quit (); /* Detect circularities and truncate them. */ if (NILP (Vprint_circle)) @@ -1446,7 +1446,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) FETCH_STRING_CHAR_ADVANCE (c, obj, i, i_byte); - QUIT; + maybe_quit (); if (multibyte ? (CHAR_BYTE8_P (c) && (c = CHAR_TO_BYTE8 (c), true)) @@ -1550,7 +1550,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) /* Here, we must convert each multi-byte form to the corresponding character code before handing it to PRINTCHAR. */ FETCH_STRING_CHAR_ADVANCE (c, name, i, i_byte); - QUIT; + maybe_quit (); if (escapeflag) { @@ -1707,7 +1707,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) for (i = 0; i < size_in_chars; i++) { - QUIT; + maybe_quit (); c = bool_vector_uchar_data (obj)[i]; if (c == '\n' && print_escape_newlines) print_c_string ("\\n", printcharfun); diff --git a/src/process.c b/src/process.c index ab9657b15a..dbd4358dd1 100644 --- a/src/process.c +++ b/src/process.c @@ -3431,8 +3431,8 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, break; } - immediate_quit = 1; - QUIT; + immediate_quit = true; + maybe_quit (); ret = connect (s, sa, addrlen); xerrno = errno; @@ -3459,7 +3459,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, retry_select: FD_ZERO (&fdset); FD_SET (s, &fdset); - QUIT; + maybe_quit (); sc = pselect (s + 1, NULL, &fdset, NULL, NULL, NULL); if (sc == -1) { @@ -3481,7 +3481,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, } #endif /* !WINDOWSNT */ - immediate_quit = 0; + immediate_quit = false; /* Discard the unwind protect closing S. */ specpdl_ptr = specpdl + count; @@ -3539,7 +3539,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, #endif } - immediate_quit = 0; + immediate_quit = false; if (s < 0) { @@ -4012,8 +4012,8 @@ usage: (make-network-process &rest ARGS) */) struct addrinfo *res, *lres; int ret; - immediate_quit = 1; - QUIT; + immediate_quit = true; + maybe_quit (); struct addrinfo hints; memset (&hints, 0, sizeof hints); @@ -4034,7 +4034,7 @@ usage: (make-network-process &rest ARGS) */) #else error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret); #endif - immediate_quit = 0; + immediate_quit = false; for (lres = res; lres; lres = lres->ai_next) addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos); @@ -5020,7 +5020,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, since we want to return C-g as an input character. Otherwise, do pending quit if requested. */ if (read_kbd >= 0) - QUIT; + maybe_quit (); else if (pending_signals) process_pending_signals (); @@ -5748,7 +5748,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, { /* Prevent input_pending from remaining set if we quit. */ clear_input_pending (); - QUIT; + maybe_quit (); } return got_some_output; @@ -7486,7 +7486,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, since we want to return C-g as an input character. Otherwise, do pending quit if requested. */ if (read_kbd >= 0) - QUIT; + maybe_quit (); /* Exit now if the cell we're waiting for became non-nil. */ if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell))) diff --git a/src/profiler.c b/src/profiler.c index efc0cb316f..88825bebdb 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -174,8 +174,8 @@ record_backtrace (log_t *log, EMACS_INT count) some global flag so that some Elisp code can offload its data elsewhere, so as to avoid the eviction code. There are 2 ways to do that, AFAICT: - - Set a flag checked in QUIT, such that QUIT can then call - Fprofiler_cpu_log and stash the full log for later use. + - Set a flag checked in maybe_quit, such that maybe_quit can then + call Fprofiler_cpu_log and stash the full log for later use. - Set a flag check in post-gc-hook, so that Elisp code can call profiler-cpu-log. That gives us more flexibility since that Elisp code can then do all kinds of fun stuff like write diff --git a/src/regex.c b/src/regex.c index db3f0c16a2..f6e67afef4 100644 --- a/src/regex.c +++ b/src/regex.c @@ -1729,12 +1729,9 @@ typedef struct /* Explicit quit checking is needed for Emacs, which uses polling to process input events. */ #ifdef emacs -# define IMMEDIATE_QUIT_CHECK \ - do { \ - if (immediate_quit) QUIT; \ - } while (0) +# define IMMEDIATE_QUIT_CHECK (immediate_quit ? maybe_quit () : (void) 0) #else -# define IMMEDIATE_QUIT_CHECK ((void)0) +# define IMMEDIATE_QUIT_CHECK ((void) 0) #endif /* Structure to manage work area for range table. */ diff --git a/src/search.c b/src/search.c index d304510870..f54f44c881 100644 --- a/src/search.c +++ b/src/search.c @@ -276,8 +276,9 @@ looking_at_1 (Lisp_Object string, bool posix) posix, !NILP (BVAR (current_buffer, enable_multibyte_characters))); - immediate_quit = 1; - QUIT; /* Do a pending quit right away, to avoid paradoxical behavior */ + /* Do a pending quit right away, to avoid paradoxical behavior */ + immediate_quit = true; + maybe_quit (); /* Get pointers and sizes of the two strings that make up the visible portion of the buffer. */ @@ -310,7 +311,7 @@ looking_at_1 (Lisp_Object string, bool posix) (NILP (Vinhibit_changing_match_data) ? &search_regs : NULL), ZV_BYTE - BEGV_BYTE); - immediate_quit = 0; + immediate_quit = false; #ifdef REL_ALLOC r_alloc_inhibit_buffer_relocation (0); #endif @@ -398,7 +399,7 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, ? BVAR (current_buffer, case_canon_table) : Qnil), posix, STRING_MULTIBYTE (string)); - immediate_quit = 1; + immediate_quit = true; re_match_object = string; val = re_search (bufp, SSDATA (string), @@ -406,7 +407,7 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, SBYTES (string) - pos_byte, (NILP (Vinhibit_changing_match_data) ? &search_regs : NULL)); - immediate_quit = 0; + immediate_quit = false; /* Set last_thing_searched only when match data is changed. */ if (NILP (Vinhibit_changing_match_data)) @@ -470,13 +471,13 @@ fast_string_match_internal (Lisp_Object regexp, Lisp_Object string, bufp = compile_pattern (regexp, 0, table, 0, STRING_MULTIBYTE (string)); - immediate_quit = 1; + immediate_quit = true; re_match_object = string; val = re_search (bufp, SSDATA (string), SBYTES (string), 0, SBYTES (string), 0); - immediate_quit = 0; + immediate_quit = false; return val; } @@ -497,9 +498,9 @@ fast_c_string_match_ignore_case (Lisp_Object regexp, bufp = compile_pattern (regexp, 0, Vascii_canon_table, 0, 0); - immediate_quit = 1; + immediate_quit = true; val = re_search (bufp, string, len, 0, len, 0); - immediate_quit = 0; + immediate_quit = false; return val; } @@ -560,7 +561,7 @@ fast_looking_at (Lisp_Object regexp, ptrdiff_t pos, ptrdiff_t pos_byte, } buf = compile_pattern (regexp, 0, Qnil, 0, multibyte); - immediate_quit = 1; + immediate_quit = true; #ifdef REL_ALLOC /* Prevent ralloc.c from relocating the current buffer while searching it. */ @@ -571,7 +572,7 @@ fast_looking_at (Lisp_Object regexp, ptrdiff_t pos, ptrdiff_t pos_byte, #ifdef REL_ALLOC r_alloc_inhibit_buffer_relocation (0); #endif - immediate_quit = 0; + immediate_quit = false; return len; } @@ -703,7 +704,7 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, ptrdiff_t next_change; int result = 1; - immediate_quit = 0; + immediate_quit = false; while (start < end && result) { ptrdiff_t lim1; @@ -809,7 +810,7 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, if (--count == 0) { - immediate_quit = 0; + immediate_quit = false; if (bytepos) *bytepos = lim_byte + next; return BYTE_TO_CHAR (lim_byte + next); @@ -832,7 +833,7 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, ptrdiff_t next_change; int result = 1; - immediate_quit = 0; + immediate_quit = false; while (start > end && result) { ptrdiff_t lim1; @@ -917,7 +918,7 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, if (++count >= 0) { - immediate_quit = 0; + immediate_quit = false; if (bytepos) *bytepos = ceiling_byte + prev + 1; return BYTE_TO_CHAR (ceiling_byte + prev + 1); @@ -929,7 +930,7 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, } } - immediate_quit = 0; + immediate_quit = false; if (shortage) *shortage = count * direction; if (bytepos) @@ -1196,10 +1197,10 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, trt, posix, !NILP (BVAR (current_buffer, enable_multibyte_characters))); - immediate_quit = 1; /* Quit immediately if user types ^G, + immediate_quit = true; /* Quit immediately if user types ^G, because letting this function finish can take too long. */ - QUIT; /* Do a pending quit right away, + maybe_quit (); /* Do a pending quit right away, to avoid paradoxical behavior */ /* Get pointers and sizes of the two strings that make up the visible portion of the buffer. */ @@ -1267,7 +1268,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, } else { - immediate_quit = 0; + immediate_quit = false; #ifdef REL_ALLOC r_alloc_inhibit_buffer_relocation (0); #endif @@ -1312,7 +1313,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, } else { - immediate_quit = 0; + immediate_quit = false; #ifdef REL_ALLOC r_alloc_inhibit_buffer_relocation (0); #endif @@ -1320,7 +1321,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, } n--; } - immediate_quit = 0; + immediate_quit = false; #ifdef REL_ALLOC r_alloc_inhibit_buffer_relocation (0); #endif @@ -1927,7 +1928,7 @@ boyer_moore (EMACS_INT n, unsigned char *base_pat, < 0) return (n * (0 - direction)); /* First we do the part we can by pointers (maybe nothing) */ - QUIT; + maybe_quit (); pat = base_pat; limit = pos_byte - dirlen + direction; if (direction > 0) @@ -3274,7 +3275,7 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, if (--count == 0) { - immediate_quit = 0; + immediate_quit = false; if (bytepos) *bytepos = lim_byte + next; return BYTE_TO_CHAR (lim_byte + next); @@ -3286,7 +3287,7 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, } } - immediate_quit = 0; + immediate_quit = false; if (shortage) *shortage = count; if (bytepos) diff --git a/src/syntax.c b/src/syntax.c index 0ee1c746ec..f9e4093765 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -1426,8 +1426,8 @@ scan_words (register ptrdiff_t from, register EMACS_INT count) int ch0, ch1; Lisp_Object func, pos; - immediate_quit = 1; - QUIT; + immediate_quit = true; + maybe_quit (); SETUP_SYNTAX_TABLE (from, count); @@ -1437,7 +1437,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count) { if (from == end) { - immediate_quit = 0; + immediate_quit = false; return 0; } UPDATE_SYNTAX_TABLE_FORWARD (from); @@ -1487,7 +1487,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count) { if (from == beg) { - immediate_quit = 0; + immediate_quit = false; return 0; } DEC_BOTH (from, from_byte); @@ -1536,7 +1536,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count) count++; } - immediate_quit = 0; + immediate_quit = false; return from; } @@ -1921,7 +1921,7 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, stop = (pos >= GPT && GPT > XINT (lim)) ? GAP_END_ADDR : endp; } - immediate_quit = 1; + immediate_quit = true; /* This code may look up syntax tables using functions that rely on the gl_state object. To make sure this object is not out of date, let's initialize it manually. @@ -2064,7 +2064,7 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, } SET_PT_BOTH (pos, pos_byte); - immediate_quit = 0; + immediate_quit = false; SAFE_FREE (); return make_number (PT - start_point); @@ -2138,7 +2138,7 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim) ptrdiff_t pos_byte = PT_BYTE; unsigned char *p, *endp, *stop; - immediate_quit = 1; + immediate_quit = true; SETUP_SYNTAX_TABLE (pos, forwardp ? 1 : -1); if (forwardp) @@ -2224,7 +2224,7 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim) done: SET_PT_BOTH (pos, pos_byte); - immediate_quit = 0; + immediate_quit = false; return make_number (PT - start_point); } @@ -2412,8 +2412,8 @@ between them, return t; otherwise return nil. */) count1 = XINT (count); stop = count1 > 0 ? ZV : BEGV; - immediate_quit = 1; - QUIT; + immediate_quit = true; + maybe_quit (); from = PT; from_byte = PT_BYTE; @@ -2429,7 +2429,7 @@ between them, return t; otherwise return nil. */) if (from == stop) { SET_PT_BOTH (from, from_byte); - immediate_quit = 0; + immediate_quit = false; return Qnil; } c = FETCH_CHAR_AS_MULTIBYTE (from_byte); @@ -2463,7 +2463,7 @@ between them, return t; otherwise return nil. */) comstyle = ST_COMMENT_STYLE; else if (code != Scomment) { - immediate_quit = 0; + immediate_quit = false; DEC_BOTH (from, from_byte); SET_PT_BOTH (from, from_byte); return Qnil; @@ -2474,7 +2474,7 @@ between them, return t; otherwise return nil. */) from = out_charpos; from_byte = out_bytepos; if (!found) { - immediate_quit = 0; + immediate_quit = false; SET_PT_BOTH (from, from_byte); return Qnil; } @@ -2494,7 +2494,7 @@ between them, return t; otherwise return nil. */) if (from <= stop) { SET_PT_BOTH (BEGV, BEGV_BYTE); - immediate_quit = 0; + immediate_quit = false; return Qnil; } @@ -2587,7 +2587,7 @@ between them, return t; otherwise return nil. */) else if (code != Swhitespace || quoted) { leave: - immediate_quit = 0; + immediate_quit = false; INC_BOTH (from, from_byte); SET_PT_BOTH (from, from_byte); return Qnil; @@ -2598,7 +2598,7 @@ between them, return t; otherwise return nil. */) } SET_PT_BOTH (from, from_byte); - immediate_quit = 0; + immediate_quit = false; return Qt; } @@ -2640,8 +2640,8 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) from_byte = CHAR_TO_BYTE (from); - immediate_quit = 1; - QUIT; + immediate_quit = true; + maybe_quit (); SETUP_SYNTAX_TABLE (from, count); while (count > 0) @@ -2801,7 +2801,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) if (depth) goto lose; - immediate_quit = 0; + immediate_quit = false; return Qnil; /* End of object reached */ @@ -2984,7 +2984,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) if (depth) goto lose; - immediate_quit = 0; + immediate_quit = false; return Qnil; done2: @@ -2992,7 +2992,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) } - immediate_quit = 0; + immediate_quit = false; XSETFASTINT (val, from); return val; @@ -3173,8 +3173,8 @@ do { prev_from = from; \ UPDATE_SYNTAX_TABLE_FORWARD (from); \ } while (0) - immediate_quit = 1; - QUIT; + immediate_quit = true; + maybe_quit (); depth = state->depth; start_quoted = state->quoted; @@ -3432,7 +3432,7 @@ do { prev_from = from; \ state->levelstarts); state->prev_syntax = (SYNTAX_FLAGS_COMSTARTEND_FIRST (prev_from_syntax) || state->quoted) ? prev_from_syntax : Smax; - immediate_quit = 0; + immediate_quit = false; } /* Convert a (lisp) parse state to the internal form used in diff --git a/src/sysdep.c b/src/sysdep.c index 4316c21a1c..e172dc0aed 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -391,10 +391,10 @@ get_child_status (pid_t child, int *status, int options, bool interruptible) if (errno != EINTR) emacs_abort (); - /* Note: the MS-Windows emulation of waitpid calls QUIT + /* Note: the MS-Windows emulation of waitpid calls maybe_quit internally. */ if (interruptible) - QUIT; + maybe_quit (); } /* If successful and status is requested, tell wait_reading_process_output @@ -2383,7 +2383,7 @@ emacs_open (const char *file, int oflags, int mode) oflags |= O_BINARY; oflags |= O_CLOEXEC; while ((fd = open (file, oflags, mode)) < 0 && errno == EINTR) - QUIT; + maybe_quit (); if (! O_CLOEXEC && 0 <= fd) fcntl (fd, F_SETFD, FD_CLOEXEC); return fd; @@ -2516,7 +2516,7 @@ emacs_read (int fildes, void *buf, ptrdiff_t nbyte) while ((rtnval = read (fildes, buf, nbyte)) == -1 && (errno == EINTR)) - QUIT; + maybe_quit (); return (rtnval); } @@ -2538,7 +2538,7 @@ emacs_full_write (int fildes, char const *buf, ptrdiff_t nbyte, { if (errno == EINTR) { - /* I originally used `QUIT' but that might cause files to + /* I originally used maybe_quit but that might cause files to be truncated if you hit C-g in the middle of it. --Stef */ if (process_signals && pending_signals) process_pending_signals (); diff --git a/src/textprop.c b/src/textprop.c index 7cb3d3c38e..225ff28e57 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -211,7 +211,7 @@ validate_plist (Lisp_Object list) if (! CONSP (tail)) error ("Odd length text property list"); tail = XCDR (tail); - QUIT; + maybe_quit (); } while (CONSP (tail)); diff --git a/src/w32fns.c b/src/w32fns.c index c24fce11fc..6a576fcec2 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -778,7 +778,7 @@ w32_color_map_lookup (const char *colorname) break; } - QUIT; + maybe_quit (); } unblock_input (); @@ -3166,7 +3166,7 @@ signal_user_input (void) if (!NILP (Vthrow_on_input)) { Vquit_flag = Vthrow_on_input; - /* Doing a QUIT from this thread is a bad idea, since this + /* Calling maybe_quit from this thread is a bad idea, since this unwinds the stack of the Lisp thread, and the Windows runtime rightfully barfs. Disabled. */ #if 0 @@ -3174,8 +3174,8 @@ signal_user_input (void) do it now. */ if (immediate_quit && NILP (Vinhibit_quit)) { - immediate_quit = 0; - QUIT; + immediate_quit = false; + maybe_quit (); } #endif } diff --git a/src/w32notify.c b/src/w32notify.c index 1f4cbe2df4..25205816ba 100644 --- a/src/w32notify.c +++ b/src/w32notify.c @@ -664,7 +664,7 @@ w32_get_watch_object (void *desc) Lisp_Object descriptor = make_pointer_integer (desc); /* This is called from the input queue handling code, inside a - critical section, so we cannot possibly QUIT if watch_list is not + critical section, so we cannot possibly quit if watch_list is not in the right condition. */ return NILP (watch_list) ? Qnil : assoc_no_quit (descriptor, watch_list); } diff --git a/src/w32proc.c b/src/w32proc.c index a7f2b4a995..0aa248a6f7 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -1449,7 +1449,7 @@ waitpid (pid_t pid, int *status, int options) do { - QUIT; + maybe_quit (); active = WaitForMultipleObjects (nh, wait_hnd, FALSE, timeout_ms); } while (active == WAIT_TIMEOUT && !dont_wait); diff --git a/src/window.c b/src/window.c index 0a6b94d4d1..71a82b522c 100644 --- a/src/window.c +++ b/src/window.c @@ -521,9 +521,10 @@ select_window (Lisp_Object window, Lisp_Object norecord, bset_last_selected_window (XBUFFER (w->contents), window); record_and_return: - /* record_buffer can run QUIT, so make sure it is run only after we have - re-established the invariant between selected_window and selected_frame, - otherwise the temporary broken invariant might "escape" (bug#14161). */ + /* record_buffer can call maybe_quit, so make sure it is run only + after we have re-established the invariant between + selected_window and selected_frame, otherwise the temporary + broken invariant might "escape" (Bug#14161). */ if (NILP (norecord)) { w->use_time = ++window_select_count; diff --git a/src/xdisp.c b/src/xdisp.c index 168922ef06..33661c882c 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -22635,7 +22635,7 @@ move_elt_to_front (Lisp_Object elt, Lisp_Object list) else prev = tail; tail = XCDR (tail); - QUIT; + maybe_quit (); } /* Not found--return unchanged LIST. */ diff --git a/src/xselect.c b/src/xselect.c index 47ccf6886b..2249828fb4 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -329,7 +329,7 @@ x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value, Fcons (selection_data, dpyinfo->terminal->Vselection_alist)); /* If we already owned the selection, remove the old selection - data. Don't use Fdelq as that may QUIT. */ + data. Don't use Fdelq as that may quit. */ if (!NILP (prev_value)) { /* We know it's not the CAR, so it's easy. */ @@ -929,7 +929,7 @@ x_handle_selection_clear (struct selection_input_event *event) && local_selection_time > changed_owner_time) return; - /* Otherwise, really clear. Don't use Fdelq as that may QUIT;. */ + /* Otherwise, really clear. Don't use Fdelq as that may quit. */ Vselection_alist = dpyinfo->terminal->Vselection_alist; if (EQ (local_selection_data, CAR (Vselection_alist))) Vselection_alist = XCDR (Vselection_alist); diff --git a/src/xterm.c b/src/xterm.c index db561c902a..80cf8ce191 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -635,7 +635,7 @@ x_cr_export_frames (Lisp_Object frames, cairo_surface_type_t surface_type) (*surface_set_size_func) (surface, width, height); unblock_input (); - QUIT; + maybe_quit (); block_input (); } commit 1392ec7420ee23238a1588b759c631d87a677483 Author: Paul Eggert Date: Wed Jan 25 20:27:45 2017 -0800 A quicker check for quit On some microbenchmarks this lets Emacs run 60% faster on my platform (AMD Phenom II X4 910e, Fedora 25 x86-64). * src/atimer.c: Include keyboard.h, for pending_signals. * src/editfns.c (Fcompare_buffer_substrings): * src/fns.c (Fnthcdr, Fmemq, Fmemql, Fassq, Frassq, Fplist_put) (Fnconc, Fplist_member): Set and clear immediate_quit before and after loop instead of executing QUIT each time through the loop. This is OK for loops that affect only locals. * src/eval.c (process_quit_flag): Now static. (maybe_quit): New function, containing QUIT’s old body. * src/fns.c (rarely_quit): New function. (Fmember, Fassoc, Frassoc, Fdelete, Fnreverse, Freverse) (Flax_plist_get, Flax_plist_put, internal_equal, Fnconc): Use it instead of QUIT, for speed in tight loops that might modify non-locals. * src/keyboard.h (pending_signals, process_pending_signals): These belong to keyboard.c, so move them here ... * src/lisp.h: ... from here. (QUIT): Redefine in terms of the new maybe_quit function, which contains this macro’s old definiens. This works well with branch prediction on processors with return stack buffers, e.g., x86 other than the original Pentium. diff --git a/src/atimer.c b/src/atimer.c index 7f099809d3..5feb1f6777 100644 --- a/src/atimer.c +++ b/src/atimer.c @@ -20,6 +20,7 @@ along with GNU Emacs. If not, see . */ #include #include "lisp.h" +#include "keyboard.h" #include "syssignal.h" #include "systime.h" #include "atimer.h" diff --git a/src/editfns.c b/src/editfns.c index bee3bbc2cd..634aa1f63b 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3053,6 +3053,7 @@ determines whether case is significant or ignored. */) i2 = begp2; i1_byte = buf_charpos_to_bytepos (bp1, i1); i2_byte = buf_charpos_to_bytepos (bp2, i2); + immediate_quit = true; while (i1 < endp1 && i2 < endp2) { @@ -3060,8 +3061,6 @@ determines whether case is significant or ignored. */) characters, not just the bytes. */ int c1, c2; - QUIT; - if (! NILP (BVAR (bp1, enable_multibyte_characters))) { c1 = BUF_FETCH_MULTIBYTE_CHAR (bp1, i1_byte); @@ -3093,14 +3092,17 @@ determines whether case is significant or ignored. */) c1 = char_table_translate (trt, c1); c2 = char_table_translate (trt, c2); } - if (c1 < c2) - return make_number (- 1 - chars); - if (c1 > c2) - return make_number (chars + 1); + if (c1 != c2) + { + immediate_quit = false; + return make_number (c1 < c2 ? -1 - chars : chars + 1); + } chars++; } + immediate_quit = false; + /* The strings match as far as they go. If one is shorter, that one is less. */ if (chars < endp1 - begp1) diff --git a/src/eval.c b/src/eval.c index 01e3db4408..734f01d81a 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1450,7 +1450,7 @@ static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object); static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data); -void +static void process_quit_flag (void) { Lisp_Object flag = Vquit_flag; @@ -1462,6 +1462,15 @@ process_quit_flag (void) quit (); } +void +maybe_quit (void) +{ + if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) + process_quit_flag (); + else if (pending_signals) + process_pending_signals (); +} + DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA. This function does not return. diff --git a/src/fns.c b/src/fns.c index c65a731f32..c175dd935d 100644 --- a/src/fns.c +++ b/src/fns.c @@ -84,9 +84,21 @@ See Info node `(elisp)Random Numbers' for more details. */) } /* Heuristic on how many iterations of a tight loop can be safely done - before it's time to do a QUIT. This must be a power of 2. */ + before it's time to do a quit. This must be a power of 2. It + is nice but not necessary for it to equal USHRT_MAX + 1. */ enum { QUIT_COUNT_HEURISTIC = 1 << 16 }; +/* Process a quit, but do it only rarely, for efficiency. "Rarely" + means once per QUIT_COUNT_HEURISTIC or per USHRT_MAX + 1 times, + whichever is smaller. Use *QUIT_COUNT to count this. */ + +static void +rarely_quit (unsigned short int *quit_count) +{ + if (! (++*quit_count & (QUIT_COUNT_HEURISTIC - 1))) + QUIT; +} + /* Random data-structure functions. */ DEFUN ("length", Flength, Slength, 1, 1, 0, @@ -1348,16 +1360,18 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0, CHECK_NUMBER (n); EMACS_INT num = XINT (n); Lisp_Object tail = list; + immediate_quit = true; for (EMACS_INT i = 0; i < num; i++) { if (! CONSP (tail)) { + immediate_quit = false; CHECK_LIST_END (tail, list); return Qnil; } tail = XCDR (tail); - QUIT; } + immediate_quit = false; return tail; } @@ -1387,12 +1401,13 @@ DEFUN ("member", Fmember, Smember, 2, 2, 0, The value is actually the tail of LIST whose car is ELT. */) (Lisp_Object elt, Lisp_Object list) { + unsigned short int quit_count = 0; Lisp_Object tail; for (tail = list; CONSP (tail); tail = XCDR (tail)) { if (! NILP (Fequal (elt, XCAR (tail)))) return tail; - QUIT; + rarely_quit (&quit_count); } CHECK_LIST_END (tail, list); return Qnil; @@ -1403,13 +1418,17 @@ DEFUN ("memq", Fmemq, Smemq, 2, 2, 0, The value is actually the tail of LIST whose car is ELT. */) (Lisp_Object elt, Lisp_Object list) { + immediate_quit = true; Lisp_Object tail; for (tail = list; CONSP (tail); tail = XCDR (tail)) { if (EQ (XCAR (tail), elt)) - return tail; - QUIT; + { + immediate_quit = false; + return tail; + } } + immediate_quit = false; CHECK_LIST_END (tail, list); return Qnil; } @@ -1422,14 +1441,18 @@ The value is actually the tail of LIST whose car is ELT. */) if (!FLOATP (elt)) return Fmemq (elt, list); + immediate_quit = true; Lisp_Object tail; for (tail = list; CONSP (tail); tail = XCDR (tail)) { Lisp_Object tem = XCAR (tail); if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil)) - return tail; - QUIT; + { + immediate_quit = false; + return tail; + } } + immediate_quit = false; CHECK_LIST_END (tail, list); return Qnil; } @@ -1440,13 +1463,15 @@ The value is actually the first element of LIST whose car is KEY. Elements of LIST that are not conses are ignored. */) (Lisp_Object key, Lisp_Object list) { + immediate_quit = true; Lisp_Object tail; for (tail = list; CONSP (tail); tail = XCDR (tail)) - { - if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key)) + if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key)) + { + immediate_quit = false; return XCAR (tail); - QUIT; - } + } + immediate_quit = true; CHECK_LIST_END (tail, list); return Qnil; } @@ -1468,6 +1493,7 @@ DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0, The value is actually the first element of LIST whose car equals KEY. */) (Lisp_Object key, Lisp_Object list) { + unsigned short int quit_count = 0; Lisp_Object tail; for (tail = list; CONSP (tail); tail = XCDR (tail)) { @@ -1475,7 +1501,7 @@ The value is actually the first element of LIST whose car equals KEY. */) if (CONSP (car) && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key)))) return car; - QUIT; + rarely_quit (&quit_count); } CHECK_LIST_END (tail, list); return Qnil; @@ -1502,13 +1528,15 @@ DEFUN ("rassq", Frassq, Srassq, 2, 2, 0, The value is actually the first element of LIST whose cdr is KEY. */) (Lisp_Object key, Lisp_Object list) { + immediate_quit = true; Lisp_Object tail; for (tail = list; CONSP (tail); tail = XCDR (tail)) - { - if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key)) + if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key)) + { + immediate_quit = false; return XCAR (tail); - QUIT; - } + } + immediate_quit = true; CHECK_LIST_END (tail, list); return Qnil; } @@ -1518,6 +1546,7 @@ DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0, The value is actually the first element of LIST whose cdr equals KEY. */) (Lisp_Object key, Lisp_Object list) { + unsigned short int quit_count = 0; Lisp_Object tail; for (tail = list; CONSP (tail); tail = XCDR (tail)) { @@ -1525,7 +1554,7 @@ The value is actually the first element of LIST whose cdr equals KEY. */) if (CONSP (car) && (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key)))) return car; - QUIT; + rarely_quit (&quit_count); } CHECK_LIST_END (tail, list); return Qnil; @@ -1666,6 +1695,7 @@ changing the value of a sequence `foo'. */) } else { + unsigned short int quit_count = 0; Lisp_Object tail, prev; for (tail = seq, prev = Qnil; CONSP (tail); tail = XCDR (tail)) @@ -1679,7 +1709,7 @@ changing the value of a sequence `foo'. */) } else prev = tail; - QUIT; + rarely_quit (&quit_count); } CHECK_LIST_END (tail, seq); } @@ -1699,11 +1729,12 @@ This function may destructively modify SEQ to produce the value. */) return Freverse (seq); else if (CONSP (seq)) { + unsigned short int quit_count = 0; Lisp_Object prev, tail, next; for (prev = Qnil, tail = seq; CONSP (tail); tail = next) { - QUIT; + rarely_quit (&quit_count); next = XCDR (tail); Fsetcdr (tail, prev); prev = tail; @@ -1749,9 +1780,10 @@ See also the function `nreverse', which is used more often. */) return Qnil; else if (CONSP (seq)) { + unsigned short int quit_count = 0; for (new = Qnil; CONSP (seq); seq = XCDR (seq)) { - QUIT; + rarely_quit (&quit_count); new = Fcons (XCAR (seq), new); } CHECK_LIST_END (seq, seq); @@ -2041,28 +2073,28 @@ If PROP is already a property on the list, its value is set to VAL, otherwise the new PROP VAL pair is added. The new plist is returned; use `(setq x (plist-put x prop val))' to be sure to use the new value. The PLIST is modified by side effects. */) - (Lisp_Object plist, register Lisp_Object prop, Lisp_Object val) + (Lisp_Object plist, Lisp_Object prop, Lisp_Object val) { - register Lisp_Object tail, prev; - Lisp_Object newcell; - prev = Qnil; - for (tail = plist; CONSP (tail) && CONSP (XCDR (tail)); + immediate_quit = true; + Lisp_Object prev = Qnil; + for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail)); tail = XCDR (XCDR (tail))) { if (EQ (prop, XCAR (tail))) { + immediate_quit = false; Fsetcar (XCDR (tail), val); return plist; } prev = tail; - QUIT; } - newcell = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev)))); + immediate_quit = true; + Lisp_Object newcell + = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev)))); if (NILP (prev)) return newcell; - else - Fsetcdr (XCDR (prev), newcell); + Fsetcdr (XCDR (prev), newcell); return plist; } @@ -2085,6 +2117,7 @@ corresponding to the given PROP, or nil if PROP is not one of the properties on the list. */) (Lisp_Object plist, Lisp_Object prop) { + unsigned short int quit_count = 0; Lisp_Object tail; for (tail = plist; @@ -2093,8 +2126,7 @@ one of the properties on the list. */) { if (! NILP (Fequal (prop, XCAR (tail)))) return XCAR (XCDR (tail)); - - QUIT; + rarely_quit (&quit_count); } CHECK_LIST_END (tail, prop); @@ -2110,12 +2142,11 @@ If PROP is already a property on the list, its value is set to VAL, otherwise the new PROP VAL pair is added. The new plist is returned; use `(setq x (lax-plist-put x prop val))' to be sure to use the new value. The PLIST is modified by side effects. */) - (Lisp_Object plist, register Lisp_Object prop, Lisp_Object val) + (Lisp_Object plist, Lisp_Object prop, Lisp_Object val) { - register Lisp_Object tail, prev; - Lisp_Object newcell; - prev = Qnil; - for (tail = plist; CONSP (tail) && CONSP (XCDR (tail)); + unsigned short int quit_count = 0; + Lisp_Object prev = Qnil; + for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail)); tail = XCDR (XCDR (tail))) { if (! NILP (Fequal (prop, XCAR (tail)))) @@ -2125,13 +2156,12 @@ The PLIST is modified by side effects. */) } prev = tail; - QUIT; + rarely_quit (&quit_count); } - newcell = list2 (prop, val); + Lisp_Object newcell = list2 (prop, val); if (NILP (prev)) return newcell; - else - Fsetcdr (XCDR (prev), newcell); + Fsetcdr (XCDR (prev), newcell); return plist; } @@ -2204,8 +2234,9 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props, } } + unsigned short int quit_count = 0; tail_recurse: - QUIT; + rarely_quit (&quit_count); if (EQ (o1, o2)) return 1; if (XTYPE (o1) != XTYPE (o2)) @@ -2394,14 +2425,12 @@ Only the last argument is not altered, and need not be a list. usage: (nconc &rest LISTS) */) (ptrdiff_t nargs, Lisp_Object *args) { - ptrdiff_t argnum; - register Lisp_Object tail, tem, val; + unsigned short int quit_count = 0; + Lisp_Object val = Qnil; - val = tail = Qnil; - - for (argnum = 0; argnum < nargs; argnum++) + for (ptrdiff_t argnum = 0; argnum < nargs; argnum++) { - tem = args[argnum]; + Lisp_Object tem = args[argnum]; if (NILP (tem)) continue; if (NILP (val)) @@ -2411,14 +2440,18 @@ usage: (nconc &rest LISTS) */) CHECK_CONS (tem); + immediate_quit = true; + Lisp_Object tail; do { tail = tem; tem = XCDR (tail); - QUIT; } while (CONSP (tem)); + immediate_quit = false; + rarely_quit (&quit_count); + tem = args[argnum + 1]; Fsetcdr (tail, tem); if (NILP (tem)) @@ -2839,12 +2872,13 @@ property and a property with the value nil. The value is actually the tail of PLIST whose car is PROP. */) (Lisp_Object plist, Lisp_Object prop) { + immediate_quit = true; while (CONSP (plist) && !EQ (XCAR (plist), prop)) { plist = XCDR (plist); plist = CDR (plist); - QUIT; } + immediate_quit = false; return plist; } diff --git a/src/keyboard.h b/src/keyboard.h index 7cd41ae55b..2219c01135 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -486,6 +486,8 @@ extern bool kbd_buffer_events_waiting (void); extern void add_user_signal (int, const char *); extern int tty_read_avail_input (struct terminal *, struct input_event *); +extern bool volatile pending_signals; +extern void process_pending_signals (void); extern struct timespec timer_check (void); extern void mark_kboards (void); diff --git a/src/lisp.h b/src/lisp.h index 7e91824993..01a08a05f2 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3133,20 +3133,12 @@ extern Lisp_Object memory_signal_data; and (in particular) cannot call arbitrary Lisp code. If quit-flag is set to `kill-emacs' the SIGINT handler has received - a request to exit Emacs when it is safe to do. */ + a request to exit Emacs when it is safe to do. -extern void process_pending_signals (void); -extern bool volatile pending_signals; - -extern void process_quit_flag (void); -#define QUIT \ - do { \ - if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \ - process_quit_flag (); \ - else if (pending_signals) \ - process_pending_signals (); \ - } while (false) + When not quitting, process any pending signals. */ +extern void maybe_quit (void); +#define QUIT maybe_quit () /* True if ought to quit now. */ commit 0dfd9a69186e12e53b8aa759c47b9747de92db43 Author: Paul Eggert Date: Wed Jan 25 19:07:57 2017 -0800 Simplify make-list implementation * src/alloc.c (Fmake_list): Don’t unroll loop, as the complexity is not worth it these days. diff --git a/src/alloc.c b/src/alloc.c index 1a6d4e2d56..f7da7e44f2 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2872,44 +2872,14 @@ usage: (list &rest OBJECTS) */) DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0, doc: /* Return a newly created list of length LENGTH, with each element being INIT. */) - (register Lisp_Object length, Lisp_Object init) + (Lisp_Object length, Lisp_Object init) { - register Lisp_Object val; - register EMACS_INT size; - + Lisp_Object val = Qnil; CHECK_NATNUM (length); - size = XFASTINT (length); - val = Qnil; - while (size > 0) + for (EMACS_INT size = XFASTINT (length); 0 < size; size--) { val = Fcons (init, val); - --size; - - if (size > 0) - { - val = Fcons (init, val); - --size; - - if (size > 0) - { - val = Fcons (init, val); - --size; - - if (size > 0) - { - val = Fcons (init, val); - --size; - - if (size > 0) - { - val = Fcons (init, val); - --size; - } - } - } - } - QUIT; } commit 44765de2005fb56c5930383d6bd1e959a0102a45 Author: Mark Oteiza Date: Wed Jan 25 21:34:46 2017 -0500 Make use of cl-loop destructuring * lisp/progmodes/js.el (js--get-tabs): Replace extraneous bits with destructuring. (with-js): Add declare forms. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 2e5c6ae119..4a5bde764b 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3214,7 +3214,7 @@ with `js--js-encode-value'." Inside the lexical scope of `with-js', `js?', `js!', `js-new', `js-eval', `js-list', `js<', `js>', `js-get-service', `js-create-instance', and `js-qi' are defined." - + (declare (indent 0) (debug t)) `(progn (js--js-enter-repl) (unwind-protect @@ -3431,11 +3431,8 @@ left-to-right." (eq (cl-fifth window-info) 2)) do (push window-info windows)) - (cl-loop for window-info in windows - for window = (cl-first window-info) - collect (list (cl-second window-info) - (cl-third window-info) - window) + (cl-loop for (window title location) in windows + collect (list title location window) for gbrowser = (js< window "gBrowser") if (js-handle? gbrowser) commit d32dfc2c7ab03df68d4fb8c77ece6a39d87cd06c Author: Lars Ingebrigtsen Date: Wed Jan 25 22:53:07 2017 +0100 Revert "Bind C-c keys in the article buffer" This reverts commit 6b4195f2ace1f6328c5a833fde40f39babef4fa6. The commit somehow lead to problems in other parts of Emacs. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 80c519a439..a0f14402fb 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -4391,7 +4391,6 @@ If variable `gnus-use-long-file-name' is non-nil, it is "e" gnus-article-read-summary-keys "\C-d" gnus-article-read-summary-keys - "\C-c" gnus-article-read-summary-keys "\M-*" gnus-article-read-summary-keys "\M-#" gnus-article-read-summary-keys "\M-^" gnus-article-read-summary-keys commit cd0e63652445c90af7167b48d83e410af1e6e590 Author: Eli Zaretskii Date: Wed Jan 25 22:49:35 2017 +0200 ; * doc/lispref/lists.texi (List Elements): Fix last change. diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index 87fc3afe2e..8eab2818f9 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -387,13 +387,13 @@ or @code{(nthcdr 2 @var{cons-cell})}. @findex cdddar @findex cddddr In addition to the above, 24 additional compositions of @code{car} and -@code{cdr} are defined as @code{cXXXr} and @code{cXXXXr}, where each -@var{x} is either @samp{a} or @samp{d}. -@code{cadr}, @code{caddr}, and @code{cadddr} pick out the second, -third or fourth elements of a list, respectively. @file{cl-lib} -provides the same under the names @code{cl-second}, @code{cl-third}, -and @code{cl-fourth}. -@xref{List Functions,,, cl, Common Lisp Extensions}. +@code{cdr} are defined as @code{c@var{xxx}r} and @code{c@var{xxxx}r}, +where each @code{@var{x}} is either @code{a} or @code{d}. @code{cadr}, +@code{caddr}, and @code{cadddr} pick out the second, third or fourth +elements of a list, respectively. @file{cl-lib} provides the same +under the names @code{cl-second}, @code{cl-third}, and +@code{cl-fourth}. @xref{List Functions,,, cl, Common Lisp +Extensions}. @defun butlast x &optional n This function returns the list @var{x} with the last element, commit 097b1686b6ac518ba8c2ae225eb62560c2010431 Author: Lars Ingebrigtsen Date: Wed Jan 25 21:47:28 2017 +0100 Document how to quote MML tags * doc/misc/emacs-mime.texi (MML Definition): Mention how to quote MML tags (bug#18881). diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi index 771c078be7..b0cfbc9d3c 100644 --- a/doc/misc/emacs-mime.texi +++ b/doc/misc/emacs-mime.texi @@ -654,6 +654,10 @@ Each tag can contain zero or more parameters on the form but that's not necessary unless the value contains white space. So @samp{filename=/home/user/#hello$^yes} is perfectly valid. +If you want to talk about MML in a message, you need a way to +``quote'' these tags. The way to do that is to include an exclamation +point after the opening two characters; i. e. @samp{<#!part ...>}. + The following parameters have meaning in @acronym{MML}; parameters that have no meaning are ignored. The @acronym{MML} parameter names are the same as the @acronym{MIME} parameter names; the things in the parentheses say which commit 27accec97022a49b362feeb36293fdce2947eb43 Author: Lars Ingebrigtsen Date: Wed Jan 25 21:21:40 2017 +0100 Make address parsing more robust * lisp/mail/ietf-drums.el (ietf-drums-parse-address): Don't bug out on addresses like (ietf-drums-parse-address "\"Foo \"bar\" ") (bug#18572). diff --git a/lisp/mail/ietf-drums.el b/lisp/mail/ietf-drums.el index a3e53cfe79..fd793a2830 100644 --- a/lisp/mail/ietf-drums.el +++ b/lisp/mail/ietf-drums.el @@ -192,6 +192,17 @@ the Content-Transfer-Encoding header of a mail." (ietf-drums-init string) (while (not (eobp)) (setq c (char-after)) + ;; If we have an uneven number of quote characters, + ;; `forward-sexp' will fail. In these cases, just delete the + ;; final of these quote characters. + (when (and (eq c ?\") + (not + (save-excursion + (ignore-errors + (forward-sexp 1) + t)))) + (delete-char 1) + (setq c (char-after))) (cond ((or (eq c ? ) (eq c ?\t)) commit e0e95199b93a232e5d4da67823364676ca9cb67c Author: Lars Ingebrigtsen Date: Wed Jan 25 20:57:52 2017 +0100 Fix the %P (line number) thing in Gnus summary buffers * lisp/gnus/gnus-salt.el (gnus-pick-line-number): Remove hack. * lisp/gnus/gnus-sum.el (gnus-summary-read-group-1): Reset the "pick" mode line number on entry instead of relying in a hack (bug#18311). diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el index 5361c2b86f..7037328b7a 100644 --- a/lisp/gnus/gnus-salt.el +++ b/lisp/gnus/gnus-salt.el @@ -131,9 +131,7 @@ It accepts the same format specs that `gnus-summary-line-format' does." (defvar gnus-pick-line-number 1) (defun gnus-pick-line-number () "Return the current line number." - (if (bobp) - (setq gnus-pick-line-number 1) - (incf gnus-pick-line-number))) + (incf gnus-pick-line-number)) (defun gnus-pick-start-reading (&optional catch-up) "Start reading the picked articles. diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 624833420d..e21d6bdb67 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -3976,6 +3976,8 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; The group was successfully selected. (t (gnus-set-global-variables) + (when (boundp 'gnus-pick-line-number) + (setq gnus-pick-line-number 0)) (when (boundp 'spam-install-hooks) (spam-initialize)) ;; Save the active value in effect when the group was entered. commit 36cbe217c818000d90fea132f0c8041f06748502 Author: Lars Ingebrigtsen Date: Wed Jan 25 20:43:27 2017 +0100 Fix wrong documentation on nnmairix keystrokes * doc/misc/gnus.texi (nnmairix keyboard shortcuts): The nnmairix commands are on G G, not $ (bug#18260). diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 05159d4b2f..9c87259ab0 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -21857,37 +21857,37 @@ In summary mode: @table @kbd -@item $ m -@kindex $ m (Summary) +@item G G m +@kindex G G m (Summary) @findex nnmairix-widget-search-from-this-article Allows you to create a mairix query or group based on the current message using graphical widgets (same as @code{nnmairix-widget-search}) (@code{nnmairix-widget-search-from-this-article}). -@item $ g -@kindex $ g (Summary) +@item G G g +@kindex G G g (Summary) @findex nnmairix-create-search-group-from-message Interactively creates a new search group with query based on the current message, but uses the minibuffer instead of graphical widgets (@code{nnmairix-create-search-group-from-message}). -@item $ t -@kindex $ t (Summary) +@item G G t +@kindex G G t (Summary) @findex nnmairix-search-thread-this-article Searches thread for the current article (@code{nnmairix-search-thread-this-article}). This is effectively a shortcut for calling @code{nnmairix-search} with @samp{m:msgid} of the current article and enabled threads. -@item $ f -@kindex $ f (Summary) +@item G G f +@kindex G G f (Summary) @findex nnmairix-search-from-this-article Searches all messages from sender of the current article (@code{nnmairix-search-from-this-article}). This is a shortcut for calling @code{nnmairix-search} with @samp{f:From}. -@item $ o -@kindex $ o (Summary) +@item G G o +@kindex G G o (Summary) @findex nnmairix-goto-original-article (Only in @code{nnmairix} groups!) Tries determine the group this article originally came from and displays the article in this group, so that, @@ -21896,8 +21896,8 @@ parameters are applied (@code{nnmairix-goto-original-article}). This function will use the registry if available, but can also parse the article file name as a fallback method. -@item $ u -@kindex $ u (Summary) +@item G G u +@kindex G G u (Summary) @findex nnmairix-remove-tick-mark-original-article Remove possibly existing tick mark from original article (@code{nnmairix-remove-tick-mark-original-article}). (@pxref{nnmairix @@ -22051,7 +22051,7 @@ activate the always-unread feature by using @kbd{G b r} twice. So far so good---but how do you remove the tick marks in the @code{nnmairix} group? There are two options: You may simply use -@code{nnmairix-remove-tick-mark-original-article} (bound to @kbd{$ u}) to remove +@code{nnmairix-remove-tick-mark-original-article} (bound to @kbd{G G u}) to remove tick marks from the original article. The other possibility is to set @code{nnmairix-propagate-marks-to-nnmairix-groups} to @code{t}, but see the above comments about this option. If it works for you, the tick marks should commit 6b4195f2ace1f6328c5a833fde40f39babef4fa6 Author: Lars Ingebrigtsen Date: Wed Jan 25 20:40:27 2017 +0100 Bind C-c keys in the article buffer * lisp/gnus/gnus-art.el (gnus-article-mode-map): Also bind the C-c keys so that they execute in the summary buffer (bug#18257). This makes commands like `C-c C-f' work from the article buffer. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index a0f14402fb..80c519a439 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -4391,6 +4391,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is "e" gnus-article-read-summary-keys "\C-d" gnus-article-read-summary-keys + "\C-c" gnus-article-read-summary-keys "\M-*" gnus-article-read-summary-keys "\M-#" gnus-article-read-summary-keys "\M-^" gnus-article-read-summary-keys commit c5442adaa68d1ae866424a06d55c0734f172946d Author: Lars Ingebrigtsen Date: Wed Jan 25 20:30:44 2017 +0100 Don't mark articles in Gnus as displayed when they aren't * lisp/gnus/gnus-sum.el (gnus-summary-read-group-1): Don't mark any articles as selected if we're not selecting any articles (bug#18255). diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 72e902a11f..624833420d 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -4037,6 +4037,9 @@ If SELECT-ARTICLES, only select those articles from GROUP." (when kill-buffer (gnus-kill-or-deaden-summary kill-buffer)) (gnus-summary-auto-select-subject) + ;; Don't mark any articles as selected if we haven't done that. + (when no-article + (setq overlay-arrow-position nil)) ;; Show first unread article if requested. (if (and (not no-article) (not no-display) commit 43eba4955350b787c5567a31e2980ae70b9fb52f Author: Mark Oteiza Date: Wed Jan 25 14:21:10 2017 -0500 Move cXXXr and cXXXXr to subr.el * etc/NEWS: Mention new core Elisp. * doc/lispref/lists.texi (List Elements): Document and index the new functions. * doc/misc/cl.texi (List Functions): Change "defines" to "aliases". * lisp/subr.el (caaar, caadr, cadar, caddr, cdaar, cdadr, cddar) (cdddr, caaaar caaadr, caadar, caaddr, cadaar, cadadr, caddar): (cadddr, cdaaar, cdaadr, cdadar, cdaddr, cddaar, cddadr, cdddar): (cddddr): New functions. * lisp/emacs-lisp/cl-lib.el (cl-caaar, cl-caadr, cl-cadar, cl-caddr): (cl-cdaar, cl-cdadr, cl-cddar cl-cdddr, cl-caaaar cl-caaadr): (cl-caadar, cl-caaddr, cl-cadaar, cl-cadadr, cl-caddar, cl-cadddr): (cl-cdaaar, cl-cdaadr, cl-cdadar, cl-cdaddr, cl-cddaar, cl-cddadr): (cl-cdddar, cl-cddddr): Alias to new subr functions. * lisp/emacs-lisp/cl.el (cl-unload-function): Remove cXXXr and cXXXXr elements. diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index bd7d85aa18..87fc3afe2e 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -362,6 +362,39 @@ This is the same as @code{(cdr (cdr @var{cons-cell}))} or @code{(nthcdr 2 @var{cons-cell})}. @end defun +@findex caaar +@findex caadr +@findex cadar +@findex caddr +@findex cdaar +@findex cdadr +@findex cddar +@findex cdddr +@findex caaaar +@findex caaadr +@findex caadar +@findex caaddr +@findex cadaar +@findex cadadr +@findex caddar +@findex cadddr +@findex cdaaar +@findex cdaadr +@findex cdadar +@findex cdaddr +@findex cddaar +@findex cddadr +@findex cdddar +@findex cddddr +In addition to the above, 24 additional compositions of @code{car} and +@code{cdr} are defined as @code{cXXXr} and @code{cXXXXr}, where each +@var{x} is either @samp{a} or @samp{d}. +@code{cadr}, @code{caddr}, and @code{cadddr} pick out the second, +third or fourth elements of a list, respectively. @file{cl-lib} +provides the same under the names @code{cl-second}, @code{cl-third}, +and @code{cl-fourth}. +@xref{List Functions,,, cl, Common Lisp Extensions}. + @defun butlast x &optional n This function returns the list @var{x} with the last element, or the last @var{n} elements, removed. If @var{n} is greater diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi index 9e56a54ed7..8baa0bd88c 100644 --- a/doc/misc/cl.texi +++ b/doc/misc/cl.texi @@ -3694,7 +3694,7 @@ i.e., chains of cons cells. @defun cl-caddr x This function is equivalent to @code{(car (cdr (cdr @var{x})))}. -Likewise, this package defines all 24 @code{c@var{xxx}r} functions +Likewise, this package aliases all 24 @code{c@var{xxx}r} functions where @var{xxx} is up to four @samp{a}s and/or @samp{d}s. All of these functions are @code{setf}-able, and calls to them are expanded inline by the byte-compiler for maximum efficiency. diff --git a/etc/NEWS b/etc/NEWS index 69b247f6f3..0ad5f70075 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -858,6 +858,9 @@ ABBR is a time zone abbreviation. The affected functions are collection). +++ +** 'car' and 'cdr' compositions 'cXXXr' and 'cXXXXr' are now part of Elisp. + ++++ ** The new functions 'make-nearby-temp-file' and 'temporary-file-directory' can be used for creation of temporary files of remote or mounted directories. diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index b1db07fe16..5aa8f1bf65 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -413,125 +413,30 @@ Signal an error if X is not a list." (declare (gv-setter (lambda (store) `(setcar (nthcdr 9 ,x) ,store)))) (nth 9 x)) -(defun cl-caaar (x) - "Return the `car' of the `car' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (car (car (car x)))) - -(defun cl-caadr (x) - "Return the `car' of the `car' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (car (car (cdr x)))) - -(defun cl-cadar (x) - "Return the `car' of the `cdr' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (car (cdr (car x)))) - -(defun cl-caddr (x) - "Return the `car' of the `cdr' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (car (cdr (cdr x)))) - -(defun cl-cdaar (x) - "Return the `cdr' of the `car' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (cdr (car (car x)))) - -(defun cl-cdadr (x) - "Return the `cdr' of the `car' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (cdr (car (cdr x)))) - -(defun cl-cddar (x) - "Return the `cdr' of the `cdr' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (cdr (cdr (car x)))) - -(defun cl-cdddr (x) - "Return the `cdr' of the `cdr' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (cdr (cdr (cdr x)))) - -(defun cl-caaaar (x) - "Return the `car' of the `car' of the `car' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (car (car (car (car x))))) - -(defun cl-caaadr (x) - "Return the `car' of the `car' of the `car' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (car (car (car (cdr x))))) - -(defun cl-caadar (x) - "Return the `car' of the `car' of the `cdr' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (car (car (cdr (car x))))) - -(defun cl-caaddr (x) - "Return the `car' of the `car' of the `cdr' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (car (car (cdr (cdr x))))) - -(defun cl-cadaar (x) - "Return the `car' of the `cdr' of the `car' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (car (cdr (car (car x))))) - -(defun cl-cadadr (x) - "Return the `car' of the `cdr' of the `car' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (car (cdr (car (cdr x))))) - -(defun cl-caddar (x) - "Return the `car' of the `cdr' of the `cdr' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (car (cdr (cdr (car x))))) - -(defun cl-cadddr (x) - "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (car (cdr (cdr (cdr x))))) - -(defun cl-cdaaar (x) - "Return the `cdr' of the `car' of the `car' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (cdr (car (car (car x))))) - -(defun cl-cdaadr (x) - "Return the `cdr' of the `car' of the `car' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (cdr (car (car (cdr x))))) - -(defun cl-cdadar (x) - "Return the `cdr' of the `car' of the `cdr' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (cdr (car (cdr (car x))))) - -(defun cl-cdaddr (x) - "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (cdr (car (cdr (cdr x))))) - -(defun cl-cddaar (x) - "Return the `cdr' of the `cdr' of the `car' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (cdr (cdr (car (car x))))) - -(defun cl-cddadr (x) - "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (cdr (cdr (car (cdr x))))) - -(defun cl-cdddar (x) - "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (cdr (cdr (cdr (car x))))) - -(defun cl-cddddr (x) - "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (cdr (cdr (cdr (cdr x))))) +(defalias 'cl-caaar 'caaar) +(defalias 'cl-caadr 'caadr) +(defalias 'cl-cadar 'cadar) +(defalias 'cl-caddr 'caddr) +(defalias 'cl-cdaar 'cdaar) +(defalias 'cl-cdadr 'cdadr) +(defalias 'cl-cddar 'cddar) +(defalias 'cl-cdddr 'cdddr) +(defalias 'cl-caaaar 'caaaar) +(defalias 'cl-caaadr 'caaadr) +(defalias 'cl-caadar 'caadar) +(defalias 'cl-caaddr 'caaddr) +(defalias 'cl-cadaar 'cadaar) +(defalias 'cl-cadadr 'cadadr) +(defalias 'cl-caddar 'caddar) +(defalias 'cl-cadddr 'cadddr) +(defalias 'cl-cdaaar 'cdaaar) +(defalias 'cl-cdaadr 'cdaadr) +(defalias 'cl-cdadar 'cdadar) +(defalias 'cl-cdaddr 'cdaddr) +(defalias 'cl-cddaar 'cddaar) +(defalias 'cl-cddadr 'cddadr) +(defalias 'cl-cdddar 'cdddar) +(defalias 'cl-cddddr 'cddddr) ;;(defun last* (x &optional n) ;; "Returns the last link in the list LIST. diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index e33a603d1b..73eb9a4e86 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -258,30 +258,6 @@ copy-list ldiff list* - cddddr - cdddar - cddadr - cddaar - cdaddr - cdadar - cdaadr - cdaaar - cadddr - caddar - cadadr - cadaar - caaddr - caadar - caaadr - caaaar - cdddr - cddar - cdadr - cdaar - caddr - cadar - caadr - caaar tenth ninth eighth diff --git a/lisp/subr.el b/lisp/subr.el index 53774169b4..a6ba05c202 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -384,6 +384,126 @@ configuration." (declare (compiler-macro internal--compiler-macro-cXXr)) (cdr (cdr x))) +(defun caaar (x) + "Return the `car' of the `car' of the `car' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (car (car (car x)))) + +(defun caadr (x) + "Return the `car' of the `car' of the `cdr' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (car (car (cdr x)))) + +(defun cadar (x) + "Return the `car' of the `cdr' of the `car' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (car (cdr (car x)))) + +(defun caddr (x) + "Return the `car' of the `cdr' of the `cdr' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (car (cdr (cdr x)))) + +(defun cdaar (x) + "Return the `cdr' of the `car' of the `car' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (cdr (car (car x)))) + +(defun cdadr (x) + "Return the `cdr' of the `car' of the `cdr' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (cdr (car (cdr x)))) + +(defun cddar (x) + "Return the `cdr' of the `cdr' of the `car' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (cdr (cdr (car x)))) + +(defun cdddr (x) + "Return the `cdr' of the `cdr' of the `cdr' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (cdr (cdr (cdr x)))) + +(defun caaaar (x) + "Return the `car' of the `car' of the `car' of the `car' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (car (car (car (car x))))) + +(defun caaadr (x) + "Return the `car' of the `car' of the `car' of the `cdr' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (car (car (car (cdr x))))) + +(defun caadar (x) + "Return the `car' of the `car' of the `cdr' of the `car' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (car (car (cdr (car x))))) + +(defun caaddr (x) + "Return the `car' of the `car' of the `cdr' of the `cdr' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (car (car (cdr (cdr x))))) + +(defun cadaar (x) + "Return the `car' of the `cdr' of the `car' of the `car' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (car (cdr (car (car x))))) + +(defun cadadr (x) + "Return the `car' of the `cdr' of the `car' of the `cdr' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (car (cdr (car (cdr x))))) + +(defun caddar (x) + "Return the `car' of the `cdr' of the `cdr' of the `car' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (car (cdr (cdr (car x))))) + +(defun cadddr (x) + "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (car (cdr (cdr (cdr x))))) + +(defun cdaaar (x) + "Return the `cdr' of the `car' of the `car' of the `car' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (cdr (car (car (car x))))) + +(defun cdaadr (x) + "Return the `cdr' of the `car' of the `car' of the `cdr' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (cdr (car (car (cdr x))))) + +(defun cdadar (x) + "Return the `cdr' of the `car' of the `cdr' of the `car' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (cdr (car (cdr (car x))))) + +(defun cdaddr (x) + "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (cdr (car (cdr (cdr x))))) + +(defun cddaar (x) + "Return the `cdr' of the `cdr' of the `car' of the `car' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (cdr (cdr (car (car x))))) + +(defun cddadr (x) + "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (cdr (cdr (car (cdr x))))) + +(defun cdddar (x) + "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (cdr (cdr (cdr (car x))))) + +(defun cddddr (x) + "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (cdr (cdr (cdr (cdr x))))) + (defun last (list &optional n) "Return the last link of LIST. Its car is the last element. If LIST is nil, return nil. commit ff9ccf6883113ef6d30a352f3ee6dfaa090f0e88 Author: Lars Ingebrigtsen Date: Wed Jan 25 19:30:33 2017 +0100 Only save .newsrc file if the native method is NNTP * lisp/gnus/gnus-start.el (gnus-save-newsrc-file): Only save the .newsrc file if the native select method is NNTP (bug#18198). This avoids problems with invalid IMAP group names and the like in the .newsrc file. diff --git a/etc/NEWS b/etc/NEWS index ca66df6261..69b247f6f3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -348,6 +348,12 @@ bound to 'Buffer-menu-unmark-all-buffers'. *** Two new commands 'Buffer-menu-unmark-all', bound to 'U' and 'Buffer-menu-unmark-all-buffers', bound to 'M-DEL'. +** Gnus + +--- +*** The .newsrc file will now only be saved if the native select +method is an NNTP select method. + ** Ibuffer --- commit 544b996915b9a06050b1a80c690749649dacb9d3 Author: Lars Ingebrigtsen Date: Wed Jan 25 19:30:22 2017 +0100 Only save .newsrc file if the native method is NNTP * lisp/gnus/gnus-start.el (gnus-save-newsrc-file): Only save the .newsrc file if the native select method is NNTP (bug#18198). This avoids problems with invalid IMAP group names and the like in the .newsrc file. diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 47e33af96e..be46339cd3 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -2801,8 +2801,13 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-run-hooks 'gnus-save-newsrc-hook) (if gnus-slave (gnus-slave-save-newsrc) - ;; Save .newsrc. - (when gnus-save-newsrc-file + ;; Save .newsrc only if the select method is an NNTP method. + ;; The .newsrc file is for interoperability with other + ;; newsreaders, so saving non-NNTP groups there doesn't make + ;; much sense. + (when (and gnus-save-newsrc-file + (eq (car (gnus-server-to-method gnus-select-method)) + 'nntp)) (gnus-message 8 "Saving %s..." gnus-current-startup-file) (gnus-gnus-to-newsrc-format) (gnus-message 8 "Saving %s...done" gnus-current-startup-file)) commit 7a7c0b170b9567e892a1bf9a03d8f447f67b0e50 Author: Lars Ingebrigtsen Date: Wed Jan 25 18:31:42 2017 +0100 Gnus custom spec fix * lisp/gnus/gnus-art.el (gnus-signature-limit): Fix customize spec to match the doc string (bug#17679). diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index e1af859516..a0f14402fb 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -251,7 +251,12 @@ This can also be a list of the above values." (integer :value 200) (number :value 4.0) function - (regexp :value ".*")) + (regexp :value ".*") + (repeat (choice (const nil) + (integer :value 200) + (number :value 4.0) + function + (regexp :value ".*")))) :group 'gnus-article-signature) (defcustom gnus-hidden-properties commit 87e2657baf2a1aca59b55542d798357a9b49f199 Author: Lars Ingebrigtsen Date: Wed Jan 25 18:27:33 2017 +0100 Clarify confusing Gnus error message * lisp/gnus/gnus-topic.el (gnus-topic-unindent): Clarify confusing error message (bug#17677). diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index 8ab8f46288..6d6e20dc12 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -1564,7 +1564,7 @@ If UNINDENT, remove an indentation." (parent (gnus-topic-parent-topic topic)) (grandparent (gnus-topic-parent-topic parent))) (unless grandparent - (error "Nothing to indent %s into" topic)) + (error "Can't unindent %s further" topic)) (when topic (gnus-topic-goto-topic topic) (gnus-topic-kill-group) commit 00591a8ee72d71459caf9b7e8aa3f32fddb5da46 Author: Lars Ingebrigtsen Date: Wed Jan 25 18:14:00 2017 +0100 Make C-u C-x m work with Message as documented * lisp/gnus/message.el (message-mail): Respect the CONTINUE parameter (bug#17175). diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 4d4ba08943..4f9dd093fa 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -6644,29 +6644,27 @@ OTHER-HEADERS is an alist of header/value pairs. CONTINUE says whether to continue editing a message already being composed. SWITCH-FUNCTION is a function used to switch to and display the mail buffer." (interactive) - (let ((message-this-is-mail t)) - (unless (message-mail-user-agent) - (message-pop-to-buffer - ;; Search for the existing message buffer if `continue' is non-nil. - (let ((message-generate-new-buffers - (when (or (not continue) - (eq message-generate-new-buffers 'standard) - (functionp message-generate-new-buffers)) - message-generate-new-buffers))) - (message-buffer-name "mail" to)) - switch-function)) - (message-setup - (nconc - `((To . ,(or to "")) (Subject . ,(or subject ""))) - ;; C-h f compose-mail says that headers should be specified as - ;; (string . value); however all the rest of message expects - ;; headers to be symbols, not strings (eg message-header-format-alist). - ;; http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg00337.html - ;; We need to convert any string input, eg from rmail-start-mail. - (dolist (h other-headers other-headers) - (if (stringp (car h)) (setcar h (intern (capitalize (car h))))))) - yank-action send-actions continue switch-function - return-action))) + (let ((message-this-is-mail t) + message-buffers) + ;; Search for the existing message buffer if `continue' is non-nil. + (if (and continue + (setq message-buffers (message-buffers))) + (pop-to-buffer (car message-buffers)) + ;; Start a new buffer. + (unless (message-mail-user-agent) + (message-pop-to-buffer (message-buffer-name "mail" to) switch-function)) + (message-setup + (nconc + `((To . ,(or to "")) (Subject . ,(or subject ""))) + ;; C-h f compose-mail says that headers should be specified as + ;; (string . value); however all the rest of message expects + ;; headers to be symbols, not strings (eg message-header-format-alist). + ;; http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg00337.html + ;; We need to convert any string input, eg from rmail-start-mail. + (dolist (h other-headers other-headers) + (if (stringp (car h)) (setcar h (intern (capitalize (car h))))))) + yank-action send-actions continue switch-function + return-action)))) ;;;###autoload (defun message-news (&optional newsgroups subject) commit 82b6b3cf8ff2544be4aab5157c3df05e98d77ab6 Author: Lars Ingebrigtsen Date: Wed Jan 25 17:43:44 2017 +0100 Fix problem with auto-mode and dir-locals-collect-variables * lisp/files.el (dir-locals-collect-variables): When run from auto-mode, the file in question may not be an absolute path name (bug#24016). Example backtrace: Debugger entered--Lisp error: (args-out-of-range "compile-1st-in-loa dir-locals-collect-variables(((emacs-lisp-mode (indent-tabs-mode)) hack-dir-local-variables() hack-local-variables(no-mode) run-mode-hooks(diff-mode-hook) diff-mode() mm-display-inline-fontify((# ("text/x-diff" ( diff --git a/lisp/files.el b/lisp/files.el index f60282b775..25392fdcc7 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3723,7 +3723,8 @@ Return the new variables list." (let* ((file-name (or (buffer-file-name) ;; Handle non-file buffers, too. (expand-file-name default-directory))) - (sub-file-name (if file-name + (sub-file-name (if (and file-name + (file-name-absolute-p file-name)) ;; FIXME: Why not use file-relative-name? (substring file-name (length root))))) (condition-case err commit 97934ffb5673fe7d7498fb31a9bdf32fd8e0c5c7 Author: Lars Ingebrigtsen Date: Wed Jan 25 17:28:17 2017 +0100 Attach text files correctly in Message * lisp/gnus/mml.el (mml-generate-mime-1): Detect which coding system has been used in attached text files, and don't try to do any encoding of these files (bug#13808). diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 6d13d892b5..6d9e24e708 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -486,7 +486,8 @@ be \"related\" or \"alternate\"." (equal (cdr (assq 'type (car cont))) "text/html")) (setq cont (mml-expand-html-into-multipart-related (car cont)))) (prog1 - (mm-with-multibyte-buffer + (with-temp-buffer + (set-buffer-multibyte nil) (setq message-options options) (cond ((and (consp (car cont)) @@ -605,15 +606,18 @@ be \"related\" or \"alternate\"." (intern (downcase charset)))))) (if (and (not raw) (member (car (split-string type "/")) '("text" "message"))) + ;; We have a text-like MIME part, so we need to do + ;; charset encoding. (progn (with-temp-buffer + (set-buffer-multibyte nil) + ;; First insert the data into the buffer. (cond ((cdr (assq 'buffer cont)) (insert-buffer-substring (cdr (assq 'buffer cont)))) ((and filename (not (equal (cdr (assq 'nofile cont)) "yes"))) - (let ((coding-system-for-read coding)) - (mm-insert-file-contents filename))) + (mm-insert-file-contents filename)) ((eq 'mml (car cont)) (insert (cdr (assq 'contents cont)))) (t @@ -667,21 +671,22 @@ be \"related\" or \"alternate\"." ;; insert a "; format=flowed" string unless the ;; user has already specified it. (setq flowed (null (assq 'format cont))))) - ;; Prefer `utf-8' for text/calendar parts. - (if (or charset - (not (string= type "text/calendar"))) - (setq charset (mm-encode-body charset)) - (let ((mm-coding-system-priorities - (cons 'utf-8 mm-coding-system-priorities))) - (setq charset (mm-encode-body)))) - (mm-disable-multibyte) + (unless charset + (setq charset + ;; Prefer `utf-8' for text/calendar parts. + (if (string= type "text/calendar") + 'utf-8 + (mm-coding-system-to-mime-charset + (detect-coding-region + (point-min) (point-max) t))))) (setq encoding (mm-body-encoding charset (cdr (assq 'encoding cont)))))) (setq coded (buffer-string))) (mml-insert-mime-headers cont type charset encoding flowed) (insert "\n") (insert coded)) - (mm-with-unibyte-buffer + (with-temp-buffer + (set-buffer-multibyte nil) (cond ((cdr (assq 'buffer cont)) (insert (string-as-unibyte commit 6bfa9e9abca17290bc393d90aedb5abef83a3e06 Author: Lars Ingebrigtsen Date: Wed Jan 25 14:21:13 2017 +0100 Build fix for older gnutls versions * src/gnutls.c (emacs_gnutls_handle_error): GNUTLS_E_PREMATURE_TERMINATION is apparently only present in gnutls-3. diff --git a/src/gnutls.c b/src/gnutls.c index 6fa0e10972..65b83bad6b 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -586,8 +586,10 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err) /* Mostly ignore "The TLS connection was non-properly terminated" message which just means that the peer closed the connection. */ +#ifdef HAVE_GNUTLS3 if (err == GNUTLS_E_PREMATURE_TERMINATION) level = 3; +#endif GNUTLS_LOG2 (level, max_log_level, "fatal error:", str); ret = 0;